Locally randomizing a path on a graph

Question

I have a walk $v_1 \ldots v_n$ on a graph $G$ and I want to apply the following operation to it: I wish to choose two indexes, $l$, $k$, and replace the sub-path from $v_l$ to $v_k$ with one of the shortest paths from $v_l$ to $v_k$, chosen uniformly at random among all such paths.

I would appreciate your assistance in implementing this in Mathematica!

I found a question related to mine (how to find all shortest paths) here: Finding all shortest paths between two vertices, but I am not sure how to utilize the answer there to select, uniformly at random, a path among all paths generated by the algorithm there.

Answer 1

Perhaps this will be easier to follow.

This function finds all shortest paths in graph g between vertices s and t, and returns them in a list.

findAllShortestPaths[g_, s_, t_] := 
 FindPath[g, s, t, {GraphDistance[g, s, t]}, All]

This function takes a graph, a walk, and two indices into the walk array: k and l. Then it replaces the section between the kth and lth elements of the walk, in the manner you described.

replacePath[g_, walk_, {k_, l_}] :=
 Join[
   Take[walk, k-1],
   RandomChoice@findAllShortestPaths[g, walk[[k]], walk[[l]] ],
   Take[walk, {l+1, -1}]
 ]

Example:

SeedRandom[42];
g = RandomGraph[{10, 20}, VertexLabels -> "Name"]

findAllShortestPaths[g, 1, 2]
(* {{1, 10, 2}, {1, 6, 2}} *)

walk = {7, 1, 10, 2};

HighlightGraph[g, PathGraph[walk]]

replacePath[g, walk, {2, 4}]
(* {7, 1, 6, 2} *)

Answer 2

Here is a graph:

g = RandomGraph[{20, 50}];

Here is the path between $\nu_l = 5$ and $\nu_n = 9$ (chosen arbitrarily):

mypathlist = FindPath[g, 5, 9][[1]]

(* {5, 2, 3, 6, 4, 1, 18, 10, 7, 9} *)

Here are two points along that path chosen arbitrarily:

myvertexes = RandomSample[mypathlist, 2]

(* {2, 7} *)

Here is the shortest path in $g$ between these vertexes:

mynewpathsegment = 
 FindShortestPath[g, myvertexes[[1]], myvertexes[[2]]]

(* {2,7} *)

If you want to get all such shortest paths:

myshortestlist = FindPath[gg, myvertexes[[1]], myvertexes[[2]], {GraphDistance[g, myvertexes[[1]], myvertexes[[2]]]}, All]

Then choose one of these shortest paths randomly:

myfinalshortpath = RandomChoice[myshortestlist]

Here is the original path with the new shortest path replacing the existing path segment:

mypathlist /. 
{x__, PatternSequence[myvertexes[[1]], __, myvertexes[[2]]], z__} -> 
{x, Sequence[myvertexes[[1]], myvertexes[[2]]], z}

(* {5, 2, 7, 9} *)

---

Note that this code automatically selects one of the shortest paths, if there are indeed multiple shortest paths. You can verify this with this simple example:

gg = Graph[{1 -> 2, 1 -> 3, 3 -> 4, 2 -> 4}]

FindShortestPath[gg, 1, 4]

(* {1, 2, 4} *)

(but not {1,3,4}).