Mathematica: True Labyrinth (827 chars)
Originally, I produced a path from {1,1,1} to {5,5,5} but because there were no possible wrong turns to be made, I introduced forks or "decision points" (vertices of degree >2) where one would need to decide which way to go. The result is a true maze or labyrinth.
The "blind alleys" were far more challenging to solve than finding a simple, direct path. The most challenging thing was to eliminate cycles within the path while allowing cycles off the solution path.
The following two lines of code are only used for rendering the drawn graphs, so the code does not count, as it is not employed in the solution.
o = Sequence[VertexLabels -> "Name", ImagePadding -> 10, GraphHighlightStyle -> "Thick",
ImageSize -> 600];
o2 = Sequence[ImagePadding -> 10, GraphHighlightStyle -> "Thick", ImageSize -> 600];
Code used:
e[c_] := Cases[EdgeList[GridGraph[ConstantArray[5, 3]]], j_ \[UndirectedEdge] k_ /; (MemberQ[c, j] && MemberQ[c, k])]
m[] :=
Module[{d = 5, v = {1, 125}},
While[\[Not] MatchQ[FindShortestPath[Graph[e[v]], 1, 125], {1, __, 125}],
v = Join[v, RandomSample[Complement[Range[125], v], 1]]];
Graph[e[Select[ConnectedComponents[Graph[e[v]]], MemberQ[#, 1] &][[1]]]]]
w[gr_, p_] := EdgeDelete[gr, EdgeList[PathGraph[p]]]
y[p_, u_] := Select[Intersection[#, p] & /@ ConnectedComponents[u], Length[#] > 1 &]
g = HighlightGraph[lab = m[], PathGraph[s = FindShortestPath[lab, 1, 125]],o]
u = w[g, s]
q = y[s, u]
While[y[s, u] != {}, u = EdgeDelete[u, Take[FindShortestPath[u, q[[1, r = RandomInteger[Length@q[[1]] - 2] + 1]],
q[[1, r + 1]]], 2] /. {{a_, b_} :> a \[UndirectedEdge] b}];
q = y[s, u]]
g = EdgeAdd[u, EdgeList@PathGraph[s]];
Partition[StringJoin /@ Partition[ReplacePart[Table["x", {125}],
Transpose[{VertexList[g], Table["o", {Length[VertexList@g]}]}]/. {{a_, b_} :> a -> b}], {5}], 5]
Sample output
{{"oxooo", "xxooo", "xoxxo", "xoxxo", "xxoox"},
{"ooxoo", "xoooo", "ooxox", "oooxx", "xooxx"},
{"oooxx", "ooxxo", "ooxox", "xoxoo", "xxxoo"},
{"oxxxx", "oooox", "xooox", "xoxxx", "oooxx"},
{"xxxxx", "ooxox", "oooox", "xoxoo", "oooxo"}}
Under the hood
The picture below shows the labyrinth or maze that corresponds to the solution ({{"ooxoo",...}}
displayed above:
![solution1](../../I/static/images/e98545ff5c680a59b713f5d7ad4426bab5db2091b3024968b1cdc0d21d22d9b0.png)
Here is the same labyrinth inserted in a 5x5x5 GridGraph
. The numbered vertices are nodes on the shortest path out of the labyrinth. Note the forks or decision points at 34, 64, and 114.
I'll include the code used for rendering the graph even though it is not part of the solution:
HighlightGraph[gg = GridGraph[ConstantArray[5, 3]], g,
GraphHighlightStyle ->"DehighlightFade",
VertexLabels -> Rule @@@ Transpose[{s, s}] ]
![solution2](../../I/static/images/abd6159a04c01edd6390356979093d383c52f4ba74ae7f885c6f70f0f248ac49.png)
And this graph shows only the solution to the labyrinth:
HighlightGraph[gg = GridGraph[ConstantArray[5, 3]],
Join[s, e[s]], GraphHighlightStyle -> "DehighlightFade", VertexLabels -> Rule @@@ Transpose[{s, s}] ]
![solution3](../../I/static/images/2b1a0cfce3b55f308f0ec4057b12ca5a2304302e8a619d50571c5d06bd7a7973.png)
Finally, some definitions that may help reading the code:
![definitions](../../I/static/images/5ef615b1295221b4cfb16117492421376213017f9706c7e30f052c6b1b62a953.png)
Original solution (432 char, Produced a path but not a true maze or labyrinth)
Imagine a 5x5x5 large solid cube made up of distinct unit cubes. The following begins without unit cubes at {1,1,1} and {5,5,5}, since we know they must be part of the solution. Then it removes random cubes until there is an unimpeded path from {1,1,1} to {5,5,5}.
The "labyrinth" is the shortest path (if more than one is possible) given the unit cubes that have been removed.
d=5
v={1,d^3}
edges[g_,c_]:=Cases[g,j_\[UndirectedEdge] k_/;(MemberQ[c,j]&&MemberQ[c,k])]
g:=Graph[v,edges[EdgeList[GridGraph[ConstantArray[d,d]]],v]];
While[\[Not]FindShortestPath[g,1,d^3]!={},
v=Join[v,RandomSample[Complement[Range[d^3],v],1]]]
Partition[Partition[ReplacePart[
Table["x",{d^3}],Transpose[{FindShortestPath[g,1,d^3],Table["o",{Length[s]}]}]
/.{{a_,b_}:> a->b}],{d}]/.{a_,b_,c_,d_,e_}:> StringJoin[a,b,c,d,e],5]
Example:
{{"ooxxx", "xxxxx", "xxxxx", "xxxxx", "xxxxx"},
{"xoxxx", "xoooo", "xxxxo", "xxxxo", "xxxxo"},
{"xxxxx", "xxxxx", "xxxxx", "xxxxx", "xxxxo"},
{"xxxxx", "xxxxx", "xxxxx", "xxxxx", "xxxxo"},
{"xxxxx", "xxxxx", "xxxxx", "xxxxx", "xxxxo"}}
Technically this is not yet a true labyrinth, since there are no wrong turns that one can make. But I thought it interesting as a start since it relies on graph theory.
The routine actually makes a labyrinth but I plugged up all empty locations that could give rise to cycles. If I find a way to remove cycles I will include that code here.
If something is unclear, just ask me :) – ajax333221 – 2012-03-25T18:43:26.543
Your specification of "printing in an understandable way" is still very vague. A slightly more strict rule wouldn't harm. – ceased to turn counterclockwis – 2012-03-25T18:46:49.853
@leftaroundabout I think I should specify an exact output format to remove all vagueness. But I can't picture any way of expressing multidimensional things, I need help plx before someone start working – ajax333221 – 2012-03-25T18:50:42.650
You could just ask for each level of the maze to be printed consecutively as ASCII art, with, say, an empty line between levels. – Ilmari Karonen – 2012-03-25T18:54:34.657
3However, there's one detail I'd like a clarification on: are walls placed between squares, or does a wall fill a whole square? – Ilmari Karonen – 2012-03-25T18:56:18.460
@IlmariKaronen added "Don't see them as walls, instead see them as a 5x5 stack of squares that some of them are missing and you can go through the missing ones" – ajax333221 – 2012-03-25T19:43:36.110
1you say 5x5 (a 2D array) in a few places, yet the code samples and image suggest 5x5x5 (a 3D array). I assume the 3D array is what's meant? – Kae Verens – 2012-03-25T21:01:42.417
@KaeVerens yes, sorry about that (updating) – ajax333221 – 2012-03-25T21:02:49.537
1how is it decided that the solution is a valid labyrinth? I mean, is it the number of offshoots that the right path has? is it something to do with the ratio of 1s to 0s? – Kae Verens – 2012-03-25T21:16:57.467
2When you say "The labyrinth must be created randomly", what limitations should we infer? I presume, for example, that you don't intend to allow, as a literal reading of the rules currently does, a program which chooses between two hard-coded outputs at random. – Peter Taylor – 2012-03-25T21:41:00.060
@ajax Why not accept output in {x,y,z} coordinates? – DavidC – 2012-03-25T23:16:28.543
Please post a sample labyrinth. – boothby – 2012-03-26T01:48:08.910
@KaeVerens it will be very hard to test if a solution is valid indeed, I guess we will need to manually build some random generated mazes in 3d and start testing. – ajax333221 – 2012-03-26T02:23:02.883
@DavidCarraher chosing is different than creating. I think the current definition is ok (but I will try to clarify that in the next update) – ajax333221 – 2012-03-26T02:25:51.693
Since there are 8 corners, but the opposite corners (Start-End) are indistinguishable from (End-Start), there are 4 possible Start-Corners to consider. Or can we say, that we only consider one start corner, since the other solutions are symmetric? – user unknown – 2012-03-26T19:17:43.673
Another question:
exactly 1 solution
prohibits circular ways. But what about dead ends that lead nowhere - they are allowed, aren't they? – user unknown – 2012-03-26T19:30:37.200@userunknown yes, there could be 1 solution with dead ends as long as they don't make a circuit to either the same way or the solution – ajax333221 – 2012-03-26T19:38:13.220
just out of curiosity, how can a block be accessible if it's a wall. and if that's no problem why can't I just declare every block out of the main path a wall? – Ali1S232 – 2012-03-27T00:15:28.337