Mathematicaで作った迷路最近、セル・オートマトンを Mathematica で計算する話を聞く機会があり、そこで聞いた話に、迷路をセル・オートマトンで解くというものがあった。例によって(?)脇道好きの血がうずき、試してみたくてたまらなくなったのだけど、これを試すためにはまず迷路を作らなければならない。

「迷路 作り方」でウェブ検索すると、たくさんのページがヒットする。今回は、その中で見つけた「穴堀り法」を Mathematica 7 でやってみる。

方眼紙で、壁の部分に 1 を、通路の部分に 0 を書き込んで迷路を表現することにしたとき、穴堀り法では次のようにして迷路を作成する。

  1. 穴堀り法の説明図まず迷路全体を壁(1)で埋めておく。
  2. 内側のどこか適当な場所を「掘り始め地点」に決める。一番外周は壁(1)なので、この掘り始め地点は、偶数列偶数行の地点から選ぶようにする。
  3. 適当に掘り進める(1 を 0 に変えていく)。すでに掘り終わった通路(0)に接続してしまうのは NG。つまり、進行方向の1つ進んだ先が壁(1)のときにのみ、その方向に掘り進めることができる。
  4. どちらを向いても「1つ進んだ先が壁(1)」ではない場合、行き詰まったと見なして、すでに掘り終わった通路のどこか適当なところに移動し、そこを新しい「掘り始め地点」にして 3 に戻る。
  5. 迷路全体に通路ができたらおしまい。

早速、迷路の縦横のサイズ n = 13 で始めてみる。迷路 maze を 1 で初期化された(つまり壁で埋めた)二次元リストとして用意し、掘り始め地点 cp を決める。cp は偶数行偶数列限定なので、1 〜 (n-1)/2 の整数乱数の組を2倍することで決める。掘り進む様子を確認できるように、Dynamic を使って maze を表示しておこう。もちろん最初はすべて壁(1)なので真っ黒な四角が表示されるだけだ。ColorRules -> {e -> Red} は、後で出入り口を色分けするためのおまじない。

n = 13; maze = ConstantArray[1, {n, n}];
cp = 2 RandomInteger[{1, (n - 1)/2}, 2];
Dynamic@ArrayPlot[maze, ColorRules -> {e -> Red}]

迷路作成初期状態

指定した位置を掘る(1 を 0 に変える)関数 dig を定義し、まず掘り始め地点を掘る。手順4で戻ってくるときのために、掘り終わった位置の情報を変数 hst に保存しておく。

dig[{i_, j_}] := maze[[i, j]] = 0;
dig[cp]; hst = {cp};

次に、cp から掘り進めることが可能な方向を調査する。cp から「1つ進んだ先(壁ひとつはさんだ向こう側)」の位置は、{-2, 0}, {0, -2}, {0, 2}, {2, 0} のいずれかを cp に足したものとして表せるので、このうちの採用可能なものを抽出して使えば良い。この抽出は繰り返すので、関数 opt として定義して使う。抽出結果は変数 os に入れておく。

opt[p_] := Module[{i, j}, Select[{{-2, 0}, {0, -2}, {0, 2}, {2, 0}},
  ({i, j} = p + #; 1 < i < n && 1 < j < n && maze[[i, j]] == 1) &]];
os = opt[cp];

os の中からランダムに1つ選択した方向 o に関数 dig で掘る。cp+o に掘り抜けるには cp+o/2 も掘る必要があることに注意。掘ると同時に cp を更新して hst にも登録する。

o = RandomChoice[os];
dig[cp + o/2]; dig[cp += o]; AppendTo[hst, cp];

これを行き詰まるまで繰り返す。行き詰まったかどうかは、行き先可能方向を抽出したリスト os = opt[cp] が空リスト {} かどうかで調べられるので、上の3行を次のように変更すれば、行き詰まるまで掘り進められる。

While[(os = opt[cp]) != {},
  o = RandomChoice[os];
  dig[cp + o/2]; dig[cp += o]; AppendTo[hst, cp]];

このループを抜けたら行き詰まっているので、手順4に従って、掘り終わった位置のリスト hst から次の掘り始め地点をランダムで選択する。ここで、単にランダムに選択すると、すでにどちらにも掘り進められなくなっている「使えない」位置が選択されることがある。そこで、選択をランダムにするのではなく、hst をランダムに並べ替えてから、先頭が「使える」位置になるまで先頭を捨てることにする。

hst = RandomSample[hst];
While[hst != {} && opt[First[hst]] == {}, hst = Rest[hst]]; (* A *)
cp = First[hst];

あとは迷路全体を掘り尽くすまでこれを繰り返せば OK。掘り尽くしたかどうかは、上の A が終わった時点で hst が空リストかどうかで判断できる。そこで、掘る部分とまとめて次のように書き換える。いちばん外側の While の第一引数が複数の文になっていて、継続判定を与える真偽値は B の式が与えていることに注意。

While[hst = RandomSample[hst];
  While[hst != {} && opt[First[hst]] == {}, hst = Rest[hst]];
  hst != {}, (* B *)
  cp = First[hst];
  While[(os = opt[cp]) != {},
    o = RandomChoice[os];
    dig[cp + o/2]; dig[cp += o]; AppendTo[hst, cp]]];

最後に、出入り口の壁を 1 から e に変えて完成。出入り口は四隅のどこでも良いので、ここでは左上と右下の側面にしておく。

maze[[2, 1]] = maze[[-2, -1]] = e;

ここまでやって、最初に出力した真っ黒な四角が次のような迷路になっていれば OK。

迷路完成〜

迷路ができたのでようやくセル・オートマトン。
セル・オートマトンは、生物の繁殖や物質の拡散、森林火災延焼のシミュレーションなどによく使われているもの(Wolfram のドキュメントではもっと違った方向の話ばかり載ってるが...)で、僕の理解で無理矢理まとめると、すべてのサイト(方眼)における次ステップの状態を現ステップにおける各サイトの近傍情報から決定する、というのを繰り返すもの。で、これで迷路をどうやって解くかというと、

各ステップで袋小路の先端に相当する部分は壁で埋めてしまう

というのを繰り返す。そんだけ。
もちろん、浮き島の中にゴールがあったりする迷路では使えないけど、今回つくったような迷路であればまったく問題ない。

Mathematica には ver.4.2 から CellularAutomaton という専用関数があるのでこれを使用する。この関数、各ステップの変換ルールを指定して使うもので、このルールの指定方法はいろいろあるのだが、今回は、サイトが袋小路の先端になる近傍9サイトのパターンをすべて指定する書き方を採用した。
袋小路になるパターンは、通路(0)の部分で3方向が壁(1)で1方向のみ開いている(0)場合なので、東西南北のそれぞれが開いている場合の4通りに、何もしない「それ以外」を追加して次のように書けば OK。FixedPoint は、値(今回の場合は変数 maze)が変化しなくなるまで第一引数の関数を繰り返し適用する関数。これで迷路が解け切るまで繰り返した後の結果が得られる。

ArrayPlot[FixedPoint[CellularAutomaton[{
    {{_, 0, _}, {1, 0, 1}, {_, 1, _}} -> 1,
    {{_, 1, _}, {0, 0, 1}, {_, 1, _}} -> 1,
    {{_, 1, _}, {1, 0, 0}, {_, 1, _}} -> 1,
    {{_, 1, _}, {1, 0, 1}, {_, 0, _}} -> 1,
    {{_, _, _}, {_, other_, _}, {_, _, _}} :> other}], maze],
  ColorRules -> {e -> Red}]

迷路探索完了〜

せっかく(?)なので、迷路生成から迷路探索までのアニメーションを作ってみた。生成は1本の通路だけが延びていくのがにょろにょろしていてかわいいし、探索はいっせいに波が引くようにすべての袋小路が縮んでいってなんだか寂しいというかはかない。...え?そんなことないっスか?

※この記事の内容は執筆者の個人的見解で、ヒューリンクスによる公式情報ではありません。[免責事項]

トラックバック

この記事へのトラックバックURL
http://blog.hulinks.co.jp/cgi/mt/mt-tb.cgi/411
内容に対しての関連性がみられないものは削除する場合があります

「Mathematica では繰り返しのコードを書いたら負け」とは、以前の記事に... 続きを読む

コメントの投稿

Emailアドレスは表示されません。は必須項目です。
ヒューリンクス取り扱い製品の内容や購入に関するお問い合わせはヒューリンクスサイト連絡先へお願いいたします。投稿前にその他の注意事項もご覧ください。

HULINKS サイトの新着情報