#!/usr/bin/perl -w
use strict;
use Memoize;
memoize('flatten');
memoize('get_perms');

for my $test (split /\n/, <<TESTS) {
3 abbe babe
2 abc cab
4 abed bade
3 abed bead
3 bade bead X
TESTS
  my ($n, $w1, $w2, $X) = split /\s+/, $test;
#  next unless $X;
  my $an = min_chunks($w1, $w2);
  print "$w1/$w2 $n $an\n"
}

sub min_chunks {
    my ($string1, $string2) = @_;
    ($string1,$string2) = (lc($string1),lc($string2));
    my (%substrs, %shared);

    # find valid patterns in $string1
    for (my $x=length $string1; $x > 0; $x--) {
        for (0..(length($string1) - $x)) {
            my $current = substr($string1,$_,$x);
            $substrs{$current}++
        }
    }

    # find all patterns from $string1 occuring in $string2
    my $max = 1;
    my @patterns;
    push @patterns, ($_)x$substrs{$_} for keys %substrs;
    foreach my $pat (@patterns) {
        $shared{$pat}++ if (index($string2,$pat) > -1);
    }

    # find permutations
    my @total;
    push @total, ($_)x$shared{$_} for keys %shared;
    my @perm = get_perms($string2,\@total);

    # flatten tree
    my @flattened = flatten(@perm);

    # filter out bad matches
    my @filtered;
    FILTER: while (@flattened) {
        my $current = shift @flattened;
        my $copy = $current;
        my @chunks = grep{$_}(split /\//,$copy);
        $copy =~ tr!/!!d;
        next unless length $string2 == length $copy;
        my $string = $string1;
        # fixed filtering here
        while (@chunks) {
            my $cur = shift @chunks;
            if (index($string,$cur) > -1) {
                substr($string,index($string,$cur),length $cur) = " ";
            }
            else {
                next FILTER;
            }
        }
        push @filtered, $current;
    }

    # find lowest
    my $lowest = length $string2;
    while (@filtered) {
        my $set = shift @filtered;
        my $copy = $set;
        my $count = $set =~ tr!/!!d;
        $lowest = $count if $count < $lowest;
    }
    return $lowest;
}

sub get_perms {
    my ($string,$perms) = @_;
    my @new_perm;

    for (my $x=0; ($x < @$perms) && (length $string > 0); $x++) {
        if (index($string,$perms->[$x]) == 0) {
            my %bad;
            for (my $y=0; ($y < @$perms) && (length $string > 0); $y++) {
                $bad{$perms->[$y]} = $y if (   
(index($string,$perms->[$y]) == 0)
                                            && (!exists $bad{$perms->[$y]})
                                           );
            }
            my @copy = @$perms;
            # added 'reverse sort'
            foreach (reverse sort values %bad) {
                splice @copy,$_,1;
            }
            my $temp = $string;
            substr($temp,0,length $perms->[$x]) = "";
            push @new_perm, [$perms->[$x], get_perms($temp, \@copy)];
        }
    }
    return @new_perm;
}

sub flatten {
    my @refs = @_;
    my @new;
    my $text = shift @refs unless ref $refs[0];
    foreach my $match (@refs) {
        if (ref($match) eq 'ARRAY') {
            push @new, [flatten(@$match)];
        }
        else {
            push @new, $match;
        }
    }

    my @proc;
    foreach my $match (@new) {
        if (ref($match) eq 'ARRAY') {
            foreach my $item (@$match) {
                $item = $text.'/'.$item;
            }
            push @proc, @$match;
        }
        else {
            $match = $text.$match;
            push @proc, $match
        }
    }
    return (@proc) if @proc;
    return ($text);
}

