CA 迷路

迷路を格子で考える。
 路に相当するサイト:0
 壁に相当するサイト:1
 出入口:e
ルール:路であって周囲に壁が3つもしくは4つの時、この路を壁に変える。
In [ ]:
maze = Import["http://symbolics.jp/SS/Mathematica/maze.csv"];
Head[maze]
Out[ ]:
List
In [ ]:
Short[maze, 4]
Out[ ]:
Output
In [ ]:
showMaze[board_] := ArrayPlot[Reverse[board], 
        ColorRules -> {e -> Red, 1 -> Black, 0 -> White}]
In [ ]:
maze // showMaze
Out[ ]:
Output

Fortranスタイルによる実装

In [ ]:
oneStepOfMaze[board0_] := Module[{vnNeighbor, checkWall, self},
  checkWall[0, u_, r_, d_, l_] := 
        2 /; Count[{u, r, d, l}, 1] + Count[{u, r, d, l}, 2] >= 3;
  checkWall[self_, _, _, _, _] := self /; True;
  vnNeighbor[board_, i_, j_] :=
   Module[{pos, rowmax, colmax},
    {rowmax, colmax} = Dimensions[board];
    pos[p_, lmt_] := lmt + p /; p <= 0;
    pos[p_, lmt_] := (p - lmt) /; p > lmt;
    pos[p_, lmt_] := p /; True;
    {board[[i, j]],
     board[[ pos[i - 1, rowmax], pos[j, colmax] ]],
     board[[ pos[i, rowmax], pos[j + 1, colmax] ]],
     board[[ pos[i + 1, rowmax], pos[j, colmax] ]],
     board[[ pos[i, rowmax], pos[j - 1, colmax] ]]}];
  Array[checkWall @@ vnNeighbor[board0, ##] &, Dimensions[board0]]]

1ステップのみの変化。

In [ ]:
oneStepOfMaze[maze] // showMaze
Out[ ]:
Output

MapThread, Map, FixedPointによる実装

In [ ]:
findPathOfMaze[board_] := Module[{rule},
  rule[0, 1, 1, 1, 0] := 1;
  rule[0, 1, 1, 0, 1] := 1;
  rule[0, 1, 0, 1, 1] := 1;
  rule[0, 0, 1, 1, 1] := 1;
  rule[0, 1, 1, 1, 1] := 1;
  rule[x_, _, _, _, _] := x;
  updateMaze[maze_] :=
   MapThread[rule,
      Map[RotateRight[maze, #] &, {{0, 0}, {0, 1}, {1, 0}, {0, -1}, {-1,0}}], 2];
  FixedPoint[updateMaze, board]
  ]
  
  Timing[
      findPathOfMaze[maze] // showMaze]
Out[ ]:
Output

Listable, Map, Nestによる実装

In [ ]:
Clear[findPathOfMaze]; 
findPathOfMaze[board_] := Module[{rule, vnNeighbors0},
 rule[0, 1, 1, 1, 0] := 1;
  rule[0, 1, 1, 0, 1] := 1;
  rule[0, 1, 0, 1, 1] := 1;
  rule[0, 0, 1, 1, 1] := 1;
  rule[0, 1, 1, 1, 1] := 1;
  rule[x_, _, _, _, _] := x;
  Attributes[rule] = Listable; 
  vnNeighbors0[maze_] := 
   Map[RotateRight[maze, #] &, {{0, 0}, {0, 1}, {1, 0}, {0, -1}, {-1, 0}}];
  updateMaze[maze_] := rule @@ vnNeighbors0[maze];
  Nest[updateMaze, board, 220]]
  
  Timing[
      findPathOfMaze[maze] // showMaze]
Out[ ]:
Output

CellularAutomatonによる実装

In [ ]:
mazesteps =
  With[{
    rule = { {{_, 0, _}, {1, 0, 1}, {_, 1, _}} -> 1,
                  {{_, 1, _}, {0, 0, 1}, {_, 1, _}} -> 1,  
                  {{_, 1, _}, {1, 0, 0}, {_, 1, _}} -> 1, 
                  {{_, 1, _}, {1, 0, 1}, {_, 0, _}} -> 1, 
                  {{_, _, _}, {_, e_, _}, {_, _, _}} -> e},
    init = maze,
    step = 220},
   CellularAutomaton[rule, init, step]];
   
 Timing[
    mazesteps[[-1]] // showMaze]
Out[ ]:
Output
In [ ]: