There's already a Golf out there that allows the player to play hangman; here, we'll reverse it and look at a two-parter golf that could be used to develop a Hangman player.

Part 1
Given a string, composed of a-z and the underscore '_' character, and a reference to an array of dictionary words, return an array of words that matches the hangman pattern as defined by the string. Examples, assuming that the ref to the dictionary array is taken from something like /usr/words/dict: 

@matches = f("____", \@dict);  # @matches would be every 4 letter word
+ in @dict
@matches = f("__rl", \@dict);  # @matches could include 'earl', 'perl'
+, 'curl', etc.

[download]

Part 2
Given the same string as above, the list of words that were matched, and a array of characters that have already been 'guessed' by the hangman player, return a character within a-z that is not in the array of guessed characters that appears the most in the possible word list. As an example: 

$string = "s__s";
@letters_guessed = qw( s e );
@possible_words = qw( suns sets sees saws skis sews sits );

$guess = g( $string, \@possible_words, @letters_guessed );

[download]
While 'e' would be the letter that would match 3 out of these 7 words, it has already been guessed and cannot be selected. So out of the rest of the remaining letters, only 'i', 't' or 'w' would get 2 out of 7 words, so either could be returned (programmer's choice).

Extra Credit for Part 1
Effectively add the list of guessed characters to this part such that the underscore characters can only be replaced by characters that are NOT on this list.

-----------------------------------------------------
Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain
It's not what you know, but knowing how to find it if you don't know that's important

Replies are listed 'Best First'.
Re: (Golf) Hangman Player
by japhy (Canon) on Oct 04, 2001 at 20:24 UTC
    Part 1: 
    # 39 chars
sub f {
  #23456789_123456789_
  my($p,$d)=@_;$p=~tr
  /_/./;grep/^$p$/,@$d
}

    [download]
    Part 1 with E/C: 
    # 60 chars
sub f {
  #23456789_123456789_123456789_
  my($p,$d)=@_;my@c=$p=~/[^_]/g;
  $p=~s/_/[^@c]/g;grep/^$p$/,@$d
}

    [download]
    Part 2: 
    # 123 chars
sub g {
  #23456789_123456789_123456789_123456789_12
  my($p,$d,@l)=@_;$p=~s/_/[^@l]/g;$_=join''
  ,sort+map{split//}grep/$p/i&&s/[@l]//g,@$d
  ;$p=y;;;c;/(.)\1{$p}/&&return$1while--$p
}

    [download]

    _____________________________________________________
    Jeff[japhy]Pinyan: Perl, regex, and perl hacker.
    s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;

[reply]
[d/l]
[select]
Re: (Golf) Hangman Player
by gbarr (Monk) on Oct 04, 2001 at 20:54 UTC
    Part 1 - 41 chars

    sub f{
#2345678901234567890123456789012345678901
(my$i=shift)=~y/_/./;grep/^$i$/i,@{$_[0]}
}

    [download]
    Part 1 with xtra credit - 55 chars

    sub f{
#234567890123456789012345678901234567890123456789012345
my$a=shift;(my$b=$a)=~s/_/[^$a]/gi;grep/^$b$/i,@{$_[0]}
}

    [download]

    Part 2 may follow later, but I have to get back to work :(

[reply]
[d/l]
[select]
Re: (Golf) Hangman Player
by suaveant (Parson) on Oct 04, 2001 at 21:54 UTC
    Part 1 with extra credit (since that is the only way it should be done) and matching case insensitive 
    sub f {
($a=shift)=~s/_/[^$a]/g;grep/^$a$/i,@{$_[0]}
#23456789_123456789_123456789_123456789_1234
}

    [download]
    44 chars

    Update I screwed up and didn't do most frequent char... now I have both... 

    sub g {
shift;for(@{+shift}){s/[@_]//g;$c{$_}++for split//}(sort{$c{$b}<=>$c{$
+a}}%c)[0]
#23456789_123456789_123456789_123456789_123456789_123456789_123456789_
+123456789
}

    [download]
    Done the right way I get 79 chars for part B
    sub g {
shift;for(@{+shift}){s/[@_]//g;$b||=chop}$b
#23456789_123456789_123456789_123456789_123
}

    [download]
    43 chars without most common char (the wrong way :)

                    - Ant
                    - Some of my best work - Fish Dinner

[reply]
[d/l]
[select]
      I can shorten it to 43. 
      sub f {
($a=shift)=~s/_/[^$a]/g;grep/^$a$/i,@{+pop}
#23456789_123456789_123456789_123456789_123
}

      [download]

      _____________________________________________________
      Jeff[japhy]Pinyan: Perl, regex, and perl hacker.
      s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;

[reply]
[d/l]
Re: (Golf) Hangman Player
by jj808 (Hermit) on Oct 04, 2001 at 19:40 UTC
    Here's part 1: 
    #! /usr/bin/perl -w
 
use strict;
 
open WORDS,"</usr/dict/words";
my @words = (<WORDS>);
close WORDS;
 
my @guessed = qw(a b c r l);
my @matches = f("__rl",\@words,\@guessed);
print foreach (@matches);
 
#--------------------------------------
 
sub f{
  my ($guess,$wordref,$letterref) = @_;
  my @m = ();
  my $alphabet = join"|",('a'..'z');
  my $guessed  = join"|",@$letterref;
  $alphabet =~ s/$guessed//g;
  $guess =~ s!_![$alphabet]!g;
  foreach (@$wordref) {
    push @m,$_ if (/\b$guess\b/)
  }
  return @m;
}
 
#--------------------------------------

    [download]
    OK, it's not very short but it does the job. I'll have a go at part 2 this evening.

    JJ

[reply]
[d/l]
      Using your framework, I got f() down to 97. 
      ($a=join"|",a..z)=~s/join"|",@{pop@_}//eg;($g=shift)=~s!_![$a]!g;/^$g$
+/&&push@m,$_ for@{pop@_};@m

      [download]
      If I could change the order of the arguments, I could cut 2 characters by make the shift a pop. I am a little perplexed as to why @{pop@_} won't let me do a @$_[0], which would cut another 3 characters. *shrugs*

      Update: I feel slightly inadequate after reading japhy's contributions. *sighs*

      ------
      We are the carpenters and bricklayers of the Information Age.

      Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.

[reply]
[d/l]
        The reason is this: 
        @$_[0] => @{$_}[0] => (@$_)[0]

        [download]

        _____________________________________________________
        Jeff[japhy]Pinyan: Perl, regex, and perl hacker.
        s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;

[reply]
[d/l]
Re: (Golf) Hangman Player
by patgas (Friar) on Oct 04, 2001 at 20:56 UTC

    Okay, I gave it a shot:

    sub f {
# 38 characters
# ($a,$b)=@_;$a=~s/_/./g;grep{/^$a$/}@$b

# UPDATE: After seeing everyone use y///, I decided to join in:
# 37 characters
($a,$b)=@_;$a=~y/_/./;grep{/^$a$/}@$b
}

sub g {
# 186 characters
# my($c,$d,@e)=@_;my$g='[^'.(join'',@e).']';$c=~s/_/$g/ge;my(%f,$j,@i)
+;for$j(grep{/$c/}@$d){map{$f{$_}+=($j=~s/$_/$_/g)}(grep{/$g/}('a'..'z
+'))}@i=(sort{$f{$a}<=>$f{$b}}keys%f);return pop@i

# UPDATE: I forgot that you didn't have to join the list...
# 166 characters
my($c,$d,@e)=@_;$c=~s/_/[^@e]/ge;my(%f,$j,@i);for$j(grep{/$c/}@$d){map
+{$f{$_}+=($j=~s/$_/$_/g)}(grep{/[^@e]/}('a'..'z'))}@i=(sort{$f{$a}<=>
+$f{$b}}keys%f);return pop@i
}

    [download]

    These seem to work with my test cases, but I'm sure someone can break them... This was a fun one, thanks Masem.

    Update: There weren't any answers when I started, and I noticed after I finished posting that my solution to Part 1 is almost the same to japhy's. Before anyone leaves a note, I didn't rip him off... Actually, I'm pretty pleased with myself that I had the same idea as the Lord of all Regexes himself.

    "We're experiencing some Godzilla-related turbulence..."

[reply]
[d/l]

Back to Meditations