sub pattern{
  my $slot = 'a';
  my %slots = ();
  my $pattern = "";
  for( split//, $_[0] ){
     $pattern .= $slots{$_} ||= $slot++;
  }
  $pattern;
}

sub match_crypto {
  my $pattern = pattern($_[0]);
  my $len = length $pattern;
  my @matches = grep{length == $len && pattern($_) eq $pattern} @dict;
}
[download]

The function takes the obvious parameters to it, a pattern and the word.

sub match { 
  my $pattern=shift; 
  my $word=shift; 
   
  ## have to be exact 
  return unless length($pattern) == length($word); 
   
  my %seen; 
  my @pattern=split //,$pattern; 
  my @word=split //,$word; 
 
  for my $let (@word) { 
    my $pat=shift @pattern; 
    ## if this is a new pattern, make sure it doesn't 
    ## match a previous letter 
    if (!defined $seen{$pat}) { 
      ## bad if this letter exists 
      return if grep /$let/,join("",values %seen); 
      ## it's OK, 
      $seen{$pat}=$let; 
    } 
    else { 
      ## must be the same 
      return if $seen{$pat} ne $let; 
    } 
    ## tis good 
  } 
  1; 
}
[download]

any senselessness you detect is due to medication

First of all, I'm not a perl monk, so my coding style isn't quite as pretty as yours. I have to stare at stuff like:

return if grep /$let/,join("",values %seen);
[download]

for about 3 minutes before I say "ok, I know what you're doing, but I didn't know you could do that..." :)

I did find the bug in my code before I saw your solution, but yours is obviously more elegant. I just might steal your version. :)

As for using this as a brute force decrypter -- yes, it is easy in theory. But it takes me about 4 hours to code up the thing you just saw above. Writing the entire thing is not a trivial task for me.

Can you give me some tips on how I should approach the rest of the problem? So far, my approach has been pretty unelegant. What's the best way to recurse through all the possible words for each codeword? I have written a program that generates a partial cipher alphabet and compares two cipher alphabets to see how many entries mismatch. I'm concerned about doing the recursive part in a dumb way and eating up a ton of memory resources unnecessarily.

Thanks again for all your help guys.

if (exists $slots{$pattern[$i]}) {
  next WORDS unless $slots{$pattern[$i]} eq $letters[$i];
}
else {
  $slots{$pattern[$i]} = $letters[$i];
}
foreach $key (keys %slots)
  next if ($key eq $pattern[$i]);                #
  next WORDS if ($slots{$key} eq $letters[$i]);  # <- HERE
}                                                #
[download]

buckaduck