Finding a "not-shortest" path between two vertices

In designing a routine for making a simple three dimensional (5x5x5) labyrinth, I realized that my solutions (a solution is a labyrinth includes a single path from {1, 1, 1} to {5, 5, 5} in a 5 x5x5 grid) almost never wandered or "doubled back". This feature makes for a somewhat uninteresting labyrinth (see a labyrinth and its solution path, below); a person in the labyrinth can find the exit rather quickly by avoiding subpaths that turn back.

Finding a "not-shortest" path between two vertices

Here's why the solution did not require doubling back: FindShortestPath was used to determine the solution path between {1,1,1} and {5,5,5}, that is, between vertex 1 and vertex 125 (see the labyrinth as a graph in the plane below), before circuits within the path were pruned. The shortest path will generally be the path that reaches the exit most directly.

Finding a "not-shortest" path between two vertices

How can I find a paths between start and finish vertices that are ostensibly not the shortest path? This is easy enough through visual inspection. But I'd like to compute a path that is not the shortest path.

Note: The above graph and its respective labyrinth have not yet been pruned. By pruning I mean the removal of alternative paths for reaching vertex 125 from vertex 1. Once a labyrinth has been properly pruned, one can only reach the finish vertex by traversing the unique solution path (and perhaps making some wrong turns into dead ends).



Code for above graph:

edges= {1 \[UndirectedEdge] 2, 2 \[UndirectedEdge] 3, 3 \[UndirectedEdge] 4,  1 \[UndirectedEdge] 6, 2 \[UndirectedEdge] 7, 6 \[UndirectedEdge] 7,  6 \[UndirectedEdge] 11, 7 \[UndirectedEdge] 12,  11 \[UndirectedEdge] 12, 12 \[UndirectedEdge] 13,  10 \[UndirectedEdge] 15, 11 \[UndirectedEdge] 16, 12 \[UndirectedEdge] 17, 16 \[UndirectedEdge] 17, 13 \[UndirectedEdge] 18, 17 \[UndirectedEdge] 18,  18 \[UndirectedEdge] 19, 17 \[UndirectedEdge] 22, 19 \[UndirectedEdge] 24, 24 \[UndirectedEdge] 25, 1 \[UndirectedEdge] 26, 3 \[UndirectedEdge] 28, 4 \[UndirectedEdge] 29, 28 \[UndirectedEdge] 29, 29 \[UndirectedEdge] 30, 6 \[UndirectedEdge] 31, 26 \[UndirectedEdge] 31, 7 \[UndirectedEdge] 32, 31 \[UndirectedEdge] 32, 29 \[UndirectedEdge] 34, 10 \[UndirectedEdge] 35, 30 \[UndirectedEdge] 35, 34 \[UndirectedEdge] 35, 11 \[UndirectedEdge] 36, 31 \[UndirectedEdge] 36, 12 \[UndirectedEdge] 37,  32 \[UndirectedEdge] 37, 36 \[UndirectedEdge] 37, 13 \[UndirectedEdge] 38, 37 \[UndirectedEdge] 38, 34 \[UndirectedEdge] 39, 38 \[UndirectedEdge] 39, 15 \[UndirectedEdge] 40, 35 \[UndirectedEdge] 40,  39 \[UndirectedEdge] 40, 16 \[UndirectedEdge] 41, 36 \[UndirectedEdge] 41, 17 \[UndirectedEdge] 42,  37 \[UndirectedEdge] 42, 41 \[UndirectedEdge] 42, 18 \[UndirectedEdge] 43, 38 \[UndirectedEdge] 43,  42 \[UndirectedEdge] 43, 40 \[UndirectedEdge] 45, 43 \[UndirectedEdge] 48, 24 \[UndirectedEdge] 49, 48 \[UndirectedEdge] 49, 25 \[UndirectedEdge] 50, 45 \[UndirectedEdge] 50, 49 \[UndirectedEdge] 50, 26 \[UndirectedEdge] 51, 28 \[UndirectedEdge] 53, 29 \[UndirectedEdge] 54, 53 \[UndirectedEdge] 54,  30 \[UndirectedEdge] 55, 54 \[UndirectedEdge] 55, 31 \[UndirectedEdge] 56, 51 \[UndirectedEdge] 56, 32 \[UndirectedEdge] 57, 56 \[UndirectedEdge] 57,  53 \[UndirectedEdge] 58, 57 \[UndirectedEdge] 58,  35 \[UndirectedEdge] 60, 55 \[UndirectedEdge] 60,  36 \[UndirectedEdge] 61, 56 \[UndirectedEdge] 61,  40 \[UndirectedEdge] 65, 60 \[UndirectedEdge] 65,  41 \[UndirectedEdge] 66, 61 \[UndirectedEdge] 66, 42 \[UndirectedEdge] 67, 66 \[UndirectedEdge] 67,  45 \[UndirectedEdge] 70, 65 \[UndirectedEdge] 70, 69 \[UndirectedEdge] 70, 66 \[UndirectedEdge] 71, 67 \[UndirectedEdge] 72, 71 \[UndirectedEdge] 72, 48 \[UndirectedEdge] 73, 72 \[UndirectedEdge] 73, 55 \[UndirectedEdge] 80, 56 \[UndirectedEdge] 81, 57 \[UndirectedEdge] 82, 77 \[UndirectedEdge] 82, 81 \[UndirectedEdge] 82, 60 \[UndirectedEdge] 85,  80 \[UndirectedEdge] 85, 84 \[UndirectedEdge] 85,  61 \[UndirectedEdge] 86, 81 \[UndirectedEdge] 86,  84 \[UndirectedEdge] 89, 88 \[UndirectedEdge] 89,  66 \[UndirectedEdge] 91, 86 \[UndirectedEdge] 91, 67 \[UndirectedEdge] 92, 91 \[UndirectedEdge] 92,  88 \[UndirectedEdge] 93, 92 \[UndirectedEdge] 93, 69 \[UndirectedEdge] 94, 89 \[UndirectedEdge] 94,  93 \[UndirectedEdge] 94, 71 \[UndirectedEdge] 96,  91 \[UndirectedEdge] 96, 72 \[UndirectedEdge] 97,  92 \[UndirectedEdge] 97, 96 \[UndirectedEdge] 97, 73 \[UndirectedEdge] 98, 93 \[UndirectedEdge] 98,  97 \[UndirectedEdge] 98, 94 \[UndirectedEdge] 99, 98 \[UndirectedEdge] 99, 81 \[UndirectedEdge] 106, 101 \[UndirectedEdge] 106, 82 \[UndirectedEdge] 107, 106 \[UndirectedEdge] 107, 85 \[UndirectedEdge] 110,  86 \[UndirectedEdge] 111, 106 \[UndirectedEdge] 111, 107 \[UndirectedEdge] 112, 111 \[UndirectedEdge] 112,  88 \[UndirectedEdge] 113, 112 \[UndirectedEdge] 113,  89 \[UndirectedEdge] 114, 113 \[UndirectedEdge] 114,  110 \[UndirectedEdge] 115, 114 \[UndirectedEdge] 115,  93 \[UndirectedEdge] 118, 113 \[UndirectedEdge] 118,  94 \[UndirectedEdge] 119, 114 \[UndirectedEdge] 119, 118 \[UndirectedEdge] 119, 96 \[UndirectedEdge] 121, 97 \[UndirectedEdge] 122, 121 \[UndirectedEdge] 122, 98 \[UndirectedEdge] 123, 118 \[UndirectedEdge] 123, 122 \[UndirectedEdge] 123, 99 \[UndirectedEdge] 124, 119 \[UndirectedEdge] 124, 123 \[UndirectedEdge] 124, 124 \[UndirectedEdge] 125}   HighlightGraph[lab=Graph[edges],  PathGraph[s = FindShortestPath[lab, 1, 125]],     VertexLabels -> "Name", ImagePadding -> 10,     GraphHighlightStyle -> "Thick", ImageSize -> 600] 


Update

I posted below a CW response that lays out some ideas as to how to generate a labyrinth. Feel free to make your own edits to that code.

Replay

You can try giving your edges random weights so that FindShortestPath is forced to take a different path. Here are some different possible paths —

Table[HighlightGraph[lab = Graph[edges, EdgeWeight -> RandomInteger[1000, Length[edges]]],
    PathGraph[s = FindShortestPath[lab, 1, 125]], VertexLabels -> "Name",
    ImagePadding -> 10, GraphHighlightStyle -> "Thick", ImageSize -> 600], {6}
] ~Partition~ 3 // Grid

Finding a "not-shortest" path between two vertices

If you want to be really nasty, traverse the entire graph (trying various vertices as starting points) and restrict the search for a shortest path to the traverse tree. Some of these will be quite long.

edges = {1 \[UndirectedEdge] 2, 2 \[UndirectedEdge] 3, ... 124 \[UndirectedEdge] 125};
g = Graph[edges];
h = Reap[DepthFirstScan[g, 7, {"FrontierEdge" -> Sow}]][[2, 1]]);
t = FindShortestPath[Graph[h], 1, 125];

(This use of DepthFirstScan is from an example on its help page.) This solution, obtained by a traversal starting at vertex 7, uses 75 of the 151 edges. It was found by varying the starting vertex of h from 1 through 125 and picking the one for which the length of t is as long as possible.

HighlightGraph[g, {PathGraph[t], Style[{1, 125}, Yellow],
    Labeled[{1, 125}, "*"]}, GraphHighlightStyle -> "Thick"]

Finding a "not-shortest" path between two vertices

Here's an approach based on R.M's response and on celtschk's idea of pushing the labyrinth toward vertices known not to be on the shortest path. I removed the constraint that parallel tunnels should be avoided. I also set aside the issue of dead ends and misleading paths for later. It struck me as cleaner to find an elaborate labyrinth directly within the complete 5x5x5 grid, and then add misleading paths later. Perhaps you have some ideas on how to add false paths.

Feel free to contribute your own improvements.

Also, I know that there is still a glitch or two that occasionally causes the program to fail to find a shortest path.

Finding a "not-shortest" path between two vertices

The commented code follows:

ClearAll[f, maze]

(* Randomly selects two vertices to pass through, avoiding those near \
 start or finish *)
stops :=
  RandomSample[
  Complement[
    Range[125], {1, 2, 6, 7, 26, 27, 31, 32, 95, 99, 100, 119, 120,
       125, 124}], 2]

 (* The 5 x 5 x 5 grid *)

g1 := GridGraph[ConstantArray[5, 3], EdgeStyle -> Thin,
  VertexSize -> Small, ImagePadding -> 15,
  EdgeWeight -> RandomInteger[{1, 1000}, 300];

(* Generate an indirect path from start to end that does not visit \
  any vertices in path *)

f[v1_, v2_, path_: {}] :=
   Join[path,
        FindShortestPath[
        VertexDelete[g1,
        [email protected][Length[path] == 0, path, Most[path]]], v1, v2]]

(* Maze that goes from 1 to stops[[1]] to stops[[2]] to 125 *)
maze :=
  Module[{st = stops,
     s = DeleteDuplicates[
     f[st[[2]], 125, f[st[[1]], st[[2]], f[1, st[[1]], {}]]]]},
     HighlightGraph[g1, PathGraph[s],
     VertexLabels -> s /. {v_Integer :> v -> v}, ImagePadding -> 10,
     GraphHighlightStyle -> "Thick", ImageSize -> 250]]

Table[maze, {6}]

I'm a bit unclear as to why this works .... however, using FindPath instead of FindShortestPathyields a route through 71 of the 88 vertices which definitely doubles back on itself.

HighlightGraph[lab = Graph[edges], PathGraph[s = [email protected]@FindPath[lab, 1, 125]],
   VertexLabels -> "Name", ImagePadding -> 10, GraphHighlightStyle -> "Thick", ImageSize -> 600]

Finding a "not-shortest" path between two vertices

HighlightGraph[GridGraph[{5, 5, 5}, EdgeStyle -> LightGray, VertexStyle -> LightGray,
                VertexSize -> 0.3, BaseStyle -> EdgeForm[White]],
                PathGraph[s], VertexLabels -> "Name", ImagePadding -> 10,
                GraphHighlightStyle -> "Thick", ImageSize -> 400]

Finding a "not-shortest" path between two vertices

Using the form FindPath[start,end,Infinity,All] will find all paths through the graph. Although, for a 5x5x5 grid there are likely to be 10,000's of paths and generating this list may take several hours... Trimming such a list to only include longer paths (e.g. FindPath[start,end,{55,60},All]) might yield a more manageable, yet still interesting set of paths to play with.


Making a labyrinth

... here is an attempt at a all-in-one labyrinth maker:

mesh = GridGraph[{4, 4, 4}];

(*generating a pseudorandom subset of edges that include the start and end vertices*)

edgelab = EdgeList[mesh][[Union[{1, 144}~Join~RandomInteger[{1, 144}, 130]]]];

(*graph of the subset of edges*)

labset = Graph[edgelab];

(*finding a path...*)

path = [email protected]@FindPath[labset, 1, 64, {30, 45}];

HighlightGraph[labset, PathGraph[path], VertexLabels -> "Name", ImagePadding -> 10,
               GraphHighlightStyle -> "Thick", ImageSize -> 600]

Finding a "not-shortest" path between two vertices

Varying the number of RandomInteger's generated (in this case 130) is the key control on the connectivity of the labyrinth. Of course it is possible to create disconnected 'chambers', but this may not be such a problem (depending on the final application).

Category: programming Time: 2012-04-09 Views: 1

Related post

iOS development

Android development

Python development

JAVA development

Development language

PHP development

Ruby development

search

Front-end development

Database

development tools

Open Platform

Javascript development

.NET development

cloud computing

server

Copyright (C) avrocks.com, All Rights Reserved.

processed in 0.229 (s). 12 q(s)