M.Hiroi's Home Page

Linux Programming

お気楽 Perl プログラミング超入門

[ PrevPage | Perl | NextPage ]

パズルの解法 (2)

今回は基本的な探索手法である幅優先探索 (breadth-first search) を使って 15 パズルで有名なスライドパズルを解いてみましょう。

●パズルの説明

参考文献 1 によると、15 パズルはアメリカのサム・ロイドが 1870 年代に考案したパズルで、彼はパズルの神様と呼ばれるほど有名なパズル作家だそうです。


      図 : 15 パズル

15 パズルは上図に示すように、1 から 15 までの駒を並べるパズルです。駒の動かし方は、1 回に 1 個の駒を空いている隣の場所に滑らせる、というものです。駒を跳び越したり持ち上げたりすることはできません。

15 パズルの場合、駒の配置は空き場所がどこでもいいことにすると、16! (約 2e13) 通りもあります。実際には、15 パズルの性質からその半分になるのですが、それでもパソコンで扱うにはあまりにも大きすぎる数です。そこで、盤面を一回り小さくした、1 から 8 までの数字を並べる「8 パズル」を考えることにします。


              図 : 8 パズル

15 パズルは 4 行 4 列の盤ですが、8 パズルは 3 行 3 列と盤を小さくしたパズルです。8 パズルの場合、駒の配置は空き場所がどこでもいいことにすると、9! = 362880 通りあります。15 パズルや 8 パズルの場合、参考文献 2 によると 『適当な 2 つの駒をつまみ上げて交換する動作を偶数回行った局面にしか移行できない』 とのことです。

上図 (2) は 7 と 8 を入れ替えただけの配置です。この場合、交換の回数が奇数回のため完成形に到達することができない、つまり解くことができないのです。このような性質を「偶奇性 (パリティ)」といいます。詳しい説明は拙作のページ Puzzle DE Programming 偶奇性 (パリティ) のお話 をお読みください。8 パズルの場合、完成形に到達する局面の総数は 9! / 2 = 181440 個となります。

●盤面の定義

それでは、プログラムを作りましょう。下図に示すスタートから完成形 (ゴール) に到達するまでの最短手数を幅優先探索で求めます。


            図 : 8 パズル

8 パズルの盤面は文字列を使って表します。盤面の位置と文字列の添字の対応は下図を見てください。

こうすると、同じ局面かチェックする処理にハッシュを使うことができます。空白を 0 で表すと、ゴールは '123456780' となります。駒の移動は、0 と隣接する数字を交換することで行います。これは文字列の置換で処理することができます。

文字列の中から文字を探すには関数 index を使います。

index 文字列 部分文字列 [位置]

文字列の先頭から部分文字列を探し、最初に見つけた位置を返します。見つからない場合は -1 を返します。位置を指定すると、その位置から検索を開始します。このほかに関数 rindex があり、これは最後に現れた部分文字列の位置を返します。

●駒の移動

隣接リストの定義は次のようになります。

リスト : 隣接リスト

@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
);

駒を移動する場合、隣接リストから空き場所の隣の位置を求め、その位置にある数字を取り出します。これは substr を使えばいいですね。この数字と 0 を交換するには、次のように文字列の置換を行えば実現できます。

s/([0$n])(.*)([0$n])/$3$2$1/

数字を $n とすると、0 か $n から始まり、0 か $n で終わる部分文字列を探します。そして、その最初の文字と最後の文字を交換すればいいわけです。正規表現には ( ) を使っているので、最初の文字は $1 に、あいだの文字列は $2 に、最後の文字は $3 に格納されます。置換部分で、$1 と $3 をひっくり返して $3$2$1 とすれば、0 と $n を交換することができます。今回は文字列の置換を使いましたが、ほかにもいろいろな方法があると思います。興味のある方は考えてみてください。

●移動手順の管理

今度は移動手順の管理を考えましょう。経路の探索のように、局面の状態を配列に格納して手順を表してもいいのですが、最短手数を求めるだけであれば、すべての手順を記憶しておく必要はありません。n 手目の移動で作られた局面が n 手目以前の局面で出現しているのであれば、n 手より短い手数で到達する移動手順があるはずです。したがって、この n 手の手順を記憶しておく必要はないのです。新しい局面だけをキューに登録すればいいわけです。

そして、移動手順は局面を連結リストに格納して表すことにします。次のリストを見てください。

リスト : 局面の定義

# 連結リストの終端
our $nil = {};

# 局面
sub make_state {
    my ($board, $space, $prev) = @_;
    {board => $board, space => $space, prev => $prev}
}

関数 make_state で新しい局面を生成します。キー board に盤面を表す文字列、space に空き場所の位置、prev に 1 手前の局面を格納します。終端は大域変数 $nil で表します。ゴールに到達したら、prev をたどって手順を表示します。

●幅優先探索のプログラム

それでは幅優先探索のプログラムを作りましょう。次のリストを見てください。

リスト : 幅優先探索

sub bfs {
    my ($start, $goal) = @_;
    my @que = (make_state($start, index($start, '0'), $nil));
    my %check = ($start => 1);
    while (@que > 0) {
        my $st = shift @que;
        my $s = $st->{'space'};
        foreach my $x (@{$adjacent[$s]}) {
            my $b = $st->{'board'};
            my $c = substr($b, $x, 1);
            $b =~ s/([0$c])(.*)([0$c])/$3$2$1/;     # 0 と交換する
            my $new_st = make_state($b, $x, $st);
            if ($b eq $goal) {
                print_answer($new_st);
                return;
            } elsif (!$check{$b}) {
                $check{$b} = 1;
                push @que, $new_st;
            }
        }
    }
}

プログラムの骨格は 経路の探索 で説明した幅優先探索と同じです。関数 bfs の引数 $start はスタートを表す文字列、$goal はゴールを表す文字列です。スタートの局面を make_state で生成し、キュー @que に登録します。変数 %check は同一局面をチェックするためのハッシュです。%check をチェックして新しい局面だけをキューに登録します。

次の while ループで、ゴール (GOAL) に到達するまで探索を繰り返します。キューが空になり while ループが終了する場合、START から GOAL には到達できない、つまり解くことができなかったことになります。

キューから局面を取り出して変数 $st にセットします。次に、隣接リストから移動する駒の位置 $x を求めます。変数 $b が盤面で、変数 $c が動かす駒になります。そして、駒を動かして新しい局面 $new_st を生成します。

新しい盤面を作ったら、ゴールに到達したかチェックします。そうであれば、関数 print_answer で移動手順を表示します。そうでなければ、%check で同一局面のチェックを行います。新しい局面であれば、ハッシュ %check とキュー @que に登録します。

次は移動手順を表示する print_answer を作ります。

リスト : 手順の表示

sub print_answer {
    my $st = shift;
    if ($st->{'prev'} != $nil) {
        print_answer($st->{'prev'});
    }
    print $st->{'board'}, "\n";
}

盤面を表す文字列を print でそのまま出力します。$st->{'prev'} を順番にたどって出力すると、手順は逆順に表示されてしまいます。そこで、再帰呼び出しを使って最初の状態に戻り、そこから局面を順番に出力させます。

●実行結果

これでプログラムは完成です。それでは実行してみましょう。

$ time perl eight.pl
867254301
867204351
807264351
087264351
287064351
287364051
287364501
287364510
287360514
280367514
208367514
268307514
268037514
268537014
268537104
268537140
268530147
260538147
206538147
236508147
236058147
236158047
236158407
236158470
236150478
230156478
203156478
023156478
123056478
123456078
123456708
123456780

real    0m5.779s
user    0m5.445s
sys     0m0.100s

実行環境 : Perl v5.34.0, Ubunts 22.04 LTS (WSL2, Windows 10), Intel Core i5-6200U 2.30GHz

31 手で解くことができました。生成した局面は全部で 181440 通りで、実行時間は 5.8 秒かかりました。8 パズルの場合、最長手数は 31 手で、下図に示す 2 通りの局面があります。スタートの局面はその一つです。


      図 : 31 手で解ける局面

最長手数の局面は、幅優先探索を使って求めることができます。これはあとで試してみましょう。

●双方向探索

ところで、今回の 8 パズルようにゴールの状態が明確な場合、スタートから探索するだけではなくゴールからも探索を行うことで、幅優先探索を高速化することができます。これを「双方向探索 (bi-directional search)」といいます。

その理由を説明するために、簡単なシミュレーションをしてみましょう。たとえば、1 手進むたびに 3 つの局面が生成され、5 手で解けると仮定します。すると、n 手目で生成される局面は 3 の n 乗個になるので、初期状態から単純に探索すると、生成される局面の総数は、3 + 9 + 27 + 81 + 243 = 363 個となります。

これに対し、初期状態と終了状態から同時に探索を始めた場合、お互い 3 手まで探索した時点で同じ局面に到達する、つまり、解を見つけることができます。この場合、生成される局面の総数は 3 手目までの局面数を 2 倍した 78 個となります。

生成される局面数はぐっと少なくなりますね。局面数が減少すると同一局面の探索処理に有利なだけではなく、「キューからデータを取り出して新しい局面を作る」という根本的な処理のループ回数を減らすことになるので、処理速度は大幅に向上するのです。

それではプログラムを作りましょう。単純に考えると、2 つの探索処理を交互に行うことになりますが、そうするとプログラムの大幅な修正が必要になります。ここは、探索方向を示すフラグを用意することで、一つのキューだけで処理することにしましょう。局面を表すハッシュに方向を格納するキー dir を追加します。

リスト : 局面の定義 (双方向からの探索)

sub make_state {
    my ($board, $space, $prev, $dir) = @_;
    {board => $board, space => $space, prev => $prev, dir => $dir}
}

スタートからの探索を 'Fore' で、ゴールからの探索を 'Back' で表ます。双方向探索のプログラムは次のようになります。

リスト : 双方向探索

sub bfs {
    my ($start, $goal) = @_;
    my @que = (
        make_state($start, index($start, '0'), $nil, 'Fore'),
        make_state($goal, index($goal, '0'), $nil, 'Back')
        );
    my %check = ($start => $que[0], $goal => $que[1]);
    while (@que > 0) {
        my $st = shift @que;
        my $s = $st->{'space'};
        foreach my $x (@{$adjacent[$s]}) {
            my $b = $st->{'board'};
            my $c = substr($b, $x, 1);
            $b =~ s/([0$c])(.*)([0$c])/$3$2$1/;     # 0 と交換する
            my $st1 = $check{$b};
            if ($st1) {
                if ($st->{'dir'} ne $st1->{'dir'}) {
                    print_answer($st, $st1);
                    return;
                }
            } else {
                my $new_st = make_state($b, $x, $st, $st->{'dir'});
                $check{$b} = $new_st;
                push @que, $new_st;
            }
        }
    }
}

スタートとゴールの局面を生成してキューにセットします。スタートの局面は 'Fore' をセットし、ゴールの局面は 'Back' をセットします。最初に、スタートの状態から 1 手目の局面が生成され、次にゴールの状態から 1 手目の局面が生成されます。あとは、交互に探索が行われます。それから、同一局面を見つけたとき、その局面の方向 dir を比較する必要があるので、%check には局面をセットします。

駒の移動と局面の生成処理は幅優先探索と同じです。%check から局面を取り出して変数 $st1 にセットします。$st1 が偽でなければ同じ局面です。$st と $st1 の 'dir' を比較して探索方向が異なっていれば、双方向の探索で同一局面に到達したことがわかります。見つけた最短手順を関数 print_answer で出力します。同じ探索方向であれば、キューへの追加は行いません。

print_answer は簡単なプログラムなので説明は割愛いたします。詳細は プログラムリスト2 をお読みください。

●実行結果 (2)

さっそく実行してみると、生成された局面数は 16088 個で、実行時間は 0.33 秒でした。局面数は約 1/ 11 になり、実行時間も約 17 倍と高速になりました。

●最長手数の求め方

今度は最長手数の局面を求めてみましょう。最長手数の求め方ですが、181440 通りの配置の最短手数がすべてわかれば、最長の手数となる配置を求めることができます。しかし、この方法では時間がとてもかかりそうです。そこで、完成形から始めていちばん長い手数の局面を生成することにします。

まず、完成形から駒を動かして 1 手で到達する局面をすべて作ります。次に、これらの局面から駒を動かして新しい局面を作れば、完成形から 2 手で到達する局面となります。このように、手数を 1 手ずつ伸ばしていき、新しい局面が生成できなくなった時点での手数が求める最長手数となります。この処理は幅優先探索を使えばぴったりです。

このプログラムの目的は、いちばん長い手数となる配置を求めることなので、その手順を表示することは行いません。このため、一つ前の局面を格納するキー prev は削除します。そのかわり、その局面までの手数を格納するキー move を用意します。一つ前の局面の手数を move から求め、それに 1 を足せば現在の局面の手数となります。

●リングバッファ

今では shift と push を使ってキューを実装しましたが、配列を使ってキューを実装する場合、もうひとつ「循環配列 (リングバッファ)」という方法があります。この方法は先頭位置を示す front と末尾を示す rear を用意し、front と rear の間にあるデータをキューに格納されているデータとするのがポイントです。次の図を見てください。


                  図 : キューの動作

最初、キューは空の状態で、rear, front ともに 0 です。データの追加は、rear が示す位置にデータを書き込み、rear の値を +1 します。データ 10, 20, 30 を追加すると、図のようにデータが追加され rear は 3 になります。このとき front は 0 のままなので、先頭のデータは 10 ということになります。

次に、データを取り出す場合、front の示すデータを取り出しから front の値を +1 します。この場合、front が 0 なので 10 を取り出して front の値は 1 となり、次のデータ 20 が先頭になります。データを順番に 20, 30 と取り出していくと、3 つしかデータを書き込んでいないので当然キューは空になります。このとき front は 3 になり rear と同じ値になります。このように、front と rear の値が 0 の場合だけが空の状態ではなく、front と rear の値が等しくなると、キューは空になることに注意してください。

rear, fornt ともに値は増加していく方向なので、いつかは配列の範囲をオーバーします。このため、配列を先頭と末尾が繋がっているリング状と考え、rear, front が配列の範囲を超えたら 0 に戻すことにします。これを「循環配列」とか「リングバッファ」と呼びます。一般に、配列を使ってキューを実現する場合は、リングバッファとするのが普通です。

●プログラムの作成

それではプログラムを作ります。次のリストを見てください。

リスト : 8 パズルの最長手数を求める

sub bfs {
    my $goal = shift;
    my @que = (make_state($goal, index($goal, '0'), 0));
    my %check = ($goal => 1);
    my $front = 0;
    my $rear = 1;
    while ($front < $rear) {
        my $st = $que[$front++];
        my $s = $st->{'space'};
        foreach my $x (@{$adjacent[$s]}) {
            my $b = $st->{'board'};
            my $c = substr($b, $x, 1);
            $b =~ s/([0$c])(.*)([0$c])/$3$2$1/;     # 0 と交換する
            if (!$check{$b}) {
                my $new_st = make_state($b, $x, $st->{'move'} + 1);
                $check{$b} = 1;
                $que[$rear++] = $new_st;
            }
        }
    }
    my $max = $que[--$rear]->{'move'};
    while ($max == $que[$rear]->{'move'}) {
        my $b = $que[$rear--]->{'board'};
        print "$max, $b\n";
    }
}

関数 bfs にはゴールをチェックする処理がないことに注意してください。生成できる局面がなくなるまで、つまりキューにデータがなくなるまで処理を繰り返します。新しい局面を生成するときは、1 手前の局面 $st の手数 move を +1 します。

それから、キューは配列 @que と変数 $front, $rear で実装しています。データの追加は $que[$rear++] = $new_st で、データを取り出す処理は $st = $que[$front++] で実現できます。

$rear と $front が等しくなるとキューは空になります。while ループを終了して、最長手数とその局面を表示します。$que[$rear - 1] の局面の手数が最長手数になります。この値を変数 $max にセットします。あとは、$max と同じ手数の局面を出力するだけです。

●実行結果 (3)

これでプログラムは完成です。さっそく実行してみましょう。

$ time perl eight2.pl
31, 867254301
31, 647850321

real    0m5.145s
user    0m5.075s
sys     0m0.070s

実行環境 : Perl v5.34.0, Ubunts 22.04 LTS (WSL2, Windows 10), Intel Core i5-6200U 2.30GHz

最長手数は 31 手で、その配置は全部で 2 通りになります。実行時間は 5.2 秒になりました。

●参考文献

  1. 井上うさぎ, 『世界のパズル百科イラストパズルワンダーランド』, 東京堂出版, 1997
  2. 三木太郎, 『特集コンピュータパズルへの招待 スライディングブロック編』, C MAGAZINE 1996 年 2 月号, ソフトバンク
  3. 高橋謙一郎, 『特集 悩めるプログラマに効くアルゴリズム』, C MAGAZINE 2000 年 11 月号, ソフトバンク

●プログラムリスト1

#
# eight.pl : 8パズルの解法
#
#            Copyright (C) 2015-2023 Makoto Hiroi
#

# 連結リストの終端
our $nil = {};

# 局面
sub make_state {
    my ($board, $space, $prev) = @_;
    {board => $board, space => $space, prev => $prev}
}

# 隣接リスト
@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 print_answer {
    my $st = shift;
    if ($st->{'prev'} != $nil) {
        print_answer($st->{'prev'});
    }
    print $st->{'board'}, "\n";
}

# 幅優先探索
sub bfs {
    my ($start, $goal) = @_;
    my @que = (make_state($start, index($start, '0'), $nil));
    my %check = ($start => 1);
    while (@que > 0) {
        my $st = shift @que;
        my $s = $st->{'space'};
        foreach my $x (@{$adjacent[$s]}) {
            my $b = $st->{'board'};
            my $c = substr($b, $x, 1);
            $b =~ s/([0$c])(.*)([0$c])/$3$2$1/;     # 0 と交換する
            my $new_st = make_state($b, $x, $st);
            if ($b eq $goal) {
                print_answer($new_st);
                return;
            } elsif (!$check{$b}) {
                $check{$b} = 1;
                push @que, $new_st;
            }
        }
    }
}

# 実行
bfs("867254301", "123456780");

●プログラムリスト2

#
# eight1.pl : 8パズルの解法 (双方向探索)
#
#             Copyright (C) 2015-2023 Makoto Hiroi
#

# 連結リストの終端
our $nil = {};

# 局面
sub make_state {
    my ($board, $space, $prev, $dir) = @_;
    {board => $board, space => $space, prev => $prev, dir => $dir}
}

# 隣接リスト
@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 print_answer_fore {
    my $st = shift;
    if ($st->{'prev'} != $nil) {
        print_answer_fore($st->{'prev'});
    }
    print $st->{'board'}, "\n";
}

sub print_answer_back {
    my $st = shift;
    while ($st != $nil) {
        print $st->{'board'}, "\n";
        $st = $st->{'prev'};
    }
}

sub print_answer {
    my ($st, $st1) = @_;
    if ($st->{'dir'} eq 'Fore') {
        print_answer_fore($st);
        print_answer_back($st1);
    } else {
        print_answer_fore($st1);
        print_answer_back($st);
    }
}

# 幅優先探索 (双方向探索)
sub bfs {
    my ($start, $goal) = @_;
    my @que = (
        make_state($start, index($start, '0'), $nil, 'Fore'),
        make_state($goal, index($goal, '0'), $nil, 'Back')
        );
    my %check = ($start => $que[0], $goal => $que[1]);
    while (@que > 0) {
        my $st = shift @que;
        my $s = $st->{'space'};
        foreach my $x (@{$adjacent[$s]}) {
            my $b = $st->{'board'};
            my $c = substr($b, $x, 1);
            $b =~ s/([0$c])(.*)([0$c])/$3$2$1/;     # 0 と交換する
            my $st1 = $check{$b};
            if ($st1) {
                if ($st->{'dir'} ne $st1->{'dir'}) {
                    print_answer($st, $st1);
                    return;
                }
            } else {
                my $new_st = make_state($b, $x, $st, $st->{'dir'});
                $check{$b} = $new_st;
                push @que, $new_st;
            }
        }
    }
}

# 実行
bfs("867254301", "123456780");

●プログラムリスト3

#
# eight2.pl : 8パズルの解法 (最長手数の探索)
#
#             Copyright (C) 2015-2023 Makoto Hiroi
#

# 局面
sub make_state {
    my ($board, $space, $move) = @_;
    {board => $board, space => $space, move => $move}
}

# 隣接リスト
@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 bfs {
    my $goal = shift;
    my @que = (make_state($goal, index($goal, '0'), 0));
    my %check = ($goal => 1);
    my $front = 0;
    my $rear = 1;
    while ($front < $rear) {
        my $st = $que[$front++];
        my $s = $st->{'space'};
        foreach my $x (@{$adjacent[$s]}) {
            my $b = $st->{'board'};
            my $c = substr($b, $x, 1);
            $b =~ s/([0$c])(.*)([0$c])/$3$2$1/;     # 0 と交換する
            if (!$check{$b}) {
                my $new_st = make_state($b, $x, $st->{'move'} + 1);
                $check{$b} = 1;
                $que[$rear++] = $new_st;
            }
        }
    }
    my $max = $que[--$rear]->{'move'};
    while ($max == $que[$rear]->{'move'}) {
        my $b = $que[$rear--]->{'board'};
        print "$max, $b\n";
    }
}

# 実行
bfs("123456780");

初版 2015 年 5 月 24 日
改訂 2023 年 3 月 21 日

Copyright (C) 2015-2023 Makoto Hiroi
All rights reserved.

[ PrevPage | Perl | NextPage ]