
use Memoize;
memoize('_min_chunks');

# min_chunks
#
# This function takes 2 words and returns an array of word-chunks
# that can be used to recreate either word.  It is intended to
# return the smallest list of word-chunks possible.

sub min_chunks {
  my $word1 = shift;
  my $word2 = shift;

  return unless is_anagram($word1, $word2);
  return _min_chunks($word1, $word2);
}

# _min_chunks
#
# A helper function that should not be called directly.  It accepts a
# word and an array of word chunks.  It splits the word into 2 pieces
# and tries to find the first piece in one of the chunks of the chunk-list.  
# If a match is found, the matching piece is split out of the chunk, and 
# the function recursively calls itself using the second unused piece, and 
# the newly updated chunk-list.
# Recursion ends when _min_chunks is called with only two elements and they are equal
#
# example:
#   _min_chunks('tacos', 'ascot');
#
#  split 'tacos' in 4 different ways ('taco', 's'), ('tac', 'os'),('ta','cos'),('t', 'acos')
#    match 'taco' against 'ascot' => no match
#    match 's' against 'ascot' => match => split 'ascot' into 'a', 'cot' => call_min_chunks('taco', 'a', 'cot'')
#    match 'tac' against 'ascot' => no match
#    match 'os' against 'ascot' => no match
#    match 'ta' against 'ascot' => no match
#    match 'cos' against 'ascot' => no match
#    match 't' against 'ascot' => match => split 'ascot' into 'asco' => call_min_chunks('acos', 'asco')
#    match 'acos' against 'ascot' => no match
# if you follow this through recursively, then you will see that every combination of chunks of tacos
#  will be checked against ascot


sub _min_chunks {
  my $word   = shift;
  my @chunks = @_;

  # At the end we will just have one word and one list item that are equal to each other
  #  ie we might get 'em' and 'em'
  #  This signals the end of the recursion
  return $word if (@chunks == 1 && $word eq $chunks[0]);

  # Find the biggest chunk we have so far
  my $max_chunk=0;
    foreach my $chunk (@chunks) {
    $max_chunk = length($chunk) if length($chunk) > $max_chunk;
  }

  # prefill @shortest with the current shortest list we know about 
  #  ie the longest possible chunk list
  my @shortest = split '', $word;

  # Main loop:  loop once for every letter but one in $word
  for(my $i=1; $i < length($word); $i++) {

    # Second loop:  always loops 2 times so we can test both chunks when we split a word
    #               ie if $word='tacos' and $i=2 then on the first iteration of the second loop
    #                  $part='cos' and $newword='ta'.  On the second iteration they swap, so
    #                  $part='ta' and $newword='cos'.
    foreach my $which (0..1) {
      my $part    = ( $which) ? substr($word, 0, $i) : substr($word, $i);
      my $newword = (!$which) ? substr($word, 0, $i) : substr($word, $i);
      next if length($part) > $max_chunk; # the part we're matching is too long so skip it

      # Third loop:  Try to match $part against all of the @chunks we have
      for(my $j=0; $j < @chunks; $j++) {
        my $piece = $chunks[$j];

        # Fourth loop:  this $part might match more than once in a given chunk
        #               ie.  if $part='abc' and $piece='abcdeabc' then there
        #                    are 2 spots where 'abc' will match, and we should
        #                    check them both
        my $lastposition=0;
        while ((my $index = index($piece, $part, $lastposition)) >= 0) {
          $lastposition = $index+1;

          # Generate a new list of 'chunks' (we split out the part we found and remove it)
          # For example, if we had the following list and part:
          #   $part='path'
          #   @chunks=('anatomic', 'opathological')
          # we would get a new list without the 'path' in it
          #   newchunks = (anatomic, o, ological)
          my @newchunks = ();
          push @newchunks, @chunks[0..$j-1] if $j > 0;
          push @newchunks, substr($piece, 0, $index) if $index > 0;
          push @newchunks, substr($piece, $index+length($part)) if $index+length($part) < length($piece);
          push @newchunks, @chunks[($j+1)..$#chunks] if $j < $#chunks;

          # Recursively call ourselves with a shorter $word and longer list of chunks
          my @newlist = _min_chunks($newword, @newchunks);

          # We should now have the shortest list of chunks for $word, except the
          # $part we removed above so we add it back in
          push @newlist, $part;

          # See if this list of chunks is shorter than what we have found so far
          @shortest = sort @newlist if @newlist <= @shortest;
        }
      }
    }
  }
  return @shortest;
}

sub is_anagram {
  return (sort unpack 'C*', lc $_[0]) eq (sort unpack 'C*', lc $_[1]);
}

