in reply to Challenge: Mystery Word Puzzle

I ignored assumption #2, but the results of the following code do not violate that assumption (for this example anyway). I get two possible groups of five letters, for the sake of time, I'm not scanning any dictionary for these combinations. Even though it's probably easier to brute force a dictionary, I went the "let's find valid letter groups" route :)
use strict;
use warnings;

my $word = "aaaaa";
my @words;
{
 push @words, $word
 if
   $word =~ tr/bumps// == 2 and
   $word =~ tr/seam//  == 2 and
   $word =~ tr/domes// == 3 and
   $word =~ tr/shake// == 3 and
   $word =~ tr/pokes// == 3 and
   $word =~ tr/dukes// == 3;
 last if $word eq "zzzzz";
 $word = inc_letter($word, 4);
 redo;
}

print "$_\n" for @words;

sub inc_letter {
  my ($word, $i) = @_;
  if (substr($word, $i, 1) eq "z") {
    $word = inc_letter($word, $i-1, 1);
    substr($word, $i, 1) = substr($word, $i-1, 1);
  } else {
    substr($word, $i, 1)++;
  }
  $word;
}

[download]
Update: The puzzle changed; this solution has not. If a general solution is desired, then more work would need to be done here.

Replies are listed 'Best First'.
Re^2: Challenge: Mystery Word Puzzle
by dragonchild (Archbishop) on Jan 12, 2005 at 20:55 UTC
    I came up with code that's a lot more complicated than yours, but gives the same result. 
    my %hints = (
    bumps => 2,
    seams => 2,
    domes => 3,
    shake => 3,
    pokes => 3,
    dukes => 3,
);

my %letters;
foreach my $w (keys %hints)
{
    my %w = make_hash( $w );

    while (my ($k,$v) = each %w)
    {
        $letters{$k} ||= 0;
        $letters{$k} = $v
            if $letters{$k} < $v;
    }
}

my $iter = combo( 5, sort keys %letters );
while ( my @w = $iter->() )
{
    next unless is_legal( @w );
    print @w, $/;
}

sub is_legal
{
    my %w = make_hash( join '', @_ );

    keys %hints;
    while (my ($h, $n) = each %hints)
    {
        my %h = make_hash( $h );

        my $num = 0;
        while (my ($l,$c) = each %h)
        {
            next unless exists $w{$l};
            $num += $c < $w{$l} ? $c : $w{$l};
        }

        return 0 if $num != $n;
    }

    return 1;
}

sub make_hash { my %w; $w{$_}++ for split '', $_[0]; %w }

sub combo {
    my $by = shift;
    return sub { () } if ! $by || $by =~ /\D/ || @_ < $by;
    my @list = @_;

    my @position = (0 .. $by - 2, $by - 2);
    my @stop     = @list - $by .. $#list;
    my $end_pos  = $#position;
    my $done     = undef;

    return sub {
        return () if $done;
        my $cur = $end_pos;
        {
            if ( ++$position[ $cur ] > $stop[ $cur ] ) {
                $position[ --$cur ]++;
                redo if $position[ $cur ] > $stop[ $cur ];
                my $new_pos = $position[ $cur ];
                @position[ $cur .. $end_pos ] = $new_pos .. $new_pos +
+ $by;
            }
        }
        $done = 1 if $position[0] == $stop[0];
        return @list[ @position ];
    }
}

    [download]

    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.

[reply]
[d/l]

In Section Seekers of Perl Wisdom