perl - Printing the search path taken to find item during BFS -
i trying solve doublets puzzle problem using perl. 1 of first times using perl please excuse messy code.
i have working, believe, having issue printing shortest path. using queue , bfs able find target word not actual path taken.
does have suggestions? have been told keep track of parents of each element not working.
#!/usr/bin/perl use strict; $file = 'test'; #my $file = 'wordlist'; open(my $fh, $file); $len = length($argv[0]); $source = $argv[0]; $target = $argv[1]; @words; # creates new array of correct length words while (my $row = <$fh>) { chomp $row; $rowlen = length($row); if ($rowlen == $len) { push @words, $row; } } %wordhash; # creates graph word variations using dictionary foreach $word (@words) { $wordarr = []; (my $i = 0; $i < $len; $i++) { $begin = substr($word, 0, $i); $end = substr($word, $i+1, $len); $key = "$begin" . "_" . "$end"; $arr = []; $regex = "$begin" . "[a-z]" . "$end"; foreach $wordtest (@words) { if ("$wordtest" =~ $regex && "$wordtest" ne "$word") { push $wordarr, "$wordtest"; } } } $wordhash{"$word"} = $wordarr; } @queue; push(@queue, "$source"); $next = $source; %visited; %parents; @path; # finds path using bfs , queue while ("$next" ne "$target") { print "$next: "; foreach $variation (@{$wordhash{$next}}) { push(@queue, "$variation"); $parents{"$variation"} = $next; print "$variation | "; } print "\n-----------------\n"; $visited{"$next"} = 1; push(@path, "$next"); $next = shift(@queue); while ($visited{"$next"} == 1) { $next = shift(@queue); } } print "found: $next\n\n"; print "path bfs took: "; print "@path\n\n"; print "value -> parent: \n"; $key (keys %parents) { print "$key -> $parents{$key}\n"; }
before accept word @queue
$next
, test ensure it's not been %visited
. then, though, damage has been done. test has ensured visited word wont become focus again , hence, prevent loops earlier code updated %parents
whether word had been %visited
or not.
if word has been %visited
, not want avoid becomming $next
candidate, want avoid being considered $variation
screw %parents
. don't have word dictionary test , haven't given example of failure think can fix shifting %visited
guard inner loop variations considered;
foreach $variation (@{$wordhash{$next}}) { next if %visited{ $variation } ; push(@queue, "$variation"); ... etc ...
this protect integrity of @parents
array stop loops. on small note, don't need use double quotes when indexing hash; i've done above, state scalar variable - using quotes interpolates value of variable produces same result.
your code, imho, excellent beginner, btw.
update
i've since got word dictionary , problem above exists 1 other. code move 1 letter @ time source in near random direction - not closer target. correct that, changed regex use build graph such corresponding letter target replaces generic [a-z]
. there couple of minor changes - style related. updated code looks this;
use v5.12; $file = 'wordlist.txt'; #my $file = 'wordlist'; open(my $fh, $file); $len = length($argv[0]); $source = $argv[0]; $target = $argv[1]; chomp $target; @target = split('', $target); @words; # creates new array of correct length words while (my $row = <$fh>) { $row =~ s/[\r\n]+$//; $rowlen = length($row); if ($rowlen == $len) { push @words, $row; } } %wordhash; # creates graph word variations using dictionary foreach $word (@words) { $wordarr = []; (my $i = 0; $i < $len; $i++) { $begin = substr($word, 0, $i); $end = substr($word, $i+1, $len); $key = "$begin" . "_" . "$end"; $arr = []; # $re_str = "$begin[a-z]$end"; $regex = $begin . $target[$i] . $end ; foreach $wordtest (@words) { if ($wordtest =~ / ^ $regex $ /x ) { next if $wordtest eq $word ; push $wordarr, "$wordtest"; } } } $wordhash{"$word"} = $wordarr; } @queue; push(@queue, "$source"); $next = $source; %visited; %parents; @path; # finds path using bfs , queue while ($next ne $target) { print "$next: "; $visited{$next} = 1; foreach $variation (@{$wordhash{$next}}) { next if $visited{ $variation } ; push(@queue, $variation); $parents{$variation} = $next; print "$variation | "; } print "\n-----------------\n"; push(@path, $next); while ( $visited{$next} ) { $next = shift @queue ; } } push @path, $target ; print "found: $next\n\n"; print "path bfs took: @path\n\n"; print "value -> parent: \n"; $key (keys %parents) { print "$key -> $parents{$key}\n"; }
and when ran produces;
./words.pl head tail | more head: heal | ----------------- heal: teal | heil | ----------------- teal: ----------------- heil: hail | ----------------- hail: tail | ----------------- found: tail path bfs took: head heal teal heil hail tail value -> parent: hail -> heil heil -> heal teal -> heal tail -> hail heal -> head
you remove printing of %parents hash - hash values come out randomly, doesnt tell much
Comments
Post a Comment