[rochester-pm-list] Jumble solver

Shawn Porter sporter at rit.net
Mon Jan 10 14:51:08 CST 2000


I'm writing a little script to solve two word Jumbles and I'm having a
strange problem that I can't track down.  Here is what I get when testing
this script:

--
% echo; ./jumble; echo; ./jumble 1

finding: twtowlee, 5
found: towel
1: towel twe
finding: twe, 3
found: wet
2: wet
towel wet

finding: noiiontwsep, 8
found: opinions
found: position
1: position nwe
finding: nwe, 3
found: new
2: new
position new
1: opinions twe
finding: twe, 3

--
With the second set of letters it fails to find the word 'wet' when
searching for a 3 letter word with the letters 'twe' but with the first
set of letters it works fine.  I can't figure out the problem.  Any ideas?

The entire source is below... sorry for the complete lack of comments, I
whipped this out in like 10 minutes then racked my brain for about 20
trying to figure out this problem.... I'm stumped.

-- 
Shawn Porter
http://www.rit.net/sporter
sporter at rit.net

--
#!/usr/bin/perl
if($ARGV[0] == 1)
{
  $letters = "noiiontwsep";
  @groups = (3, 8);
}
else
{
  $letters = "twtowlee";
  @groups = (3, 5);
}

@groups = reverse sort(@groups);

open(WORDS, "/usr/dict/words");
while(<WORDS>)
{
  chomp;
  push(@words, $_);
}
close(WORDS);

my $hashref = superfind($letters, $groups[0]);
my %found = %$hashref;

foreach my $word (keys %found)
{
  print "1: " . $word . " " . $found{$word} . "\n";

  my $hashref2 = superfind($found{$word}, $groups[1]);
  my %found2 = %$hashref2;

  foreach my $secondword (keys %found2)
  {
    print "2: " . $secondword . "\n";
    if($found{$secondword} eq '')
    {
      print $word . " " . $secondword . "\n";
    }
  }
}

sub superfind
{
  my $letters = shift;
  my $length = shift;

  print "finding: $letters, $length\n";

  my %found;
  my @letters;
  until($letters eq '')
  { 
    push(@letters, chop($letters));
  }

  foreach my $word (@words)
  {
    next unless(length($word) == $length);

    my $orig = $word;
    my @used;
    my @unused;
    my @possible = @letters;

    while (@possible)
    {
      my $l = pop(@possible);
      if($word =~ /$l/)
      {
        $word =~ s/$l//;
        push(@used, $l);
      }
      else 
      {
        push(@unused, $l);
      }
    }

    if(scalar(@used) == $length)
    {
      print "found: $orig\n";
      my $unused;
      foreach(@unused) 
      {
        $unused .= $_;
      }
      $found{$orig} = $unused;
    }
  }

  return(\%found);
}




More information about the Rochester-pm mailing list