54 lines
1.6 KiB
Perl
54 lines
1.6 KiB
Perl
use strict;
|
|
use warnings;
|
|
use feature 'say';
|
|
use List::Util 'min';
|
|
|
|
my %cache;
|
|
sub leven {
|
|
my ($s, $t) = @_;
|
|
return length($t) if $s eq '';
|
|
return length($s) if $t eq '';
|
|
$cache{$s}{$t} //=
|
|
do {
|
|
my ($s1, $t1) = (substr($s, 1), substr($t, 1));
|
|
(substr($s, 0, 1) eq substr($t, 0, 1))
|
|
? leven($s1, $t1)
|
|
: 1 + min(
|
|
leven($s1, $t1),
|
|
leven($s, $t1),
|
|
leven($s1, $t ),
|
|
);
|
|
};
|
|
}
|
|
|
|
print "What is your name?"; my $name = <STDIN>;
|
|
$name = 'Number 6';
|
|
say "What is your quest? Never mind that, I will call you '$name'";
|
|
say 'Hey! I am not a number, I am a free man!';
|
|
|
|
my @starters = grep { length() < 6 } my @words = grep { /.{2,}/ } split "\n", `cat unixdict.txt`;
|
|
|
|
my(%used,@possibles,$guess);
|
|
my $rounds = 0;
|
|
my $word = say $starters[ rand $#starters ];
|
|
|
|
while () {
|
|
say "Word in play: $word";
|
|
$used{$word} = 1;
|
|
@possibles = ();
|
|
for my $w (@words) {
|
|
next if abs(length($word) - length($w)) > 1;
|
|
push @possibles, $w if leven($word, $w) == 1 and ! defined $used{$w};
|
|
}
|
|
print "Your word? "; $guess = <STDIN>; chomp $guess;
|
|
last unless grep { $guess eq $_ } @possibles;
|
|
$rounds++;
|
|
$word = $guess;
|
|
}
|
|
|
|
my $already = defined $used{$guess} ? " '$guess' was already played but" : '';
|
|
|
|
if (@possibles) { say "\nSorry $name,${already} one of <@possibles> would have continued the game." }
|
|
else { say "\nGood job $name,${already} there were no possible words to play." }
|
|
say "You made it through $rounds rounds.";
|