
use strict;

# Find and return the $n'th permutation
# of the remaining arguments in some canonical order
sub permutation_n {
  my $n = shift;
  my @result;
  while (@_) {
    ($n, my $r) = (int($n/@_), $n % @_);
    push @result, splice @_, $r, 1;
  }
  \@result;
}

sub split_word {
  my ($word) = @_;
  my %graph;
  for my $index (0 .. length($word) - 1) {
    my $ch = substr $word, $index, 1;
    push @{$graph{$ch}{pos}}, $index;
    $graph{$ch}{max} = 1 unless defined $graph{$ch}{cur};
    $graph{$ch}{max} *= @{$graph{$ch}{pos}};
    $graph{$ch}{cur} = 0;
  }
  for my $ch (keys %graph) {
    $graph{$ch}{perm} = [@{$graph{$ch}{pos}}];
  }
  %graph;
};

sub next_permutation {
  my $o = shift;
  my $DONE = 0;
  for (values %$o) {
    if (++$_->{cur} == $_->{max}) {
      $_->{cur} = 0;
      $_->{perm} = [@{$_->{pos}}];
    } else {
      $_->{perm} = permutation_n($_->{cur}, @{$_->{pos}});
      $DONE = 1;
      last;
    }
  }
  return $DONE;
}

sub count_chunks {
  my $prev = -2;
  my $chunks = 0;
  for (@_) {
    $chunks++ unless $_ == $prev+1;
    $prev = $_;
  }
  $chunks;
}

sub min_chunks {
  my ($given, $target) = @_;
  my %o = split_word($given);
  my @targ = split //, $target;
  my $chunks = 99999999;
  my @best_mapping;

  while (1) {
    my @mapping;
    my %letct;
    for (@targ) {
      push @mapping, $o{$_}{perm}[$letct{$_}++||0];
    }
    my $map_chunks = count_chunks(@mapping);
    if ($map_chunks < $chunks) {
      $chunks = $map_chunks;
      @best_mapping = @mapping;
    }
    last unless next_permutation(\%o);
  }
  wantarray ? ($chunks, @best_mapping) : $chunks;
};

__END__
my ($s1, $s2) = ('trout', 'tutor');
my ($c, @map) =  min_chunks($s1, $s2);
print "$c: ";
my $prev = -2;
for (@map) {
  print "/" if $prev + 1 != $_;
  print substr($s1, $_, 1);
  $prev = $_;
}
print "/\n";

1;
