如何从迷宫生成代码Mathematica中获取已删除墙的数组

Question

我试图从这个迷宫生成代码中删除所有已删除墙的数组。似乎无法使它工作，当我要求它打印它只会给我整个迷宫网格，而不是我要求的特定墙壁。

MazeGen2[m_, n_] := 
  Block[{$RecursionLimit = Infinity, 
    unvisited = Tuples[Range /@ {m, n}], maze, mazearray = {}, 
    mazeA},
   (*unvisited=Delete[unvisited,{{1},{2},{Length[
   unvisited]-1},{Length[unvisited]}}];*)
   (*Print[unvisited];*)

   maze = {{{{#, # - {0, 1}}, {#, # - {1, 0}}}} & /@ 
      unvisited, {{{0, n - 1}, {0, 0}, {m - 1, 
        0}}}};(*This generates the grid*)
   Print[maze];
   {unvisited = DeleteCases[unvisited, #];
      (*Print[unvisited];*)
      Do[
       If[MemberQ[unvisited, neighbor], 
        maze = DeleteCases[
          maze, {#, neighbor - {1, 1}} | {neighbor, # - {1, 1}}, {5}]
        (*mazeA=Flatten[AppendTo[mazearray,
        maze]];*)
        ; #0@neighbor],
       {neighbor, 
        RandomSample@{# + {0, 1}, # - {0, 1}, # + {1, 0}, # - {1, 
            0}}}
       ]
      } &@RandomChoice@unvisited;

   Flatten[maze]
   ];

Answer 1

我将您的代码追踪到Rosetta Code网站，并且 - 感谢您的支持！ - 这里是如何使用基于图形的替代方案进行迷宫生成。这是由用户AlephAlpha提供的：

MazeGraph[m_, n_] := 
Block[{$RecursionLimit = Infinity, grid = GridGraph[{m, n}], 
 visited = {}},
Graph[Range[m n],
 Reap[{AppendTo[visited, #];
     Do[
      If[FreeQ[visited, neighbor], 
       Sow[# <-> neighbor]; #0@neighbor],
      {neighbor, RandomSample@AdjacencyList[grid, #]}]} & @ 
   RandomChoice@VertexList@grid][[2, 1]], 
 GraphLayout -> {"GridEmbedding", "Dimension" -> {m, n}},
 EdgeStyle -> Directive[Opacity[1], AbsoluteThickness[12], Purple], 
 VertexShapeFunction -> None,
 VertexLabels -> "Name",
 VertexLabelStyle -> White,
 Background -> LightGray,
 ImageSize -> 300]];

 width = height = 8;

 maze = MazeGraph[width, height]

现在迷宫很容易解决方案：

path = FindShortestPath[maze, 1, Last[VertexList[maze]]];
solution = Show[
  maze,
  HighlightGraph[
   maze,
   PathGraph[path],
   EdgeStyle -> Directive[AbsoluteThickness[5], White],
   GraphHighlightStyle -> None]
  ];

也很容易找到已删除的墙 - 这里是原始GraphDifference和迷宫之间的GridGraph：

hg = HighlightGraph[
   GridGraph[{width, height}, 
    EdgeStyle -> 
     Directive[Opacity[0.2], Blue, AbsoluteThickness[1]]],
   EdgeList[GraphDifference[GridGraph[{width, height}], maze]],
   Background -> LightGray,
   ImageSize -> 300,
   GraphHighlightStyle -> {"Thick"}];

显示所有三个：

Row[{Labeled[maze, "maze"], Spacer[12], Labeled[hg, "deleted walls"], 
  Labeled[solution, "solution"]}]

为样式问题道歉 - 这是使用图表的难点......：）