My module:
# $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 $mysterywor
+d
# 3. solve the puzzle with candidate $r => $n
# 4. if the solution has 1 answer ($mysteryword), we're done, otherwis
+e
# 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;
Sample usage:
#!/usr/bin/perl -l
use strict;
use warnings;
use mw;
use Data::Dumper;
my $puzzle = Mystery::Word->new( debug => 1 );
my %hints = $puzzle->create('camel');
print Dumper(\%hints);
# test solution
my $p2 = Mystery::Word->new( size => 5 );
$p2->hint(%hints);
print for $p2->solve();
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.