#!/usr/bin/perl -w

# hangman-player
#
# Copyright (C) 2001  Joe Edmonds <joe@elem.com>
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

# DESCRIPTION
#
# This is a perl program that plays hangman.  The interface is very
# simple.  You type the current status of the guessed letters and
# blanks followed by a linefeed and it guesses the most likely letter
# to appear in that word.
#
# Hangman-player remembers what letters it has already guessed.  So in
# order to start a new game of hangman, end the session with Ctrl-D.
#
# In order to make the best possible guess, hangman-player searches a
# dictionary file which must contain the word.
#
# Hangman-player works quite well with Ken Arnold's terminal hangman
# program.  You can just cut and paste the current known words from
# hangman into hangman-player.
#
# To understand how it works, just read the nicely-documented (?) code
# below.

use strict;

# you may modify this to point to your word list
my $dictfile = '/usr/share/dict/words';

# support a "verbose" option which causes hangman-player to display
# the words and letters on which it's basing its guess
my $arg = shift;
my $verbose =  (defined $arg and $arg eq '-v')?1:0;

# read all the words in the dictionary into an in-core array where
# they can be quickly accessed
my @words;
open(DICT,"<$dictfile") || die "unable to open $dictfile for reading";
while(<DICT>) {
  chomp;
  push @words, $_;
}
close DICT;

# the list of letters that the program has already guessed
my %guessed_letters;

while (my $regexp = <>) {
  chomp $regexp;

  # create a regexp fragment that represents what the unguessed
  # letters could be
  my $unguessed_letters = scalar(%guessed_letters) ?
    '[^'.join('',keys %guessed_letters).']' : '.';

  # replace dashes with wildcards
  $regexp =~ s/[-._]/$unguessed_letters/g;
  print "regexp: $regexp\n" if ($verbose);

  # find all the words that match the regexp
  my @matching_words = grep(/^$regexp$/,@words);
  print join(',',@matching_words),"\n" if ($verbose);

  # generate a hash that maps the letters of the alphabet to the
  # number of words that contain that letter and match the regexp
  my %letter_frequencies = ();
  foreach my $letter ('a'..'z') {
    foreach my $word (@matching_words) {
      $letter_frequencies{$letter}++ if ($word =~ /$letter/);
    }
  }

  # take already-guessed letters out of the running
  foreach my $guessed_letter (keys %guessed_letters) {
    delete $letter_frequencies{$guessed_letter};
  }

  # create a list of letters ordered by their likelihood of appearing
  # in one of the unguessed spaces
  my @letter_likelihood
    = sort { ( $letter_frequencies{$b} <=> $letter_frequencies{$a} ) }
      (keys %letter_frequencies);

  # add the letter we're about to guess to the list
  $guessed_letters{$letter_likelihood[0]}++;

  # and print the letter
  print $letter_likelihood[0];
  print "(".join(',',keys(%guessed_letters)).")" if ($verbose);
  print "\n";
}