剪切粘贴问题

黑皮书看到的题目：
比如有6段文字，P2,P4,P1,P5,P3,P6, 希望通过剪切粘贴的方式让它变成P1P2P3P4P5P6， 希望次数尽量少

剪切粘贴可以对多个连续段落进行操作。

（其实问题可以简化成对2，4，1，5，3，6，进行排序？）

实际上这个是一个状态空间的搜索问题， 使用启发式搜索的话，让H(s) = "后继段落错误的个数"， 可知随着搜索的正确深入
， H(s)应该慢慢变小，乃至最后为0。 当然，H(S) <= 3(每次剪切最多会改变3个后继段落，就是说h(s)最多减少3)。
而每次深入所付出的代价是1次剪切粘贴， 即1， 此时应该让H'(S) =H(S) /3 <= 1, 使到H(S)相容，当然，如果搜索过程中，
只用到H(S)，不用到F(S)，那么则无所谓了，H(S) ＝  "后继段落错误的个数" 即可。

用perl 写了一个， 搜索过程只用到了估价函数H(S)， 没有用到启发函数F， 也就是单纯的对所有子节点的H(S)进行排序，取其最小的一个进行深入。

代码如下：

se strict;
use Data::Dumper;
my $str = "369425187";

my @array = split "", $str;
search( 
 {
  g => 0,
  h => h(\@array),
  ra => \@array,
 }

);

sub search {
 my $state = shift;
 my $g = $state->{g};
 my $h = $state->{h};
 return if $h == 0;
 my $ra = $state->{ra};
 my $ra_new = make_new_ra($ra);
 my @childs = ();
 my $i;
 my $j;
 for ( $i=0;$i<@$ra_new -1;$i++) {
  
  for ( $j=$i+1;$j<@$ra_new;$j++) {
   my @tmp = @$ra_new;
   my $swap = $tmp[$i];
   $tmp[$i] = $tmp[$j];
   $tmp[$j] = $swap;
   
   my $h = h(release_ra(\@tmp));
   #print Dumper($tmp[$i]->{slice});
   
   push @childs, {
    h => $h, 
    ra => release_ra(\@tmp), 
    from_change => $tmp[$j]->{slice}, 
    to_change => $tmp[$i]->{slice},
    g => $g+1, 
   };
  }  
 }
 @childs = sort {$a->{h} <=> $b->{h}}@childs;

print join "", @{$childs[0]->{from_change}};
 print '<=>';
 print join "", @{$childs[0]->{to_change}};
 print "\n";
 search($childs[0]);
 #print Dumper(\@childs);
}

sub make_new_ra {
 my $ra_real = shift;
 my @array = @$ra_real;
 my $ra = \@array;
 my $ra_new = [];

while (@$ra) {
  my @slice = ();
  my $item = shift @$ra;
  push @slice, $item;
  while (@$ra) {
   if ($ra->[0] eq $item + 1 ) {
    $item = shift @$ra;
    push @slice, $item;
   } else {
    last;
   } 
  }   
  push @$ra_new, {slice => \@slice};
 }
 return $ra_new;
}

sub release_ra {
 my $ra = shift;

my $ra_release = [];
 for (@$ra) {
  push @$ra_release, @{$_->{slice}};
 }
 return $ra_release;
}

sub h {
 my $ra = shift;

my $h = 0;
 my $last_pos = scalar @$ra -1;
 if ($ra->[$last_pos ] ne  '1' + $last_pos) {
  $h++;
 }
 for (my $i =0;$i< @$ra -1;$i++) {
  if ($ra->[$i] + 1 != $ra->[$i+1]) {
   $h++
  }
 }

return $h;
}