7
$\begingroup$

I have a directed graph with 51 nodes. I want to extract a (big) random sample of the possible paths from node $i$ to node $j$. I know that I can generate a list that contains all the paths with FindPath. For example

l = FindPath[g, 2, 49, 8, All]

generates a list l that contains All the possible paths between node 2 and node 49. This is great, but of course it uses a lot of memory and takes a lot of time to evaluate (which is expected, since there are $\approx 10^{10}$ possible paths, given the adjacency matrix from which the graph is built).

Is there a way to generate just a sample (say $10^6$) of these paths? I know that I can always replace the All argument with a smaller number, but this results in very similar paths, and I need a lot of diversity.

$\endgroup$
  • $\begingroup$ Interesting question, but FindPath seems to be completely implemented in the Kernel and resistant to introspection. What do you mean by "similar paths"? Similar length? Shared nodes? Honestly, I don't see a way how you can know the diversity of existing paths before actually finding all which makes it impossible to select a good random sample out of it. $\endgroup$ – halirutan Jan 14 '18 at 2:39
  • $\begingroup$ Thank you for your comments, halirutan. By "similar paths" I mean paths that go through the same nodes, for instance {{1, 2, 3, 4, 5, 7, 23, 34, 48}, {1, 2, 3, 4, 5, 7, 23, 33, 48}, {1, 2, 3, 4, 5, 7, 22, 41, 48}, {1, 2, 3, 4, 5, 7, 22, 40, 48}, {1, 2, 3, 4, 5, 7, 22, 39, 48}}, the first million paths share the same 7 nodes. If FindPath could somehow scan the nodes in a disordered way, perhaps there would be a more diverse set of paths to show $\endgroup$ – Arturo Jan 14 '18 at 2:48
  • 1
    $\begingroup$ I assume that by "random" you mean that every possible path must appear with the same probability (i.e. uniform sampling). Is that correct? $\endgroup$ – Szabolcs Jan 14 '18 at 9:09
  • $\begingroup$ Yes, Szabolcs, that's what I mean. And I also mean that I can draw a random element (path) of the generated (quite huge) list of paths. $\endgroup$ – Arturo Jan 14 '18 at 15:10
  • 2
    $\begingroup$ Maybe assign random weights to your edges, then run FindShortestPath $\endgroup$ – george2079 Jan 15 '18 at 20:05
3
$\begingroup$

If (!!) extracting the path of a specific length is faster and doesn't eat up memory internally, there might be a very basic (and probably stupid) idea. First, given two paths I'm measuring the similarity by testing how many elements they have in common:

duplicateQ[p1_, p2_] := 
 Length[Intersection[p1, p2]] > (Length[p1] + Length[p2])/4

If p1 and p2 are of equal length, then the criterion sorts out all paths that share more than half of the nodes.

Now, we iteratively create All paths of a certain length and we use Union to combine them with the paths that we already collected. We use SameTest to throw out all paths that are too similar.

findPaths[g_, start_, end_, maxLength_] := Module[{res = {}},
  Fold[Union[#1, FindPath[g, start, end, {#2}, All], 
     SameTest -> duplicateQ] &, {}, Range[maxLength]]
  ]

Now we can test it

g = GridGraph[{5, 5}]
findPaths[g, 1, 25, 50]
(* {{1, 2, 3, 4, 5, 10, 15, 20, 25},
    {1, 2, 3, 8, 9, 14, 19, 24, 25},
    {1, 2, 7, 12, 13, 18, 19, 20, 25},
    {1, 6, 7, 12, 17, 22, 23, 24, 25}, 
    {1, 6, 7, 8, 13, 14, 9, 10, 15, 20, 25},
    {1, 6, 11, 16, 17, 18, 13, 14, 19, 24, 25}} 
*)

which gives a short list of distinct paths.

So the idea behind this is to extract the paths in layers of equal length and reduce the size by filtering similar ones. You might want to add a condition that paths with (very) unequal length are not considered similar even when they share nodes.

I'm not even sure this helps you with your problem. When I use GridGraph as an example and increase the size to 7x7 (to get 49 nodes) I cannot work through this in a reasonable time.

From this set of possible paths, you could draw your random sample.

| improve this answer | |
$\endgroup$
  • $\begingroup$ Thanks. This sure works towards an answer, even though my 51-node graph is also not workable in a reasonable time $\endgroup$ – Arturo Jan 14 '18 at 18:08
  • $\begingroup$ @Arturo Don't accept my answer. If you like it, upvote it and wait if there is someone else coming with a better idea. $\endgroup$ – halirutan Jan 14 '18 at 18:58
1
$\begingroup$

One possibility is to pick random edges from start, next, etc. until hitting the target. Since this would tend to find shorter paths, it can be weighted by a rejection scheme that has higher probability of accepting a path the longer it is. This might or might not be sufficiently randomized for the graph in question. Possibly better would be to also take into account the number of paths of a given length, something that can be found by powers of the adjacency matrix.

The code below is assuming all vertices have outgoing edges, in forming the edge list for all vertices. Some modification will be needed if there are sinks. It also will give up if it cannot get a viable path after some number of attempts. The main part could be done nicer with Throw/Catch I guess. Then again, my first version used Goto/Label, so we know it could be done worse.

pickRandomEdge[adjList_, avoid_, j_] := 
 With[{edgelist = Complement[adjList[[avoid[[j]]]], Take[avoid, j]]},
  If[Length[edgelist] == 0, 0, RandomChoice[edgelist]]]

pickRandomPath[start_, target_, adjList_, maxTries_] := 
 Module[
  {j = 1, n = Length[adjList], found = False, deadend = False, avoid, 
   edge, k = 0},
  While[! found && k < maxTries,
   k++;
   avoid = ConstantArray[0, n];
   j = 1;
   avoid[[1]] = start;
   While[! found,
    edge = pickRandomEdge[adjList, avoid, j];
    If[edge == 0,
     Break[];
     ,
     j++;
     avoid[[j]] = edge;
     If[edge == target,
      If[(rr = RandomInteger[{1, n}]) <= j, found = True];
      Break[];
      ,
      Continue[];
      ];
     ];
    ];
   ];
  If[k < maxTries, Take[avoid, j], $Failed]
  ]

randomPaths[start_, target_, graph_, n_, maxTries_] := 
 Reap[Module[
    {adjList, j = 0, k = 0, path},
    adjList = AdjacencyMatrix[graph]["AdjacencyLists"];
   (* above improved per @HenrikSchumacher suggestion *)
    While[j < n && k < maxTries,
     path = pickRandomPath[start, target, adjList, maxTries];
     If[path === $Failed, k++, j++; k = 0; Sow[path]];
     ];
    ]][[2]]

We'll use the example from @Halirutan.

In[101]:= randomPaths[1, 4, g, 15, 10]

(* Out[101]= {{{1, 6, 7, 2, 3, 8, 13, 14, 15, 10, 9, 4}, {1, 6, 7, 12, 
   17, 16, 21, 22, 23, 24, 19, 18, 13, 8, 9, 4}, {1, 2, 3, 8, 13, 12, 
   17, 16, 21, 22, 23, 18, 19, 14, 15, 10, 5, 4}, {1, 2, 3, 8, 7, 6, 
   11, 16, 21, 22, 17, 12, 13, 14, 19, 24, 25, 20, 15, 10, 5, 4}, {1, 
   6, 7, 12, 13, 14, 19, 18, 23, 24, 25, 20, 15, 10, 5, 4}, {1, 2, 7, 
   12, 17, 22, 23, 18, 13, 8, 3, 4}, {1, 2, 7, 12, 11, 16, 21, 22, 23,
    24, 25, 20, 15, 10, 9, 8, 3, 4}, {1, 2, 7, 8, 9, 10, 5, 4}, {1, 6,
    7, 8, 9, 14, 19, 24, 25, 20, 15, 10, 5, 4}, {1, 6, 11, 12, 13, 14,
    9, 10, 5, 4}, {1, 6, 11, 12, 7, 2, 3, 4}, {1, 2, 7, 6, 11, 16, 17,
    12, 13, 14, 19, 18, 23, 24, 25, 20, 15, 10, 9, 4}, {1, 6, 11, 12, 
   17, 18, 13, 14, 9, 4}, {1, 6, 11, 12, 13, 8, 9, 4}, {1, 2, 3, 4}}} *)

We show a larger random example with 51 vertices.

m = 51;
rg = RandomGraph[{m, 8*m}];

AbsoluteTiming[paths = randomPaths[21, 42, rg, 10^4, 20];]

(* Out[150]= {25.3169, Null} *)

In[152]:= Length[paths[[1]]]

(* Out[152]= 10000 *)

So not blindlingly fast, but it did deliver the requested number of paths without first failing from too many unsuccessful attempts.

| improve this answer | |
$\endgroup$
  • 1
    $\begingroup$ Actually adjacency matrix powers don't count paths properly, as they allow "paths" with repeated vertices/edges (in an undirected graph, stepping back and forth on the same edge) $\endgroup$ – Szabolcs Mar 18 '18 at 21:00
  • $\begingroup$ @Szabolcs Good point. In any case I am not sure if that is even a reasonable way to get a good weighting for acceptance/rejection purposes. $\endgroup$ – Daniel Lichtblau Mar 18 '18 at 21:09

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.