Question

我正在尝试使用Perl解决双重拼图问题。这是我第一次使用Perl，所以请原谅凌乱的代码。

我相信，我的一切都在运作，但是在打印最短路径时遇到了问题。使用队列和BFS我能够找到目标字，但不能找到实际路径。

有没有人有任何建议？我被告知要跟踪每个元素的父母，但它不起作用。

#!/usr/bin/perl

use strict;

my $file = 'test';
#my $file = 'wordlist';
open(my $fh, $file);
my $len = length($ARGV[0]);
my $source = $ARGV[0];
my $target = $ARGV[1];
my @words;

# Creates new array of correct length words
while (my $row = <$fh>) {
    chomp $row;
    my $rowlen = length($row);
    if ($rowlen == $len) {    
        push @words, $row;
    }
}

my %wordHash;

# Creates graph for word variations using dictionary
foreach my $word (@words) {
    my $wordArr = [];
    for (my $i = 0; $i < $len; $i++) {

        my $begin = substr($word, 0, $i);
        my $end = substr($word, $i+1, $len);
        my $key = "$begin" . "_" . "$end";
        my $Arr = [];

        my $regex = "$begin" . "[a-z]" . "$end";
        foreach my $wordTest (@words) {
            if ("$wordTest" =~ $regex && "$wordTest" ne "$word") {
                push $wordArr, "$wordTest";
            }
        }
    }

    $wordHash{"$word"} = $wordArr;
}

my @queue;
push(@queue, "$source");
my $next = $source;
my %visited;
my %parents;
my @path;

# Finds path using BFS and Queue
while ("$next" ne "$target") {

    print "$next: ";
    foreach my $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 the BFS took: ";
print "@path\n\n";

print "Value -> Parent: \n";

for my $key (keys %parents) {
   print "$key -> $parents{$key}\n";
}

Answer 1

在您接受来自@queue的{{1}}字样之前，您需要进行测试以确保它不是$next。但到那时，损害已经完成。该测试确保了访问过的单词不会再成为焦点，因此会阻止循环但早期代码更新%visited该单词是否为%parents。

如果一个单词是%visited，那么您不仅要避免让它成为%visited候选人，还要避免将其视为$next，因为这样会搞砸$variation 1}}。我没有要测试的单词字典，你没有给出失败的例子，但我认为你可以通过将%parents守卫转移到考虑变化的内循环来解决这个问题;

%visited

这将保护foreach my $variation (@{$wordHash{$next}}) { next if %visited{ $variation } ; push(@queue, "$variation"); ... etc ...数组的完整性以及停止循环。小编，在索引到哈希时不需要使用双引号;正如我上面所做的那样，只需说明标量变量 - 使用引号只是插入产生相同结果的变量值。

您的代码，恕我直言，非常适合初学者，BTW。

更新

我已经有了一个单词字典，上面的问题和其他问题一样存在。代码确实一次从源移动一个字母，但是在接近随机的方向 - 不一定更接近目标。为了纠正这个问题，我更改了用于构建图形的正则表达式，使得目标中的相应字母替换了通用@parents。还有一些小的变化 - 主要是风格相关。更新后的代码如下所示;

[a-z]

当跑出来时;

use v5.12;

my $file = 'wordlist.txt';
#my $file = 'wordlist';
open(my $fh, $file);
my $len = length($ARGV[0]);
my $source = $ARGV[0];
my $target = $ARGV[1];
chomp $target;
my @target = split('', $target);
my @words;

# Creates new array of correct length words
while (my $row = <$fh>) {
    $row =~ s/[\r\n]+$//;
    my $rowlen = length($row);
    if ($rowlen == $len) {
        push @words, $row;
    }
}

my %wordHash;

# Creates graph for word variations using dictionary
foreach my $word (@words) {
    my $wordArr = [];
    for (my $i = 0; $i < $len; $i++) {

        my $begin = substr($word, 0, $i);
        my $end = substr($word, $i+1, $len);
        my $key = "$begin" . "_" . "$end";
        my $Arr = [];

        # my $re_str = "$begin[a-z]$end";
        my $regex = $begin . $target[$i] . $end ;
        foreach my $wordTest (@words) {
            if ($wordTest =~ / ^ $regex $ /x ) {
                next if $wordTest eq $word ;
                push $wordArr, "$wordTest";
            }
        }
    }

    $wordHash{"$word"} = $wordArr;
}

my @queue;
push(@queue, "$source");
my $next = $source;
my %visited;
my %parents;
my @path;

# Finds path using BFS and Queue
while ($next ne $target) {

    print "$next: ";
    $visited{$next} = 1;
    foreach my $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 the BFS took: @path\n\n";

print "Value -> Parent: \n";

for my $key (keys %parents) {
   print "$key -> $parents{$key}\n";
}

你可能会删除％父哈希的打印 - 因为哈希值是随机出现的，它不会告诉你很多

打印在BFS期间查找项目的搜索路径

1 个答案:

更新