Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Re: Challenge: Mystery Word Puzzle

by trammell (Priest)
on Jan 12, 2005 at 20:40 UTC ( #421763=note: print w/ replies, xml ) Need Help??


in reply to Challenge: Mystery Word Puzzle

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();


Comment on Re: Challenge: Mystery Word Puzzle
Select or Download Code
Re^2: Challenge: Mystery Word Puzzle
by trammell (Priest) on Jan 12, 2005 at 22:21 UTC
    I've found a few problems with my solution (failure to handle anagrams is one), but it does the right thing in many cases. Here is some test data I've generated--solutions are all animals on some nearby books.

    $length = 6; $hints = { 'blackly' => '2', 'drowsy' => '1', 'Haddad' => '1', 'desperado' => '2', 'achieving' => '2', 'cowls' => '1', 'bet' => '1', 'comprehension' => '2', 'foe' => '1', 'permeate' => '1', 'Balkanizations' => '4' };
    $length = 7; $hints = { 'shortest' => '3', 'drilling' => '0', 'locked' => '2', 'messing' => '1', 'irritated' => '1', 'glory' => '1', 'modes' => '2', 'transcribed' => '3' };
    $length = 5; $hints = { 'blocker' => '2', 'entropy' => '2', 'monotonously' => '4', 'resonant' => '3', 'blindfold' => '1', 'decrypts' => '2', 'inquiry' => '1', 'considered' => '3' };
    And a trickier one...
    $length = 5; $hints = { 'repartee' => '1', 'Kankakee' => '2', 'dewdrop' => '0', 'brushfires' => '2', 'identifiably' => '4', 'liberalizes' => '4', 'swimming' => '3', 'Geoffrey' => '0', 'dotting' => '2' };

      On of these has two solutions, and the "tricky" one has three--assuming my code is correct.

      P:\test>421692-1 6 blackly:2 drowsy:1 haddad:1 desperado:2 achieving:2 + cowls:1 bet:1 comprehension:2 foe:1 permeate:1 balkanizations:4 1 fabius P:\test>421692-1 7 shortest:3 drilling:0 locked:2 messing:1 irritated: +1 glory:1 modes:2 transcribed:3 2 cutoffs offcuts P:\test>421692-1 5 blocker:2 entropy:2 monotonously:4 resonant:3 blind +fold:1 decrypts:2 inquiry:1 considered:3 1 mouse P:\test>421692-1 5 repartee:1 kankakee:2 dewdrop:0 brushfires:2 identi +fiably:4 liberalizes:4 swimming:3 geoffrey:0 dotting:2 3 nails slain snail

      Examine what is said, not who speaks.
      Silence betokens consent.
      Love the truth but pardon error.
        Well, I was shooting for baboon, octopus, mouse, snail. I guess the solution depends pretty critically on one's dictionary.
        Where's the 'f' in the words for the second puzzle?

        Being right, does not endow the right to be rude; politeness costs nothing.
        Being unknowing, is not the same as being stupid.
        Expressing a contrary opinion, whether to the individual or the group, is more often a sign of deeper thought than of cantankerous belligerence.
        Do not mistake your goals as the only goals; your opinion as the only opinion; your confidence as correctness. Saying you know better is not the same as explaining you know better.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://421763]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (5)
As of 2014-07-31 05:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (245 votes), past polls