パズルの解法 (3)
前回 は幅優先探索の例題として 8 パズルを解きました。今回は反復深化の例題として、ペグ・ソリテアと 8 パズルを解いてみましょう。
拙作のページ 経路の探索 で説明したように、反復深化は最短手数を求めることができるアルゴリズムです。幅優先探索と違って局面を保存する必要が無いため、必要となるメモリは深さ優先探索と同程度で済みます。また、プログラムも深さ優先探索と同じくらい簡単に作成することができます。
ただし、同じ探索を何度も繰り返すため実行時間が増大する、という欠点があります。ようするに、使用するメモリは少ないが実行時間が長くなるアルゴリズムなのです。実行時間が長くなるといっても、枝刈りを工夫することでパズルを高速に解くことができます。メモリ不足になる場合には、積極的に使ってみたいアルゴリズムといえるでしょう。
●ペグ・ソリテア
ペグ・ソリテアは盤上に配置されたペグ（駒）を、最後にはひとつ残るように取り除いていく古典的なパズルです。ペグは、次のルールに従って移動し、除去することができます。
- ペグは隣にあるペグをひとつだけ跳び越して、空き場所へ着地する。
- 跳び越されたペグは盤上から取り除かれる。
- 移動方向はふつう縦横のみの 4 方向だが、ルールによっては斜め方向の移動を許す場合もある。
- 同じペグの連続跳びは 1 手と数える。
盤は今までに多数考案されていますが、33 穴英国盤、37 穴フランス盤、41 穴盤が有名です。下図に 33 穴英国盤を示します。
図 : 33 穴英国盤
33 の穴にペグがありますが、そこからひとつペグを取り除いてゲームを始めます。図では黒丸でペグを表し、白丸で空き場所を表しています。ルールに従ってペグを移動し、最後にひとつだけ残ればクリアとなります。ただし、最初に取り除くペグの位置によって、解けない場合もあるので注意してください。
橋本哲氏の記事 (参考文献 2) によると、最初の空き位置と最後に残ったペグの位置が同じになることを「補償型の解」といい、最初の空き位置が盤の中央で、なおかつ、補償型の解がある場合を「中央補償型の解」と呼ぶそうです。33 穴英国盤には、中央補償型の解があるそうです。
ペグ・ソリテアの場合、昔から補償型や中央補償型の解の最小手数を求めることが行われてきました。33 穴英国盤のように、ペグの数が多くなるとパソコンで解くのは大変になります。そこで、今回はサイズを小さくした簡単なペグ・ソリテアを反復深化で解いてみましょう。
●Hoppers
Hoppers は芦ヶ原伸之氏が考案されたペグ・ソリテアです。次の図を見てください。
図 : Hoppers
Hoppers は穴を 13 個に減らしていて、遊ぶのに手頃な大きさになっています。上図に示したように、最初に中央のペグを取り除きます。この状態から始めて、最後のペグが中央の位置に残る跳び方の最小手数を求めることにします。
●跳び先表とペグの移動
それでは、プログラムを作りましょう。今回は Hoppers の盤面を大域変数 @board で表します。ペグがある場所を 1 で、空き場所を 0 で表します。盤面と配列の対応は、下図を見てください。
図 : Hoppers の盤面
ペグの移動は跳び先表を用意すると簡単です。次のプログラムを見てください。
リスト : 跳び先表
# 跳び先表
our @jump_table = (
[1, 2, 3, 6, 5, 10],
[3, 5, 6, 11, 4, 7],
[1, 0, 4, 6, 7, 12],
[6, 9],
[6, 8],
[3, 1, 6, 7, 8, 11],
[3, 0, 4, 2, 8, 10, 9, 12],
[4, 1, 6, 5, 9, 11],
[6, 4],
[6, 3],
[5, 0, 8, 6, 11, 12],
[8, 5, 6, 1, 9, 7],
[11, 10, 9, 6, 7, 2]
);
ペグの跳び先表は配列 @jump_table で定義します。要素は無名の配列であることに注意してください。奇数番目の要素が跳び越されるペグの位置で、偶数番目の要素が跳び先の位置を表します。たとえば、0 番の位置にあるペグは、1 番を跳び越して 2 番へ移動する場合と、3 番を跳び越して 6 番へ移動する場合と、5 番を飛び越して 10 番へ移動する場合の 3 通りがあります。
次にペグを動かして新しい盤面を作る関数 move_peg と元に戻す関数 restore_peg を作ります。
リスト : ペグの移動
sub move_peg {
my ($from, $del, $to) = @_;
$board[$from] = 0;
$board[$del] = 0;
$board[$to] = 1;
push @move, [$from, $to];
}
sub restore_peg {
my ($from, $del, $to) = @_;
$board[$from] = 1;
$board[$del] = 1;
$board[$to] = 0;
pop @move;
}
move_peg は @board の $from, $del を 0 に、$to を 1 に書き換えます。そして、手順 [$from, $to] を大域変数 @move に追加します。restore_peg は @board の $from, $del を 1 に、$to を 0 に書き換えて、@move から追加した手順を取り除きます。
●反復深化による Hoppers の解法
あとは単純な反復深化で最短手順を求めます。プログラムは次のようになります。
リスト : 反復深化による解法
sub solver {
my ($n, $jc, $limit) = @_;
return if $jc > $limit;
if ($n == $max_jump) {
print_move() if $board[$hole];
} else {
for (my $from = 0; $from < @board; $from++) {
next if !$board[$from];
my $xs = $jump_table[$from];
for (my $i = 0; $i < @$xs; $i += 2) {
my $del = $xs->[$i];
my $to = $xs->[$i + 1];
next if (!$board[$del] || $board[$to]);
move_peg($from, $del, $to);
my $jc1 = $move[$n - 1]->[1] == $from ? $jc : $jc + 1;
solver($n + 1, $jc1, $limit);
restore_peg($from, $del, $to);
}
}
}
}
# 初手を 0 -> (3) -> 6 に限定
move_peg(0, 3, 6);
foreach my $limit (2 .. $max_jump) {
print "----- $limit -----\n";
solver(1, 1, $limit);
last if ($count > 0);
}
print $count, "\n";
関数 solver の引数 $n がペグの移動回数、$jc が連続跳びの回数、$limit が反復深化の上限値を表します。ペグ・ソリテアを反復深化で解く場合、上限値 $limit に達していても連続跳びによりペグを移動できることに注意してください。最初に、$jc をチェックして $limit 以下であればペグを移動します。Hoppers の場合、ペグの総数は 12 個なので、$max_jump (11) 回ペグを移動すると残りのペグは 1 個になります。解を見つけたら関数 print_answer で手順を表示します。
そうでなければペグを移動します。まず $from の位置にペグがあることを確認します。それから、跳び先表から跳び越されるペグの位置と跳び先の位置を取り出して変数 $del と $to にセットします。$del の位置にペグがあり $to の位置にペグがなければ、$from のペグを $to へ移動することができます。
ペグを動かすことができる場合は solver を再帰呼び出しします。move_peg でペグを動かします。そして、このプログラムのポイントが連続跳びのチェックをするところです。直前に移動した場所からペグを動かすときは、連続跳びと判断することができます。つまり、@move 末尾の 1 番目の要素 ($move[-1]->[1]) が $from と等しい場合は、跳んだ回数 $jc を増やしません。異なる場合は $jc の値を +1 します。
あとは反復深化の上限値を増やしながら solver を呼び出します。foreach の変数 $limit が上限値を表します。最初の移動は、四隅にあるペグのひとつを中央に動かす手順しかありません。そこで、最初は 0 のペグを 6 へ動かすことに決めて、その状態から探索を開始します。大域変数 $count が 0 でなければ、解を見つけたので反復深化を終了します。
あとのプログラムは簡単なので説明は割愛します。詳細は プログラムリスト１ をお読みください。
●実行結果
これでプログラムは完成です。それでは実行してみましょう。
$ time perl peg13.pl ----- 2 ----- ----- 3 ----- ----- 4 ----- ----- 5 ----- ----- 6 ----- ----- 7 ----- (0,6)(9,3)(2,0,6)(11,1)(10,0,2,6)(8,4)(12,2,6) (0,6)(9,3)(2,0,6)(11,1)(10,6)(4,8)(12,2,0,10,6) (0,6)(9,3)(2,0,6)(11,1)(12,2,6)(8,4)(10,0,2,6) (0,6)(9,3)(2,6)(8,4)(10,0,2,6)(7,5)(12,10,0,6) (0,6)(9,3)(2,6)(8,4)(10,0,2,6)(11,1)(12,2,0,6) (0,6)(9,3)(2,6)(8,4)(10,0,6)(7,5)(12,10,0,2,6) (0,6)(9,3)(2,6)(8,4)(12,2,0,6)(5,7)(10,12,2,6) (0,6)(9,3)(2,6)(8,4)(12,2,0,6)(11,1)(10,0,2,6) (0,6)(9,3)(2,6)(8,4)(12,2,6)(5,7)(10,12,2,0,6) (0,6)(9,3)(10,0,6)(7,5)(2,0,10,6)(4,8)(12,10,6) (0,6)(9,3)(10,0,6)(7,5)(2,6)(8,4)(12,10,0,2,6) (0,6)(9,3)(10,0,6)(7,5)(12,10,6)(4,8)(2,0,10,6) (0,6)(9,3)(10,6)(4,8)(2,0,6)(11,1)(12,2,0,10,6) (0,6)(9,3)(10,6)(4,8)(2,0,10,6)(7,5)(12,10,0,6) (0,6)(9,3)(10,6)(4,8)(2,0,10,6)(11,1)(12,2,0,6) (0,6)(9,3)(10,6)(4,8)(12,10,0,6)(1,11)(2,12,10,6) (0,6)(9,3)(10,6)(4,8)(12,10,0,6)(7,5)(2,0,10,6) (0,6)(9,3)(10,6)(4,8)(12,10,6)(1,11)(2,12,10,0,6) 18 real 0m0.280s user 0m0.159s sys 0m0.038s 実行環境 : Perl v5.34.0, Ubunts 22.04 LTS (WSL2, Windows 10), Intel Core i5-6200U 2.30GHz
7 手で解くことができました。解は全部で 18 通りで、実行時間は 0.28 秒でした。最近のパソコンは高性能なので、穴の数が少ない盤面であれば、単純な反復深化でも高速に解くことができるようです。
●反復深化による 8 パズルの解法
次は 8 パズルを反復深化で解いてみましょう。幅優先探索では全ての局面を保存しましたが、反復深化ではその必要はありません。そこで今回は盤面を配列 $board で表すことにします。$board は大域変数とし、駒の移動は $board を書き換えて、バックトラックする時は元に戻すことにします。動かした駒は大域変数 @move に格納します。動かした駒がわかれば盤面を再現できるので、それで移動手順を表すことにしましょう。
それでは、さっそくプログラムを作ります。次のリストを見てください。
リスト : 単純な反復深化による解法
sub solver {
my ($n, $limit, $space) = @_;
if ($n == $limit) {
if (eq_array($board, $goal)) {
$count++;
print "@move\n"
}
} else {
my $xs = $adjacent[$space];
for my $x (@$xs) {
my $p = $board->[$x];
# 1 手前と同じコマは動かさない
next if $p == $move[-1];
$board->[$space] = $p;
$board->[$x] = 0;
push @move, $p;
solver($n + 1, $limit, $x);
pop @move;
$board->[$x] = $p;
$board->[$space] = 0;
}
}
}
# 実行
$board = [8, 6, 7, 2, 5, 4, 3, 0, 1];
foreach my $limit (1 .. 31) {
print "----- $limit -----\n";
solver(0, $limit, 7);
last if ($count > 0);
}
print $count, "\n";
関数 solver の引数 $n が手数、$limit が上限値、$space が空き場所の位置です。手数が上限値に達したら、パズルが解けたかチェックします。Perl の場合、配列は演算子 == で等値を判定できないので、関数 eq_array で行います。eq_array は簡単で、配列の要素がすべて等しい場合は 1 を、そうでなければ 0 を返します。$goal は完成形を表す配列です。完成形に到達したら、print で手順を表示します。上限値に達していない場合は、駒を移動して新しい局面を作ります。
8 パズルのように、元の局面に戻すことが可能（可逆的）なパズルの場合、単純な深さ優先探索では同じ移動手順を何度も繰り返すことがあります。そうなると、とんでもない解を出力するだけではなく、再帰呼び出しが深くなるとスタックがオーバーフローしてプログラムの実行ができなくなることがあります。
このような場合、局面の履歴を保存しておいて同じ局面がないかチェックすることで、解を求めることができるようになります。ただし、同一局面をチェックする分だけ時間が余分にかかりますし、最初に見つかる解が最短手数とは限りません。
反復深化では深さが制限されているため、同一局面のチェックを行わなくてもスタックオーバーフローが発生することはありません。そのかわり、無駄な探索はどうしても避けることができません。8 パズルの場合、1 手前に動かした駒を再度動かすと 2 手前の局面に戻ってしまいます。完全ではありませんが、このチェックを入れるだけでもかなりの無駄を省くことができます。
プログラムでは、配列 @move に移動した駒を格納しているので、1 手前と同じ駒は動かさないようにチェックしています。なお、@move の先頭要素はダミーデータで 0 をセットしておきます。
あとは、foreach 文の中で solver を呼び出すだけです。変数 $limit が上限値を表します。大域変数 $count が 0 でなければ、解が見つかったのでループを脱出します。プログラムはこれで完成です。
●実行結果
実際に実行してみると、当然ですが最短手数は 31 手で 40 通りの手順が表示されました。実行時間は 3 分 39 秒 (Perl v5.34.0, Ubunts 22.04 LTS (WSL2, Windows 10), Intel Core i5-6200U 2.30GHz) かかりました。4 分近くかかるのですから、やっぱり遅いですね。
反復深化の場合、枝刈りを工夫しないと高速に解くことはできません。そこで、反復深化の常套手段である「下限値枝刈り法」を使うことにしましょう。
●下限値枝刈り法
下限値枝刈り法は難しいアルゴリズムではありません。たとえば、5 手進めた局面を考えてみます。探索の上限値が 10 手とすると、あと 5 手だけ動かすことができますね。この時、パズルを解くのに 6 手以上かかることがわかれば、ここで探索を打ち切ることができます。
このように、必要となる最低限の手数が明確にわかる場合、この値を「下限値 (Lower Bound)」と呼びます。この下限値を求めることができれば、「今の移動手数＋下限値」が探索手数を超えた時点で、枝刈りすることが可能になります。これが下限値枝刈り法の基本的な考え方です。
さて、下限値を求める方法ですが、これにはいろいろな方法が考えられます。今回は、各駒が正しい位置へ移動するまでの手数 (移動距離) [*1] を下限値として利用することにしましょう。次の図を見てください。
図 : 下限値の求め方
たとえば、右下にある 1 の駒を左上の正しい位置に移動するには、最低でも 4 手必要です。もちろん、ほかの駒との関連で、それ以上の手数が必要になる場合もあるでしょうが、4 手より少なくなることは絶対にありません。同じように、各駒について最低限必要な手数を求めることができます。そして、その合計値はパズルを解くのに最低限必要な手数となります。これを下限値として利用することができます。ちなみに、上図 (2) の初期状態の下限値は 21 手になります。
下限値枝刈り法を使う場合、下限値の計算を間違えると正しい解を求めることができなくなります。たとえば、10 手で解ける問題の下限値を 11 手と計算すれば、最短手数を求めることができなくなります。それどころか、10 手の解しかない場合は、答えを求めることすらできなくなります。下限値の計算には十分に注意してください。
[*1] これを「マンハッタン距離 (Manhattan Distance)」と呼ぶことがあります。
●プログラムの作成
それでは、プログラムを作りましょう。下限値の求め方ですが、駒を動かすたびに各駒の移動距離を計算していたのでは時間がかかります。8 パズルの場合、1 回に一つの駒しか移動しないので、初期状態の下限値を求めておいて、動かした駒の差分だけ計算すればいいでしょう。また、駒の移動距離はいちいち計算するのではなく、あらかじめ計算した結果を配列に格納しておきます。この配列を @distance とすると、盤面から移動距離を求めるプログラムは次のようになります。
リスト : 移動距離を求める
# 移動距離
our @distance = (
[0, 0, 0, 0, 0, 0, 0, 0, 0],
[0, 1, 2, 1, 2, 3, 2, 3, 4],
[1, 0, 1, 2, 1, 2, 3, 2, 3],
[2, 1, 0, 3, 2, 1, 4, 3, 2],
[1, 2, 3, 0, 1, 2, 1, 2, 3],
[2, 1, 2, 1, 0, 1, 2, 1, 2],
[3, 2, 1, 2, 1, 0, 3, 2, 1],
[2, 3, 4, 1, 2, 3, 0, 1, 2],
[3, 2, 3, 2, 1, 2, 1, 0, 1]
);
sub get_distance {
my $xs = shift;
my $d = 0;
for (my $i = 0; $i < @distance; $i++) {
$d += $distance[$xs->[$i]]->[$i];
}
$d;
}
@distance は 2 次元配列で「駒の種類×駒の位置」を表しています。空き場所は関係ないので、0 番目の配列は要素が全部 0 になります。関数 get_distance は盤面 $xs にある駒と位置から移動距離を求めます。変数 $d を 0 に初期化して、駒の移動距離を $d に足し算するだけです。
次は、下限値枝刈り法による反復深化を行う関数 solver を作ります。次のリストを見てください。
リスト : 下限値枝刈り法
sub solver {
my ($n, $limit, $space, $low) = @_;
if ($n == $limit) {
if (eq_array($board, $goal)) {
$count++;
print "@move\n"
}
} else {
my $xs = $adjacent[$space];
for my $x (@$xs) {
my $p = $board->[$x];
# 1 手前と同じコマは動かさない
next if $p == $move[-1];
my $new_low = $low - $distance[$p]->[$x] + $distance[$p]->[$space];
if ($new_low + $n <= $limit) {
$board->[$space] = $p;
$board->[$x] = 0;
push @move, $p;
solver($n + 1, $limit, $x, $new_low);
pop @move;
$board->[$x] = $p;
$board->[$space] = 0;
}
}
}
}
# 実行
$board = [8, 6, 7, 2, 5, 4, 3, 0, 1];
my $low = get_distance($board);
foreach my $limit ($low .. 31) {
print "----- $limit -----\n";
solver(0, $limit, 7, $low);
last if ($count > 0);
}
print $count, "\n";
関数 solver の引数 $low は現在の盤面 @board の下限値を表しています。駒を動かしたら差分を計算して、新しい下限値 $new_low を求めます。そして、$new_low + $n が上限値 $limit を越えたら枝刈りを行います。$limit 以下であれば solver を再帰呼び出しします。追加する処理はこれだけで、あとは反復深化のプログラムと同じです。とても簡単ですね。
最後に solver を呼び出す処理を修正します。関数 get_distance で初期状態の下限値 $low を求めます。下限値がわかるのですから、上限値 $limit は 1 手からではなく下限値 $low からスタートします。あとは solver に下限値 $low を渡して呼び出すだけです。
●実行結果 (2)
プログラムの主な修正はこれだけです。実際に実行してみると、実行時間は 0.19 秒でした。1000 倍以上の高速化に大変驚いてしまいました。下限値枝刈り法の効果は極めて高いですね。
●参考文献
- 高橋謙一郎, 『特集 悩めるプログラマに効くアルゴリズム』, C MAGAZINE 2000 年 11 月号, ソフトバンク
- 橋本哲, 『特集コンピュータパズルへの招待 ペグ・ソリテア編』, C MAGAZINE 1996 年 2 月号, ソフトバンク
●プログラムリスト１
#
# peg13.pl : ペグ・ソリテア (Hoppers)
#
# Copyright (C) 2015-2023 Makoto Hiroi
#
use strict;
use warnings;
# 大域変数
our $max_jump = 11;
our $hole = 6;
our @board = (1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1);
our @move = ();
our $count = 0;
# 跳び先表
our @jump_table = (
[1, 2, 3, 6, 5, 10],
[3, 5, 6, 11, 4, 7],
[1, 0, 4, 6, 7, 12],
[6, 9],
[6, 8],
[3, 1, 6, 7, 8, 11],
[3, 0, 4, 2, 8, 10, 9, 12],
[4, 1, 6, 5, 9, 11],
[6, 4],
[6, 3],
[5, 0, 8, 6, 11, 12],
[8, 5, 6, 1, 9, 7],
[11, 10, 9, 6, 7, 2]
);
# ペグの移動
sub move_peg {
my ($from, $del, $to) = @_;
$board[$from] = 0;
$board[$del] = 0;
$board[$to] = 1;
push @move, [$from, $to];
}
sub restore_peg {
my ($from, $del, $to) = @_;
$board[$from] = 1;
$board[$del] = 1;
$board[$to] = 0;
pop @move;
}
# 手順の表示
sub print_move {
$count++;
for (my $i = 0, my $j = 1; $i < $max_jump; $i++, $j++) {
print "($move[$i]->[0],$move[$i]->[1]";
for (; $j < $max_jump; $i++, $j++) {
last if $move[$i]->[1] != $move[$j]->[0];
print ",$move[$j]->[1]";
}
print ")";
}
print "\n";
}
# 単純な反復深化
sub solver {
my ($n, $jc, $limit) = @_;
return if $jc > $limit;
if ($n == $max_jump) {
print_move() if $board[$hole];
} else {
for (my $from = 0; $from < @board; $from++) {
next if !$board[$from];
my $xs = $jump_table[$from];
for (my $i = 0; $i < @$xs; $i += 2) {
my $del = $xs->[$i];
my $to = $xs->[$i + 1];
next if (!$board[$del] || $board[$to]);
move_peg($from, $del, $to);
my $jc1 = $move[$n - 1]->[1] == $from ? $jc : $jc + 1;
solver($n + 1, $jc1, $limit);
restore_peg($from, $del, $to);
}
}
}
}
# 初手を 0 -> (3) -> 6 に限定
move_peg(0, 3, 6);
foreach my $limit (2 .. $max_jump) {
print "----- $limit -----\n";
solver(1, 1, $limit);
last if ($count > 0);
}
print $count, "\n";
●プログラムリスト２
#
# eight3.pl : 8 パズル (反復深化)
#
# Copyright (C) 2015-2023 Makoto Hiroi
#
use strict;
use warnings;
# 大域変数
our $board;
our $goal = [1, 2, 3, 4, 5, 6, 7, 8, 0];
our @move = (0);
our $count = 0;
# 隣接リスト
our @adjacent = (
[1, 3], # 0
[0, 4, 2], # 1
[1, 5], # 2
[0, 4, 6], # 3
[1, 3, 5, 7], # 4
[2, 4, 8], # 5
[3, 7], # 6
[4, 6, 8], # 7
[5, 7] # 8
);
# 配列が等しいか
sub eq_array {
my ($xs, $ys) = @_;
return 0 if @$xs != @$ys;
for (my $i = 0; $i < @$xs; $i++) {
return 0 if $xs->[$i] != $ys->[$i];
}
1;
}
# 反復深化による解法
sub solver {
my ($n, $limit, $space) = @_;
if ($n == $limit) {
if (eq_array($board, $goal)) {
$count++;
print "@move\n"
}
} else {
my $xs = $adjacent[$space];
for my $x (@$xs) {
my $p = $board->[$x];
# 1 手前と同じコマは動かさない
next if $p == $move[-1];
$board->[$space] = $p;
$board->[$x] = 0;
push @move, $p;
solver($n + 1, $limit, $x);
pop @move;
$board->[$x] = $p;
$board->[$space] = 0;
}
}
}
# 実行
$board = [8, 6, 7, 2, 5, 4, 3, 0, 1];
foreach my $limit (1 .. 31) {
print "----- $limit -----\n";
solver(0, $limit, 7);
last if ($count > 0);
}
print $count, "\n";
●プログラムリスト３
#
# eight4.pl : 8 パズル (反復深化＋下限値枝刈り法)
#
# Copyright (C) 2015-2023 Makoto Hiroi
#
use strict;
use warnings;
# 大域変数
our $board;
our $goal = [1, 2, 3, 4, 5, 6, 7, 8, 0];
our @move = (0);
our $count = 0;
# 隣接リスト
our @adjacent = (
[1, 3], # 0
[0, 4, 2], # 1
[1, 5], # 2
[0, 4, 6], # 3
[1, 3, 5, 7], # 4
[2, 4, 8], # 5
[3, 7], # 6
[4, 6, 8], # 7
[5, 7] # 8
);
# 移動距離
our @distance = (
[0, 0, 0, 0, 0, 0, 0, 0, 0],
[0, 1, 2, 1, 2, 3, 2, 3, 4],
[1, 0, 1, 2, 1, 2, 3, 2, 3],
[2, 1, 0, 3, 2, 1, 4, 3, 2],
[1, 2, 3, 0, 1, 2, 1, 2, 3],
[2, 1, 2, 1, 0, 1, 2, 1, 2],
[3, 2, 1, 2, 1, 0, 3, 2, 1],
[2, 3, 4, 1, 2, 3, 0, 1, 2],
[3, 2, 3, 2, 1, 2, 1, 0, 1]
);
sub get_distance {
my $xs = shift;
my $d = 0;
for (my $i = 0; $i < @distance; $i++) {
$d += $distance[$xs->[$i]]->[$i];
}
$d;
}
# 配列が等しいか
sub eq_array {
my ($xs, $ys) = @_;
return 0 if @$xs != @$ys;
for (my $i = 0; $i < @$xs; $i++) {
return 0 if $xs->[$i] != $ys->[$i];
}
1;
}
# 反復深化による解法
sub solver {
my ($n, $limit, $space, $low) = @_;
if ($n == $limit) {
if (eq_array($board, $goal)) {
$count++;
print "@move\n"
}
} else {
my $xs = $adjacent[$space];
for my $x (@$xs) {
my $p = $board->[$x];
# 1 手前と同じコマは動かさない
next if $p == $move[-1];
my $new_low = $low - $distance[$p]->[$x] + $distance[$p]->[$space];
if ($new_low + $n <= $limit) {
$board->[$space] = $p;
$board->[$x] = 0;
push @move, $p;
solver($n + 1, $limit, $x, $new_low);
pop @move;
$board->[$x] = $p;
$board->[$space] = 0;
}
}
}
}
# 実行
$board = [8, 6, 7, 2, 5, 4, 3, 0, 1];
my $low = get_distance($board);
foreach my $limit ($low .. 31) {
print "----- $limit -----\n";
solver(0, $limit, 7, $low);
last if ($count > 0);
}
print $count, "\n";
改訂 2023 年 3 月 21 日