that may be worth pursuing if your goal is to minimize the total number of guesses. It may seem counter intuitive that there is a better approach than a binary search but I outlined an example where you have better than 50% chance of guessing correctly and a 100% chance of pruning more than 50% of the remaining candidates. I was starting to work on it when I realized I had missed an opportunity for pruning in my original. This now guesses 'eclectic' with only 2 incorrect guesses using a dictionary of 60,388 words (9,638 of them being the same length). Here is that modified code:
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Std;
my %opt;
get_args(\%opt);
my $dict = load_dictionary($opt{d}, $opt{w});
my %guessed;
my $curr_guess = join '', map {'*'} 1 .. length($opt{w});
while (1) {
last if $curr_guess eq $opt{w} || ! $opt{g};
print "Current value:\t$curr_guess\n";
my $best_letter = find_best_letter($dict, \%guessed);
die "$opt{w} not in dictionary" if ! $best_letter;
print "Best letter to choose: $best_letter\n";
my $result = index($opt{w}, $best_letter) == -1 ? 'wrong' : 'right
+';
if (index($opt{w}, $best_letter) == -1) {
print "You guessed wrong\n";
--$opt{g};
prune_dict_bad_guess($dict, $best_letter);
}
else {
print "You guessed right\n";
$curr_guess = update_current($curr_guess, $opt{w}, $best_lette
+r);
prune_dict_correct_guess($dict, $curr_guess, $best_letter);
}
$guessed{$best_letter} = undef;
}
print "\n$curr_guess\n";
sub prune_dict_correct_guess {
my ($dict, $curr, $let) = @_;
my (%right, %wrong);
for (0 .. length($curr) - 1) {
my $chr = substr($curr, $_, 1);
$chr eq '*'
? ($wrong{$_} = $let)
: ($right{$_} = $chr);
}
for my $word (keys %$dict) {
for my $pos (0 .. length($word) - 1) {
if ($right{$pos} && substr($word, $pos, 1) ne $right{$pos}
+) {
delete $dict->{$word};
last;
}
if ($wrong{$pos} && substr($word, $pos, 1) eq $wrong{$pos}
+) {
delete $dict->{$word};
last;
}
}
}
}
sub update_current {
my ($src, $tgt, $let) = @_;
for (0 .. length($tgt) - 1) {
substr($src, $_, 1, $let) if substr($tgt, $_, 1) eq $let;
}
return $src;
}
sub prune_dict_bad_guess {
my ($dict, $letter) = @_;
for my $word (keys %$dict) {
delete $dict->{$word} if index($word, $letter) != -1;
}
}
sub find_best_letter {
my ($dict, $guessed) = @_;
my %alpha;
for my $word (keys %$dict) {
my %uniq = map {$_ => undef} split //, $word;
$alpha{$_}++ for keys %uniq;
}
delete @alpha{keys %$guessed};
# Would be better as water mark algorithm
my @best = sort {$alpha{$b} <=> $alpha{$a}} keys %alpha;
return $best[0];
}
sub get_args {
my ($opt) = @_;
my $Usage = qq{Usage: $0 [options]
-h : This help message
-d : The (d)ictionary file
Default: 'words.txt' in the current working directory
-g : The number of (g)uesses
Default: 7
-w : The (w)ord to be guessed
} . "\n";
getopts('hd:g:w:', $opt) or die $Usage;
die $Usage if $opt->{h};
die $Usage if ! $opt->{w} || $opt->{w} =~ /[^a-zA-Z]
+/;
$opt->{d} = 'words.txt' if ! defined $opt->{d};
$opt->{g} = 7 if ! defined $opt->{g};
$opt->{w} = lc($opt->{w});
}
sub load_dictionary {
my ($file, $word) = @_;
my $desired_length = length($word);
my %dict;
open(my $fh, '<', $file) or die "Unable to open '$file' for readin
+g: $!";
while (<$fh>) {
tr/a-zA-Z//cd;
next if length($_) != $desired_length;
$dict{lc($_)} = undef;
}
return \%dict;
}
As a result of the code above, I didn't bother finishing the weighted solution that considers probability of guessing correct and percentage of words pruned (for right or wrong). If you are interested, I can give you my code up till then. Why did I lose interest?