10
$\begingroup$

In Mathematica, we can use FindPath[graph, start, end, Infinity, All] to find all self-avoiding paths, which means the path can not cross vertex and edge repeatedly.

enter image description here

Drawing code as follows:

v = Graphics[{GrayLevel[1], EdgeForm[RGBColor[0, 0, 0]], Disk[{0, 0}]}];
G4 = GridGraph[{4, 4}, VertexSize -> 0.2, VertexShape -> v, ImageSize -> 640, VertexLabels -> Table[i -> Placed[i, Center], {i, 16}]];
paths = FindPath[G4, 1, 16, Infinity, All];
ArrowedGraph[graph_, path_] := HighlightGraph[
    graph, (*Rule@@@Partition[path,2,1]*){},
    Prolog -> {Blue, Thickness[.003], Arrowheads[Table[.03, 15]], Arrow[BSplineCurve[GraphEmbedding[graph][[path]], SplineDegree -> 2]]}
]
ArrowedGraph[G4, RandomChoice@paths]

It can find all the 184 self-avoiding paths.


Edge self-avoiding path allow passes through the same point multiple times, but the edges cannot be repeated.

For example, the path {1, 5, 6, 7, 3, 2, 6, 10, 11, 12, 8, 7, 11, 15, 16} is a legal edge self-avoiding path, but not a legal self-avoiding path.

enter image description here

How to find all such paths?

$\endgroup$
5
$\begingroup$

Using FindPath on LineGraph[G4] with all pairs of edges where the first edge in each pair is incident to 1 and the second incident to 16:

edgepairs = Tuples[Map[EdgeIndex[G4, #] &] /@ (IncidenceList[G4, #] & /@ {1, 16})];
epaths = FindPath[LineGraph[G4], ##, Infinity, All]&@@@edgepairs; 

Using only the first pair of edges incident to vertices 1 and 16:

eapaths1 = FindPath[LineGraph[G4], ##, Infinity, All] & @@ edgepairs[[1]];

ArrowedGraph[G4, Flatten[List @@@ EdgeList[G4][[RandomChoice@eapaths1]]]]

enter image description here


However, we see that not all paths are legal.

The function decoder can filter out the legal path.

ArrowedGraph[graph_, path_] := HighlightGraph[
    graph, (*Rule@@@Partition[path,2,1]*){},
    Prolog -> {Blue, Thickness[.003], Arrowheads[Table[.03, 15]], Arrow[BSplineCurve[GraphEmbedding[graph][[path]], SplineDegree -> 2]]}
]
direction[{a_\[UndirectedEdge]b_, c_\[UndirectedEdge]d_}] := If[Count[{a, b, c, d}, a] == 2, b -> a, a -> b]
decoder[path_] := Block[
    {dpath = direction /@ Partition[EdgeList[G4][[path]], 2, 1]},
    If[dpath[[1, 1]] != 1 || dpath[[-1, -1]] != 16, Return[Nothing]];
    If[dpath[[2 ;; -1, + 1]] != dpath[[1 ;; -2, -1]], Return[Nothing]];
    Append[First /@ dpath, 16]
]
v = Graphics[{GrayLevel[1], EdgeForm[RGBColor[0, 0, 0]], Disk[{0, 0}]}];
G4 = GridGraph[{4, 4}, VertexSize -> 0.2, VertexShape -> v, ImageSize -> 640, VertexLabels -> Table[i -> Placed[i, Center], {i, 16}], EdgeLabels -> "Index"]
L4 = LineGraph[G4, VertexLabels -> "Name"]
edgepairs = Tuples[Map[EdgeIndex[G4, #]&] /@ (IncidenceList[G4, #]& /@ {1, 16})];
epaths = Flatten[FindPath[L4, ##, Infinity, All]& @@@ edgepairs, 1];
Length[vpath = decoder /@ RandomChoice[epaths, 10000]]
ArrowedGraph[G4, #]& /@ vpath

But this function is so inefficient that it can't run through all the solutions.

$\endgroup$
  • 1
    $\begingroup$ Flatten[List @@@ EdgeList[G4][[path]]] -> Prepend[First @@@ (EdgeList[G4][[path]]), 1], and seems need remove the paths which starts from 2 and 5 $\endgroup$ – GalAster May 11 at 7:55
  • $\begingroup$ @GalAster, good points. Looks like more processing is needed. $\endgroup$ – kglr May 11 at 8:43
2
$\begingroup$

I am under the impression that edge self-avoiding paths are essentially self-avoiding paths in the dual graph.

Should that be true, you could generate the dual graph with the function IGDualGraph from Szabolcs' package "IGraphM`" and run FindPath on it. The only problem is that the end points of these paths will be edges. So, to obtain all edge self-avoiding paths from vertex i to vertex j, you have to find all self-avoiding paths in the dual graph between those edges that are incident to i and j, respectively.

$\endgroup$

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.