Word ladder: Difference between revisions
→{{header|Perl}}: translation of the translation
(→{{header|jq}}: word --> play) |
SqrtNegInf (talk | contribs) (→{{header|Perl}}: translation of the translation) |
||
Line 558:
=={{header|Perl}}==
===Direct translation===
{{trans|C++}}
<lang perl>use strict;
Line 667 ⟶ 668:
white -> whine -> chine -> chink -> clink -> blink -> blank -> black
bubble -> babble -> gabble -> garble -> gargle -> gaggle -> giggle -> jiggle -> jingle -> tingle -> tinkle -> tickle</pre>
===Idiomatic version===
<b>Exactly</b> the same algorithm, written in a more Perl-ish style. Is this better, or worse? Maybe both. Interestingly, runs 1/3rd faster.
<lang perl>use strict;
use warnings;
use feature 'say';
my %dict;
open my $handle, '<', 'ref/unixdict.txt';
while (my $word = <$handle>) {
chomp $word;
my $l = length $word;
if ($dict{$l}) { push @{ $dict{$l} }, $word }
else { $dict{$l} = \@{[$word]} }
}
close $handle;
sub distance {
my($w1,$w2) = @_;
my $dist;
substr($w1, $_, 1) ne substr($w2, $_, 1) and $dist++ for 0 .. length($w1) - 1;
return $dist // 0;
}
sub contains {
my($aref,$needle) = @_;
$needle eq $_ and return 1 for @$aref;
return 0;
}
sub word_ladder {
my($fw,$tw) = @_;
say 'Nothing like that in dictionary.' and return unless $dict{length $fw};
my @poss = @{ $dict{length $fw} };
my @queue = [$fw];
while (@queue) {
my $curr_ref = shift @queue;
my $last = $curr_ref->[-1];
my @next;
distance($last, $_) == 1 and push @next, $_ for @poss;
push(@$curr_ref, $tw) and say join ' -> ', @$curr_ref and return if contains \@next, $tw;
for my $word (@next) {
$word eq $poss[$_] and splice(@poss, $_, 1) and last for 0 .. @poss - 1;
}
push @queue, \@{[@{$curr_ref}, $_]} for @next;
}
say "Cannot change $fw into $tw";
}
word_ladder(@$_) for ['boy', 'man'], ['girl','lady'], ['john','jane'], ['child','adult'];</lang>
Same style output.
=={{header|Phix}}==
| |||