Hangman

So I'll confess that I've had a big crush on Haskell for a couple of years now. I've tried and failed many times to really get beyond trivial code, but I'm utterly fascinated by the code one can write with strong, static typing. It can feel contrived at times and very constraining, but I can definitely see the benefits, which is why I'm so excited that Perl 6 has (gradual) types!

I've been working through Haskell Programming From First Principles for a year or so, and I made it to the Hangman game example. After getting a working program in Haskell, I wanted to see how quickly/easily I could do the same in Perl. While working through this code, I found that Perl's type system wasn't able to catch logical errors that Haskell would -- for example, I started off using a string for the "state" of the game where underscores represent unguessed characters, but I decided to move to an array and Perl was unable to find (at compile time) a place in my Puzzle class where I failed to make the appropriate change.

Still, I find this code extremely compact and readable. It was really fun to write this!

Here's an example of a game I won:

$ ./hangman.pl6
puzzle = _ _ _ _ _ _ _ []
What is your guess? a
puzzle = _ _ _ _ _ _ _ [a]
What is your guess? i
puzzle = _ _ _ _ _ _ _ [ai]
What is your guess? e
puzzle = _ e _ _ _ e _ [aei]
What is your guess? o
puzzle = _ e _ _ _ e _ [aeio]
What is your guess? u
puzzle = _ e _ _ u e _ [aeiou]
What is your guess? s
puzzle = _ e s _ u e _ [aeiosu]
What is your guess? t
puzzle = _ e s _ u e _ [aeiostu]
What is your guess? r
puzzle = r e s _ u e r [aeiorstu]
What is your guess? c
puzzle = r e s c u e r [aceiorstu]
You won!

And here is the code. Comments and suggestions welcome! This was my first Perl 6 object code.

#!/usr/bin/env perl6

class Puzzle {
has Str $.word;
has Str @.state;
has Int %.guesses;

submethod BUILD (Str :$word) {
$!word = $word;
@!state = '_' xx $word.chars;
}

method Str {
"puzzle = {@.state.join(' ')} [{%.guesses.keys.sort.join}]";
}

method guess (Str $char) {
unless %.guesses{ $char }++ {
for $.word.indices($char) -> $i {
@.state[$i] = $char;
}
}
}

method was-guessed (Str $char) {
return %.guesses{ $char }.defined;
}

method number-guessed {
return %.guesses.keys.elems;
}

method is-solved {
none(@.state) eq '_';
}
}

sub MAIN(Int :$num-guesses = 10, :$min-word-len=5, :$max-word-len=9) {
my $words = '/usr/share/dict/words';
my $word = $words.IO.lines.grep(
{$min-word-len <= .chars <= $max-word-len}).pick.lc;
my $puzzle = Puzzle.new(word => $word);

loop {
put ~$puzzle;
if $puzzle.is-solved {
put "You won!";
last;
}

if $puzzle.number-guessed >= $num-guesses {
put "Too many guesses. The word was '$word\.' You lose.";
last;
}

my $guess = (prompt "What is your guess? ").lc;
if $guess !~~ m:i/^<[a..z]>$/ {
put "Please guess just one letter";
next;
}

if $puzzle.was-guessed($guess) {
put "You guessed that before!";
next;
}

$puzzle.guess($guess);
}
}

Leave a comment

About Ken Youens-Clark

user-pic I work for Dr. Bonnie Hurwitz at the University of Arizona where I use Perl quite a bit in bioinformatics and metagenomics. I am also trying to write a book at https://www.gitbook.com/book/kyclark/metagenomics/details. Comments welcome.