I have a code that try to find the Eulerian path like this. But somehow it doesn't work. What's wrong with the code?
use strict;
use warnings;
use Data::Dumper;
use Carp;
my %graphs = ( 1 => [2,3], 2 => [1,3,4,5], 3 =>[1,2,4,5], 4 => [2,3,5], 5 => [2,3,4]);
my @path = eulerPath(%graphs);
sub eulerPath {
my %graph = @_;
# count the number of vertices with odd degree
my @odd = ();
foreach my $vert ( sort keys %graph ) {
my @edg = @{ $graph{$vert} };
my $size = scalar(@edg);
if ( $size % 2 != 0 ) {
push @odd, $vert;
}
}
push @odd, ( keys %graph )[0];
if ( scalar(@odd) > 3 ) {
return "None";
}
my @stack = ( $odd[0] );
my @path = ();
while (@stack) {
m开发者_如何学编程y $v = $stack[-1];
if ( $graph{$v} ) {
my $u = ( @{ $graph{$v} } )[0];
push @stack, $u;
# Find index of vertice v in graph{$u}
my @graphu = @{ $graph{$u} }; # This is line 54.
my ($index) = grep $graphu[$_] eq $v, 0 .. $#graphu;
delete @{ $graph{$u} }[$index];
delete @{ $graph{$v} }[0];
}
else {
push @path, pop(@stack);
}
}
print Dumper \@path;
return @path;
}
The error I get is:
Use of uninitialized value in hash element at euler.pl line 54
I expect it to return the output like this:
$VAR = [5, 4, 3, 5, 2, 3, 1, 2, 4];
Actually I tried to mimic the working code in Python:
def eulerPath(graph):
# counting the number of vertices with odd degree
odd = [ x for x in graph.keys() if len(graph[x])&1 ]
print odd
odd.append( graph.keys()[0] )
if len(odd) > 3:
return None
stack = [ odd[0] ]
path = []
# main algorithm
while stack:
v = stack[-1]
if graph[v]:
u = graph[v][0]
stack.append(u)
# deleting edge u-v
#print graph[u][ graph[u].index(v) ]
#print graph[u].index(v)
del graph[u][ graph[u].index(v) ]
del graph[v][0]
else:
path.append( stack.pop() )
return path
stack_ = eulerPath({ 1:[2,3], 2:[1,3,4,5], 3:[1,2,4,5], 4:[2,3,5], 5:[2,3,4] })
print stack_
In Perl, delete
doesn't re-index. From the Perl documentation:
delete() may also be used on arrays and array slices, but its behavior is less straightforward. Although exists() will return false for deleted entries, deleting array elements never changes indices of existing values; use shift() or splice() for that.
As noted in the documentation, you can use splice
to remove & re-index.
my @graphu = @{ $graph{$u} }; # This is line 54.
my ($index) = grep $graphu[$_] eq $v, 0 .. $#graphu;
splice @{ $graph{$u} }, $index, 1;
splice @{ $graph{$v} }, 0, 1;
In addition to this, there's a problem with the test whether a node has any untrodden paths:
my $v = $stack[-1];
if ( $graph{$v} ) {
my $u = ( @{ $graph{$v} } )[0];
One difference between Perl and Python is that Perl makes you handle dereferencing. $graph{$v}
originally holds an array reference; as long as it continues to refer to the array, the expression is true and this test will always succeed. In the corresponding Python statement (if graph[v]:
), it's the value of graph[v]
(the list) that is evaluated. Try:
my $v = $stack[-1];
if ( @{$graph{$v}} ) {
my $u = ( @{ $graph{$v} } )[0];
On Debugging
I'm not going to give the basics of Perl debugging here (since someone already did as part of the Perl documentation, and laziness can be a good thing), but a brief overview seems in order. The essence of debugging is examining data (aka "the program state") in a program as it runs. You can do this with scaffolding that prints out data at various points in the program (Dumper is useful for this), or with an interactive debugger to step through the program. Interactive debuggers are preferred because they give you more control and are generally quicker (if you didn't print out a crucial piece of data in scaffold code, you'll need to restart the program; with a debugger, there's no need to restart).
Using either technique, examine the variables in your eulerPath
subroutine: @graph
, @stack
, $v
, $u
. Do this with both your original program, the intermediate program that replaces delete
with splice
, and with a program making all my suggested changes. See if you can figure out from the data what was going wrong and producing the errors, and what then lead to the changes I suggested.
I tried Outis's suggestion and it is working as desired by Neversaint :)
wget
http://misccb.googlecode.com/git-history/a4c46aaecbda3c103b92d0152fa2cdbdf4da4ea0/euler.pl
perl euler.pl
$VAR1 = [ 5, 4, 3, 5, 2, 3, 1, 2, '4' ];
精彩评论