#!/usr/bin/env perl

# $Id: qotw4x.pl,v 1.5 2002/11/10 04:13:29 ksundar Exp ksundar $

# Intention: Solve QOTW #4 (Expert).

# Known problems:  See EOF.  Any help would be appreciated.  TIA.

use v5.6.0;
use warnings;
use strict;

use Memoize;
memoize 'partitions';

sub partitions {
    # Partition the number $N into $k chunks, in all possible ways,
    # and return a list of arrays.  Note that this is different from
    # the mathematical notion of partioning, in that ordering
    # matters.  [1, 3, 1] != [1, 1, 3].
    #
    # e.g.: &partitions(5,3) == ([1,1,3], [1,2,2], [1,3,1],
    #                            [2,1,2], [2,2,1], [3,1,1]).
    my ($N,$k) = @_;

    return [$N] if ($k == 1);
    return [] if ($N < $k);
    return [(1)x$N] if ($N == $k);

    # The following has some problems, stemming
    # from my ignorance of array de-referencing.
    # &partitions(5,3) looks like this:
    # (['3',1,1], ['2',2,1], ['1',3,1],
    #  ['2',1,2], ['1',1,3], [1,2,2], [4]).
    # 1. Why are some first elements stringified?
    # 2. Why are some *not* stringified?
    # 3. What is the [4] doing there, for X's sake?
    map {
	my $i = $_;
	map [@$_, $i], &partitions($N-$i, $k-1);
    } (1..$N-1);
} # &partitions

sub canonical {
    # Downcase and sort characters of the word, to get them into a
    # canonical order.
    join("", sort split "", lc shift);
}

sub check_match {
    my @p = @{shift()};
    my $offset = shift;
    my $w2 = shift;
    foreach my $q (@p) {
	my $l = length $q;
	return 1 if ($q eq substr($w2, $offset));
	if ($q eq substr($w2, $offset, $l)) {
	    @p = grep {$_ ne $q} @p;
	    return 1 if &check_match(\@p, $offset+$l, $w2);
	}
    } # foreach
    return 0;
}

sub min_chunks {
    # Keep trying succeedingly larger partitions of $word1 (i.e.,
    # break it into more chunks), until we are able to match $word2.
    my ($word1, $word2) = @_;
    my ($w1, $w2) = (lc $word1, lc $word2);

    # Confirm that $word2 is a non-trivial anagram of $word1.
    $w1 ne $w2
	or die "Error: Give me two *distinct* words, for crying out loud!\n";
    &canonical($w1) eq &canonical($w2)
	or die "Error: '$word1' and '$word2' aren't anagrams!\n";

    my $length = length $w1;
    my $pieces;

    for my $pieces (2 .. $length) {
	my @partitions = &partitions($length, $pieces);

	# Hack to throw out the [4].  :-(
	# See comment in &partitions.
	# Throw out partitions that don't add up to the original
	# number.  Yuck.
	@partitions =
	    grep { my $s = 0; $s+=$_ for @$_; $s==$length }
		@partitions;

	foreach my $p (@partitions) {
	    my @chunks = unpack "a" . join("a", @$p), $word1;
	    if (&check_match(\@chunks, 0, $w2)) {
		# It is not in the specification, but I am printing
		# the chunks of $word1 for visual confirmation that
		# they can be rearranged into $word2.
		$" = "/";
		print "$pieces: @chunks == pieces($word2)\n";
		return $pieces;
	    }
	}
    } # for $pieces
    die "Error: I should never reach here, because I already
    confirmed that $w1 and $w2 are anagrams!";
} # &min_chunks

# __BEGIN__

die "Usage: $0 <word1> <word2>\n"
    unless @ARGV == 2;

$" = ", ";
print "min_chunks(@ARGV) = ", &min_chunks(@ARGV), "\n";

__END__

Known problems:
--------------
Any help would be appreciated in solving these problems.  TIA.

1. &partitions has a bug that I am hacking around using a grep()
   on its output, without understanding the bug.  :-(
   This bug is described in the function itself.

2. There is a separate bug in the nested map()''s of &partitions.
   It showed up on one specific input, but I am unable to
   reproduce it with different inputs:

    || # The buggy case
    || % $0 abcghijkpqdeflmno abcdefghijklmnopq
    || Anonymous function called in forbidden list context; \
    || faulting at ./qotw4x.pl line 40
    || %
    || # Try dropping 'q'
    || % $0 abcghijkpdeflmno abcdefghijklmnop
    || 5: abc/ghijk/p/def/lmno == pieces(abcdefghijklmnop)
    || min_chunks(abcghijkpdeflmno, abcdefghijklmnop) = 5
    || %
    || # Restore 'q'; Try adding 'r'
    || % $0 abcghijkpqrdeflmno abcdefghijklmnopqr
    || 5: abc/ghijk/pqr/def/lmno == pieces(abcdefghijklmnopqr)
    || min_chunks(abcghijkpqrdeflmno, abcdefghijklmnopqr) = 5
    || %
    || # Try adding 'r' elsewhere (not contiguous with 'pq')
    || % $0 abcghijkpqdeflmnor abcdefghijklmnopqr
    || 6: abc/ghijk/pq/def/lmno/r == pieces(abcdefghijklmnopqr)
    || min_chunks(abcghijkpqdeflmnor, abcdefghijklmnopqr) = 6
    || %
    || # Try something unrelated
    || % $0 ./qotw4x.pl abcdefghijklmn nmlkjihgfedcba
    || 14: a/b/c/d/e/f/g/h/i/j/k/l/m/n == pieces(nmlkjihgfedcba)
    || min_chunks(abcdefghijklmn, nmlkjihgfedcba) = 14
    || % 

3. &check_match does not tell you how the pieces of $word1 should
   be ordered to obtain $word2.

peace,                              || From Child Labour to Scholarship
--{kr.pA}                           || http://makeashorterlink.com/?J17F21842
--
"The war [on Iraq] is a weapon of mass distraction."  -- Seen on a placard.
