use strict;

sub split_word {
  my ($word) = @_;
  my %graph;
  for my $index (0 .. length($word) - 1) {
    my $ch = substr $word, $index, 1;
    push @{$graph{$ch}}, $index;
  }
  %graph;
};

my %o;
my @targ;
my $best_chunks;
my @best_mapping;
my @mapping;

# remove the list element being tried for the duration of the nested call
sub scan_next_pos {
  my ($list, $pos, $pindex, $chunks) = @_;
  my $save = splice @$list, $pindex, 1;
  push @mapping, $save;
  scan_pos( $pos, $save, $chunks );
  splice @$list, $pindex, 0, $save;
  pop @mapping;
}

sub scan_pos {
  my ($pos, $pindex, $chunks) = @_;
  if ( $pos == @targ ) {
    $best_chunks = $chunks;
    @best_mapping = @mapping;
    return;
  }
  my $ch = $targ[$pos];
  my $max = @{$o{$ch}}-1;
  my $check;
  for ( 0..$max ) {
    $check = $_;
    last if $o{$ch}[$check] > $pindex;
  }
  # continue the current run if possible
  if ($o{$ch}[$check] == $pindex+1) {
    scan_next_pos( $o{$ch}, $pos+1, $check, $chunks );
  } else {
    undef $check;
  }
  # breaking a run, increase chunks and check whether
  # any previous complete result is as good as what
  # we're at (so far, we could get much worse but we'll
  # quit in the middle of the generated run sequence as
  # soon as we're tied)
  return if ++$chunks >= $best_chunks;
  for my $index ( 0..$max ) {
    # skip a previously checked run item
    if (defined $check && $index == $check) {
      undef $check;
      next;
    }
    scan_next_pos( $o{$ch}, $pos+1, $index, $chunks );
  }
}

sub min_chunks {
  my ($given, $target) = @_;
  %o = split_word($given);
  @targ = split //, $target;
  $best_chunks = @targ+1;

  scan_pos( 0, -2, 0 );
  wantarray ? ($best_chunks, @best_mapping) : $best_chunks;
};

while( <> ) {
  chomp;
  my ($exp, $s1, $s2) = split;
  my ($got, @map) = min_chunks($s1,$s2);
  next if $exp == $got;
  print "$exp,$got: ";
  my $prev = -2;
  for (@map) {
    print "/" if $prev + 1 != $_;
    print substr($s1, $_, 1);
    $prev = $_;
  }
  print "/  ($s1)\n";
}

__END__

my ($s1, $s2) = ('photochromolithograph', 'photochromolithograph');
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;
