#!/usr/local/bin/perl -w

# Dan Boger
# 11/8/02 - QOTW expert quiz
# it's not as optimized as it could be, but it still takes only a few seconds
# to run - mostly because of memoize :)

use strict;
use Memoize;
memoize('GenKey');
memoize('FindChunks');
my %chunks;

while (<DATA>) {
  next unless /\S/; # skip blank lines
  my ($min, $matches) = &min_chunks(split ' ');
  print "$min: @$matches\n";
}
  
sub min_chunks {
  my ($word1, $word2) = @_;

  # find all the ways to break up the word
  my %chunks1 = map {&GenKey($_) => $_} &FindChunks($word1);
  %chunks = (); # have to reset this global var
  
  my @matches;
  my $min_chunk;
  foreach my $chunk2 (&FindChunks($word2)) {
    # we don't care about solutions that don't work for both words
    next unless exists $chunks1{&GenKey($chunk2)};

    # how many chunks are in this solution
    my $level = $chunk2 =~ tr/\//\//;

    # store them by level
    push @{$matches[$level]}, ( $chunk2, $chunks1{&GenKey($chunk2)} );

    # keep track of the minimal solution
    $min_chunk = $level if ! defined $min_chunk or $level < $min_chunk;
  }

  return wantarray ? ($min_chunk+1, $matches[$min_chunk]) : $min_chunk + 1;
}

sub GenKey {
  # generate a unique key for all solutions that use the same chunks
  my $data = shift;
  return join "/", sort split /\//, lc $data; 
}

sub FindChunks {
  # break given word in all possible ways - recursive
  my $word = shift;

  if (length($word)== 1) {
    # end of the recursion
    return $word;
  }
  
  my @sub_chunks = ( $word );
  # recurse on each possible split
  for my $index (1 .. length($word)-1) {
    foreach my $c1 (&FindChunks(substr($word,0,$index))) {
      foreach my $c2 (&FindChunks(substr($word,$index))) {
        # save this solution, but try to avoid duplicates
        push @sub_chunks, "$c1/$c2" unless $chunks{"$c1/$c2"}++;
      }
    }
  }
  return @sub_chunks;
}

__DATA__
bade bead
glare lager
precipitate peripatetic
prefect perfect
trout tutor
alarm lamar
assist stasis
egret greet
virgin irving
ramada armada


-- 
Dan Boger
dan@peeron.com
