#!/usr/bin/perl -w

=head1 My solution

To solve the "expert" quiz, I first had to (at least theoretically) solve
the "novice" quiz. So, how do you find out if two words are anagrams of
each other? Either you can go, character by character, through one word
and see if you find the character exactly once in the second word - or 
you just can "sort the letters alphabetically", and if both words give 
the same result, bingo - they are anagrams.

Example: If you sort the characters in "halls", you get "ahlls".
         If you sort the characters in "shall", you get "ahlls", too.
	 Therefore, "halls" and "shall" are anagrams

Now, how does this match with the expert quiz?

In the "novice" quiz, we have to shuffle characters aroud.

So, in the "expert" quiz, we just shuffle *chunks* around!

We first have to find all possible "breakdowns" of a word, then sort
the chunks alphabetically, giving us something we can compare to get 
the minimal number of chunks.

Oh, and this implementation uses memory in the order of 2^n, where "n"
is the length of your words (two hashes with 2^(n-1) elements, giving 2^n).
So, on 32bit platforms, don't try 33 character words...

Here's the code:

=cut

use strict;

# make_gram: builds the "gram" of a word
#
# Oh, you don't know what a "gram" is? Well, it's kind of a "histogram" 
# for the "anagram", so i called it "gram", for lack of a better name.
#
# It's a list of sorted "breakdowns" of a word. There are always 2^n
# ways to separate any given word (of length "n+1"), since for every 
# space "between" two characters, you can either separate the characters
# or not. So you can basically count in binary and get all the possible
# "breakdowns" for a word:
#
# example: car: 00 => 1 chunk:  "car"          sorted "car"
#               01 => 2 chunks: "ca", "r"      sorted "ca", "r"
#               10 => 2 chunks: "c", "ar"      sorted "ar", "c"
#               11 => 3 chunks: "c", "a", "r"  sorted "a", "c", "r"
#
# By then comparing the two "grams" for two words, we can determine
# the minimum amount of "chunks" that make them anagrams (for they will
# be equivalent in the sorted version)
#
# The return value of this function is a hashref with the "sorted 
# breakdowns", separated by slashes, as keys. So, the example for "car"
# it is a hashref with the following keys: ('car', 'ca/r', 'c/ar', 'c/a/r').
# The hash values don't matter (and are undef, in fact)

sub make_gram ($) {
  my($word) = @_;

  my $gram;
  my $n = length($word)-1;
  for(my $i = 0; $i < 2**$n; $i++) {
    my @bits = split //, sprintf "%0${n}b", $i;
    my @chunks;
# Now "splice off" the chunks wherever $bits has a 1
    my $lastcutpoint = 0;
    for(my $j = 1; $j <= $n; $j++) {
      if($bits[$j-1]) {
	push @chunks, substr($word, $lastcutpoint, $j-$lastcutpoint);
	$lastcutpoint = $j;
      }
    }
    push @chunks, substr($word, $lastcutpoint);
    $gram->{join('/', sort @chunks)} = undef;
  }
  return $gram;
}

# min_chunks: the final frontier<ctrl-w>function. Quite easy, now
# that we've done the hard work!

sub min_chunks ($$) {
  my(@words) = @_;
  my(@grams);

# build "gram" hashes for both words

  $grams[0] = make_gram lc $words[0];
  $grams[1] = make_gram lc $words[1];

# the "best case" would be a chunk size of not more than one character,
# yielding $min_chunks equal to the length of the words
  my $min_chunks = length $words[0];

# but let's see if we find fewer!
# if two "gram keys" are equivalent, we have a common "breakdown".
# if then the number of chunks in this "breakdown" is less than the current
# $min_chunks, we found a new candidate

  foreach my $gram (keys %{$grams[0]}) {
    if(exists $grams[1]{$gram}) {
      my $chunks = ($gram =~ tr|/||)+1;
      $min_chunks = $chunks if $chunks < $min_chunks;
      # DEBUG print STDERR "found $chunks chunks: $gram\n";
    }
  }

  return $min_chunks;
}

# Now comes the "Use the function to generate interesting anagrams" part...
# 
# It assumes that we get the output of a "novice" solution on standard 
# input, and optionally a "threshold" for the minimal number of chunks
# to output as first argument. If not given, it assumes 4.
#
# And yes, its handling of "anagram sets" in the input which consist
# of more more than two words is highly # suboptimal, as it calls the
# (very expensive) make_gram function multiple times.

use vars '$treshold';
$treshold = shift || 4;

my %seen;

while(<>) {
  chop;
  next if /\(/; # skip lines that only reference others
  my(@anagrams) = split;

  if(@anagrams == 2) {
    next if exists $seen{$anagrams[1]};
    $seen{$anagrams[0]} = undef; # so we don't come by next time

    &handle_pair(@anagrams);
  } else {
    for(my $i = 0; $i < @anagrams; $i++) {
      for(my $j = $i + 1; $j < @anagrams; $j++) {
	&handle_pair($anagrams[$i], $anagrams[$j]);
      }
    }
  }
}

sub handle_pair {
  my $mc = min_chunks($_[0], $_[1]);
  if($mc >= $treshold) {
    printf "%02d %s %s\n", $mc, $_[0], $_[1];
  }
}

# Just for some curiosity: the "test data" given by Mark Jason
# decomposes into the following "minimum winning grams":
#
# 3 bade bead (ad/b/e)
# 4 glare lager (e/g/la/r)
# 8 precipitate peripatetic (ate/c/e/i/ip/p/r/t)
# 4 prefect perfect (e/fect/p/r)
# 4 trout tutor (o/r/t/ut)
# 4 alarm lamar (a/ar/l/m)
# 4 assist stasis (as/is/s/t)
# 3 egret greet (e/gre/t)
# 4 virgin irving (g/in/ir/v)
# 3 ramada armada (a/mada/r)

