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

Popular posts from this blog

Ansible - ERROR! the field 'hosts' is required but was not set -

customize file_field button ruby on rails -

SoapUI on windows 10 - high DPI/4K scaling issue -