8
$\begingroup$

Suppose you're driving on a closed 4x4 square grid of roads. At each intersection, one can choose to turn left or right or keep straight, as long as there is a road to drive onto. (No U-turns are allowed.) A map might look something like this:

grid

(Intersections are not to scale.) This can be properly represented with the following directed graph:

directed

(To drive on the left, flip the image.) A much simpler way to represent this is with a colored undirected graph:

undirected

(This is easily obtained with LineGraph[GridGraph[{4,4}]], although without the coloring.) In this case, there has to be an additional restriction: one cannot take two edges of the same color in a row (in order to enforce the no U-turn rule). Can one apply this restriction to FindPath and related functions in Mathematica?

Currently, the best method I have so far is to split the undirected graph by edge colors, and then multiply their adjacency matrices together. After using FindPath (or whatever) on this new graph, I then have to translate the results in the new graph back to the old graph. Is there any easier way to do this, particularly if using more than two colors? (The application that I was using this for involves deleting random edges, which would have to be somehow paired in the directed graph.)

$\endgroup$
  • $\begingroup$ Would it make sense to define color as a Property of each edge, find all paths of desired length between desired vertices, and discard paths having adjacent edges with the same Property? $\endgroup$ – bbgodfrey Jan 9 '17 at 5:46
  • $\begingroup$ @bbgodfrey Yes, although finding all paths could get computationally expensive.... $\endgroup$ – 404UserNotFound Jan 9 '17 at 7:05
  • $\begingroup$ Please add the code that generated the final figure of your question.. $\endgroup$ – bbgodfrey Jan 9 '17 at 13:16
  • $\begingroup$ @bbgodfrey The code would probably not be of much help, as the graph was created manually, by listing out all of the edges individually, and then highlighting the relevant edges, again chosen manually. $\endgroup$ – 404UserNotFound Jan 10 '17 at 7:09
  • $\begingroup$ The code still would be useful to and interested reader, saving him or her the trouble of writing out all the edges and removing the possibility of errors. $\endgroup$ – bbgodfrey Jan 10 '17 at 13:40
2
$\begingroup$

One approach is to compute many paths and delete those that cross either color twice in succession. Begin by defining the Graph as

g = Graph[Range[24], 
    {1 <-> 2, 1 <-> 4, 1 <-> 5, 2 <-> 3, 2 <-> 5, 2 <-> 6, 
     3 <-> 6, 3 <-> 7, 4 <-> 8, 4 <-> 11, 5 <-> 8, 5 <-> 9, 5 <-> 12, 
     6 <-> 9, 6 <-> 10, 6 <-> 13, 7 <-> 10, 7 <-> 14, 8 <-> 9, 8 <-> 11,
     8 <-> 12, 9 <-> 10, 9 <-> 12, 9 <-> 13, 10 <-> 13, 10 <-> 14, 
    11 <-> 15, 11 <-> 18, 12 <-> 15, 12 <-> 16, 12 <-> 19, 13 <-> 16, 
    13 <-> 17, 13 <-> 20, 14 <-> 17, 14 <-> 21, 15 <-> 16, 15 <-> 18, 
    15 <-> 19, 16 <-> 17, 16 <-> 19, 16 <-> 20, 17 <-> 20, 17 <-> 21, 
    18 <-> 22, 19 <-> 22, 19 <-> 23, 20 <-> 23, 20 <-> 24, 21 <-> 24, 
    22 <-> 23, 23 <-> 24}, 
     Properties -> Join[{"DefaultEdgeProperties" -> {EdgeStyle -> Blue}}, 
     Evaluate[# -> {EdgeStyle -> Red} & /@ {1 <-> 4, 2 <-> 3, 2 <-> 6, 
     3 <-> 6, 5 <-> 8, 5 <-> 9, 5 <-> 12, 7 <-> 10, 7 <-> 14, 
     8 <-> 9, 8 <-> 12, 9 <-> 12, 10 <-> 14, 11 <-> 15, 11 <-> 18, 
    13 <-> 16, 13 <-> 17, 13 <-> 20, 15 <-> 18, 16 <-> 17, 
    16 <-> 20, 17 <-> 20, 19 <-> 22, 19 <-> 23, 21 <-> 24, 22 <-> 23}]], 
     VertexCoordinates -> {{-2, 3}, {0, 3}, {2, 3}, {-3, 2}, {-1, 2}, {1, 2}, {3, 2}, 
    {-2, 1}, {0, 1}, {2, 1}, {-3, 0}, {-1, 0}, {1, 0}, {3, 0}, {-2, -1}, {0, -1}, 
    {2, -1}, {-3, -2}, {-1, -2}, {1, -2}, {3, -2}, {-2, -3}, {0, -3}, {2, -3}}, 
    VertexStyle -> Black, VertexLabels -> "Name"]

enter image description here

It differs from the third figure in the question in two ways. More importantly, colors are assigned as Properties, because GraphHighlight does not assign specific colors to specific edges in a way that can be accessed later. In addition, the vertices are labeled by their names for convenience.

A short path from vertex 1 to vertex 24, for instance, that do not cross either color twice in succession is easy to find.

FindShortestPath[g, 1, 24]
(* {1, 2, 6, 13, 20, 24} *)

Long paths are a different story. However, all 1197872 paths can be winnowed down to 800 in about 110 seconds. The longest visit 21 of the 24 vertices.

FindPath[g, 1, 24, 24, 10000000];
Length[%]
Select[%%, ! MemberQ[Partition[PropertyValue[{g, #}, EdgeStyle] & /@ 
    UndirectedEdge @@@ Partition[#, 2, 1], 2, 1], {z_, z_}] &];
Length[%]
SortBy[%%, Length] // Last
(* 1197872 *)
(* 800 *)
(* {1, 5, 12, 19, 23, 20, 16, 15, 11, 8, 9, 10, 7, 3, 6, 13, 17, 21, 24} *)

It can be displayed as

HighlightGraph[g, Style[UndirectedEdge @@@ Partition[%, 2, 1], Black, 
    Dashing[{.03, .03}], Thickness[.007]]]

enter image description here

$\endgroup$
  • $\begingroup$ While this may work for small examples, I was looking for a way to extrapolate this to, say, 8x8, which has exponentially more possibilities. Also, just because there aren't U-turns allowed at an intersection doesn't mean that an edge can't be taken in both directions (e.g. 1-4-8-12-15-11-4-1). $\endgroup$ – 404UserNotFound Jan 12 '17 at 20:54
  • $\begingroup$ @404UserNotFound Are you seeking a general procedure to find an arbitrary path between two points, the shortest path, a path of a specified length, all paths, or something else? Any of these are feasible, although substantial work could be required. In any case, I believe that I have provided a valid answer to the question you actually asked. $\endgroup$ – bbgodfrey Jan 12 '17 at 23:34

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.