use strict;
our $I = "";

# $Id: min_chunks.pm,v 1.31 2002/11/11 18:43:09 k Exp k $

sub min_chunks ($$);
sub min_array ($;$);
sub histpack ($);

sub min_chunks ($$) {
  my($w1,$w2) = @_;
  die "Not an anagram: $w1 $w2" unless histpack($w1) eq histpack($w2);
  return 1 if lc $w1 eq lc $w2;
  my @w1 = split //, $w1;
  my @w2 = split //, $w2;
  my($r) = min_array([\@w1,\@w2]);
  local $"="/";
  return scalar @{$r->[0]} unless wantarray;
  (scalar @{$r->[0]}, "@{$r->[0]}", "@{$r->[1]}");
}

sub min_array ($;$) {
  local $I = "  $I";
  my($r) = shift;
  my(@w1) = @{$r->[0]};
  my(@w2) = @{$r->[1]};
  print STDERR "$ {I}min_array(@w1, @w2)\n";
  my $C = shift || {};
  my $best = @w1;
  my $ret = [\@w1,\@w2];
 OUTER: for my $w1i (0..$#w1-1) { # left word
    my $l1 = $w1[$w1i];
  INNER: for my $w2i (0..$#w2-1) { # right word
      my $l2 = $w2[$w2i];
      # warn "w1i[$w1i]l1[$l1]w2i[$w2i]l2[$l2]\n";
      next unless lc $l2 eq lc $l1;
      next unless lc $w1[$w1i+1] eq lc $w2[$w2i+1];
      my @w1c = @w1; # copy
      my @w2c = @w2;
      my $i = 1;
      my $r;
      # Be greedy here. We will find alternate solutions because we
      # check every letter as a starter.
      while ($r = lc $w1[$w1i+$i] and $r eq lc $w2[$w2i+$i]) {
        $w1c[$w1i] .= $r;
        splice @w1c, $w1i+1, 1;
        $w2c[$w2i] .= $r;
        splice @w2c, $w2i+1, 1;
        $i++;
      }
      my($ma,$sig);
      $sig = join "|", join("/",@w1c), join("/",@w2c);
      next if $C->{$sig}++; # what we have called already, needs no redoing
      $ma = min_array([\@w1c,\@w2c],$C) or next;
      if (@{$ma->[0]} < $best) {
        $ret = $ma;
        $best = @{$ma->[0]};
      }
    }
  }
  $ret;
}

sub histpack ($) {
  my $word = shift;
  join "", sort split //, lc $word;
}

my $z = min_chunks('xylinid', 'xylidin');
print "$z\n";
1;
