#!/usr/bin/perl -w

use strict;
use feature qw(state);
use List::Util qw(shuffle);

my $DIMENSION = 5;

my $L = $DIMENSION - 1;
my $N = $DIMENSION*$DIMENSION-1;
# my @rlist = reverse( 0..$N );    #  doesn't have solution
my @rlist = shuffle(0..$N);
my (@hj, @hi, @map, $k, $r, $ok, $j, $i, $tmp, $cost, $min, @backup, $count);  
my ($cost0, @oi, @oj, $linea);

for $i (0..$L){
    for $j (0..$L){
	$k = shift @rlist;
	$hj[$k] = $j;
	$hi[$k] = $i;
	$map[$i][$j] = $k;
	$oi[$k] = int $k/$DIMENSION;
	$oj[$k] = $k % $DIMENSION;
    }
}

$linea = $L;
$count = 0;
$min = 999_999_999;
do {
    $ok = 0;
    while ($ok == 0) {
	$j = $hj[0];
	$i = $hi[0];
	$r = guess();
	if ($r == 0) {
	    swap(0,-1);
	    $hj[0]--;
	    $hj[$tmp]++;
	}elsif ($r == 1){
	    swap(-1,0);
	    $hi[0]--;
	    $hi[$tmp]++;
	}elsif ($r == 2){
	    swap(0,1);
	    $hj[0]++;
	    $hj[$tmp]--;
	}elsif ($r == 3){
	    swap(1,0);
	    $hi[0]++;
	    $hi[$tmp]--;
	}else{
	    die "big error";
	}
	$ok=1;
    }
    
    $cost = $k = 0;
    for $i (0..$L){
	$cost0 = 0;
	for $j (0..$L){
#	    $cost0 = ( abs( $hj[ $map[$i][$j] ] - ($oj[$map[$i][$j]] ) ) +
#		abs( $hi[ $map[$i][$j] ] - ($oi[$map[$i][$j]]) ) );     # Manhattan distance is bad
	    $cost0 += abs($map[$i][$j]-$k);
	    $k++;	     
	}
	$cost += $cost0;
	if ($cost0==0 && $i==$linea && $linea>1){ $linea--; }
    }
        
    if ($cost <= $min){
	print "COST = $cost\n";
	for $i (0..$L){
	    for $j (0..$L){
		printf "%.02d ", $map[$i][$j];
	    }
	    print "\n";
	}
	$min = $cost;
	@backup = @map;
    }elsif (++$count % 1000 ==0){
	@map = @backup;
	for $i (0..$L){
	    for $j (0..$L){
		$hi[ $map[$i][$j] ] = $i;
		$hj[ $map[$i][$j] ] = $j;
	    }
	}
    } 
    if ($cost==2 && $count>1_000_000_000) {
	print "Problem without solution!\n";
	exit 1;
    }
}until ($cost==0); 

sub swap {
    my ($upi, $upj) = @_;
    $tmp = $map[ $i + $upi ][ $j + $upj ];
    $map[ $i + $upi ][ $j + $upj ] = 0 ;
    $map[ $i ][ $j ] = $tmp;		      
}

sub guess {
#    state $kk = 0;
#    $kk++;
#    if ($kk==$N+1) { $kk=1; }
#    state @tabu;
#    if ($count % 100 ==0) { shift @tabu; }
#    if ($i == $oi[$kk] && $j == $oj[$kk]){
#	push @tabu, $kk;
#    }
    my @cand;
#    if (@tabu){
#	for my $z (@tabu){
#	    if ($j-1>=0) { unless ($map[$i][$j-1]==$z) { push @cand, 0; }}
#	    if ($i-1>=0) { unless ($map[$i-1][$j]==$z) { push @cand, 1; }}
#	    if ($j+1<=$L) { unless ($map[$i][$j+1]==$z) { push @cand, 2; }}
#	    if ($i+1<=$L) { unless ($map[$i+1][$j]==$z) { push @cand, 3; }}
#	}
#    }else{
	if ($j-1>=0) { push @cand, 0; }
	if ($i-1>=0) { push @cand, 1; }
	if ($j+1<=$L) { push @cand, 2; }
	if ($i+1<=$L && $i+1<=$linea) { push @cand, 3; }
#    }
    return $cand[int rand( scalar @cand )]; 
#    my $ii = $hi[$candidate];
#    my $jj = $hj[$candidate];
#    if ($ii > $i) { return (0,2,3)[int rand(3)]; } 
#    if ($ii < $i) { return (0,1,2)[int rand(3)]; }
#    if ($jj < $j) { return (0,1,3)[int rand(3)]; } 
#    if ($jj > $j) { return (1,2,3)[int rand(3)]; }
#    return int rand(4);
}


__END__

http://en.wikipedia.org/wiki/Fifteen_puzzle