# $Id: mw.pm,v 1.4 2005/01/12 20:20:06 trammell Exp $ package Mystery::Word; use strict; use warnings; sub new { my $class = shift; my %defaults = ( size => 5, dictfile => '/usr/share/dict/words', ); my %args = (%defaults, @_); return bless \%args, $class; } sub hint { my ($self, %args) = @_; $self->{hint} = \%args; } sub solve { my $self = shift; my @keep; WORD: for (@{ $self->words }) { next WORD unless length == $self->{size}; foreach my $hint (keys %{ $self->{hint} }) { next WORD unless letters_in_common($_,$hint) == $self->{hint}{ $hint }; } push @keep, $_; } return @keep; } sub words { my ($self, $random) = @_; unless ($self->{words}) { open (my $fh, $self->{dictfile}) or die "Can't open dictionary '$self->{dictfile}': $!"; while (<$fh>) { chomp; push @{$self->{words}}, $_; } } if ($random) { my $i = rand( @{ $self->{words} } ); return $self->{words}[$i]; } return $self->{words}; } sub letters_in_common { (my $p = lc $_[0]) =~ y/a-z//cd; (my $q = lc $_[1]) =~ y/a-z//cd; my %p = map { $_, 1 } split //, $p; my %q = map { $_, 1 } split //, $q; my %common = (%p, %q); return (scalar keys %p) + (scalar keys %q) - (scalar keys %common); } sub create { my $self = $_[0]; (my $mysteryword = lc $_[1]) =~ y/a-z//cd; $self->{size} = length($mysteryword); # algorithm is: # 1. choose a random word $r # 2. determine how many letters ($n) it has in common with $mysteryword # 3. solve the puzzle with candidate $r => $n # 4. if the solution has 1 answer ($mysteryword), we're done, otherwise # try again my %hints; my $count; { $count++; warn "Iteration $count" if $self->{debug}; my $r = $self->words('random'); my $n = letters_in_common($r,$mysteryword); $self->hint( %hints, $r, $n); my @s = $self->solve(); redo unless grep { $_ eq $mysteryword } @s; $hints{ $r } = $n; redo unless @s == 1; } return %hints; } 1;