Re: Solutions and Discussion for Perl Quiz-of-the-Week #17

--=-=-=

Sample solutions and discussion
Perl Quiz of The Week #17 (20040526)

[ This arrived from Marco just a few minutes after I sent out my
  replacement report.  My apologies to Marco for pre-empting him, and
  to anyone on the list who didn't want to receive two reports. -- MJD. 
]




[sorry for the delay]

Quiz Question:

        http://perl.plover.com/~alias/list.cgi?mss:72

Posted Solutions:

- Tor Fuglerud wins the "we don't like no stinckin' whitespace!" prize
  with http://perl.plover.com/~alias/list.cgi?1:mss:1656

- Christian Duhl wins the "pretty source code" prize with
  http://perl.plover.com/~alias/list.cgi?1:mss:1660

- Shlomi Fish wins the "yes, redo is actually usefull for something"
  prize with
  http://perl.plover.com/~alias/list.cgi?1:mss:1663

- Mike South wins the "politcally correct" prize with his
  hang(man|woman)
  solution. http://perl.plover.com/~alias/list.cgi?1:mss:1670 

- Mark Jason Dominus wins the "Bad MotherFucker" prize with his less
  than honest solution
  http://perl.plover.com/~alias/list.cgi?1:mss:1675

- Fred P. wins the "most polished program" prize with
  http://perl.plover.com/~alias/list.cgi?1:mss:1679

- Et al.: do not take offence if you're not in this list, your
  solution, while valid, simply didn't make me smile or pause.

Comments:

The core algorithm was, obviously, very similar among the various
solutions. A set of guessed letters was kept (either in a string or an
array or hash) along with a set of letters-to-guess.

During the discussions regarding this qotw a few people talked about
writing hangman playerssome pretty interesting discussions came out of
this. See the archives for all the gory details.

David Jones posted a player 
http://perl.plover.com/~alias/list.cgi?1:mss:1666

Randy W. Sims wrote a text pattern analyzer, see
http://perl.plover.com/~alias/list.cgi?1:mss:1682

Sample Solution:

This, rather simple, solution uses two data structures, an array of
the letters in the mystery word and a set (implemented as a hash
table) of the letters guessed so far. It simply loops until we either
guess all the letters in the mystery word or we run out of guesses,
updating the set of letters guessed each time.


--=-=-=
Content-Type: application/octet-stream
Content-Disposition: attachment; filename=simple

#!/usr/bin/perl
use strict;
use warnings;

my ($dict, $num_guesses) = @ARGV;

# Slurp the entire dictionary into memory. I know, I know, I
# explicitly said in the spec that this would be a bad idea. It's just
# that I don't often have access to a machine with 2 GB of RAM and I
# wanted to take advantage of it.
open DICT, "<$dict" or die "Can't open $dict: $!";
my @words = <DICT>;
close DICT;

my $word_string = $words[rand($#words)];

chomp $word_string;
# The array of all the letters in the mystery word.
my @word = split //, $word_string;

# The set of characters guessed so far
my %guesses;

# Register a new guess by the player.
sub collect_guess {
    my $guess = shift;
    if (grep { $_ eq $guess } @word) {
        # If they chose a letter in the word get another guess.
        $num_guesses++
    }
    $guesses{$guess} = 1;
}

# Returns a sorted list af all letters guessed so far
sub guesses_so_far {
    sort { $a cmp $b } keys %guesses;
}

# Returns, as a string, the mystery word with unguessed chars
# substituted with '_'
sub word_so_far {
    join '', map { $guesses{$_} ? $_ : "_" } @word;
}

print word_so_far(), "\n";

for (my $i = 0; $i < $num_guesses; $i++) {
    my $guess = <STDIN>;
    chomp $guess;
    collect_guess $guess;

    if (word_so_far() !~ /_/) {
        # no more letters to guess
        print "LIFE!\n";
        exit;
    }

    print word_so_far(), " ", guesses_so_far(), "\n";
}

# If we ever get here the player ran out of guesses.
print "DEATH!\n";

--=-=-=


Hope you had fun, I did.
-- 
-Marco
Ring the bells that still can ring.
Forget your perfect offering.
There is a crack in everything.
That's how the light gets in.
     -Leonard Cohen

--=-=-=--