
use strict;

sub min_chunks ($$) {
  my($w1,$w2) = @_;
  die "Not an anagram: $w1 $w2" unless histpack($w1) eq histpack($w2);
  my @w1 = split //, $w1;
  my @w2 = split //, $w2;

  my($r) = min_array([\@w1,\@w2]);

  local $"="/";
  # warn "w1[@$r1]w2[@$r2]\n";
  return scalar @{$r->[0]} unless wantarray;
  (scalar @{$r->[0]}, "@{$r->[0]}", "@{$r->[1]}");
}

sub min_array {
  my($r) = shift;
  my $depth = shift || 0;
  my(@w1) = @{$r->[0]};
  my(@w2) = @{$r->[1]};
  my $C = shift || {};
  # print "depth[$depth]C[$C->{$stamp}]stamp[$stamp]\n";
  my $best = @w1;
  my $ret = [\@w1,\@w2];
 OUTER: for my $w1i (0..$#w1-1) {
    my $l1 = $w1[$w1i];
    for my $w2i (0..$#w2-1) {
      my $l2 = $w2[$w2i];
      next unless lc $l2 eq lc $l1;
      my $r1 = $w1[$w1i+1];
      my $r2 = $w2[$w2i+1];
      next unless lc $r1 eq lc $r2;
      #warn "depth[$depth]w1i[$w1i]l1[$l1]r1[$r1]w2i[$w2i]l2[$l2]r2[$r2]";
      my $ma;
      my @w1c = @w1;
      $w1c[$w1i] .= $r1;
      splice @w1c, $w1i+1, 1;
      my @w2c = @w2;
      $w2c[$w2i] .= $r1;
      splice @w2c, $w2i+1, 1;
      my $sig;
      $sig = join "|", join("/",@w1c), join("/",@w2c);
      next if $C->{$sig}++;
      $ma = min_array([\@w1c,\@w2c],$depth+1,$C) or next;
      if (@{$ma->[0]} < $best) {
        $ret = $ma;
        $best = @{$ma->[0]};
        last OUTER if $best==1;
      }
    }
  }
  $ret;
}

sub histpack ($) {
  my $word = shift;
  my(%hist);
  for (split //, $word) {
    $hist{lc $_}++;
  }
  my($pack) = "";
  for (sort keys %hist) {
    $pack .= sprintf "%s%s", $_, $hist{$_}==1 ? "" : $hist{$_};
  }
  $pack;
}

1;

