How can I speed up FindShortestPath?

Questions
, ,
1

I have a graph with 6401 vertices.

It takes about 30 seconds to run FindShortestPath[g,0,6400,Method->Dijkstra]. This is acceptable, but I wonder if I could speed it up. An equivalent Racket package is about 100x faster and Racket isn’t renowned for its blazing speed.

More details: I create a list of DirectedEdges and Weights and then g = Graph[edges, weights]

Thanks,
-Joe

2

Is the package just running Dijkstra without any heuristics?
It’s possible that there’s more overhead in Mathematica’s algorithm. Graph objects could be more general in purpose in one language over the other and who knows how much this would add in overhead to access elements. I could also imagine that someone could possibly define the graph with rational numbers too, which could also be a significant drain.
It’s probable that the common R implementation is faster and if so you might consider this IGraphR package that’s been going around. I haven’t gotten a chance to use it myself:
https://github.com/szhorvat/IGraphRhttps://github.com/szhorvat/IGraphR

3

Thanks Sean (if you get a chance, you might want to edit your post to fix the “double” URL at the bottom).

Since Graphs need to be drawable, etc. in Mathematica, maybe it’s a memory issue?

My Weights are all integers.

To answer your first question, yes, just Dijkstra… how to I employ heuristics with it?

Thanks again

4

Ouch, my bad… FindShortestPath was not the problem, my code that builds the edges and weights was taking all the time! Working on it…

5

OK… got it…

The following code:

For[i = 1, i <= Length@v, i++,
 If[i <= Length@v - slen, AppendTo[edges, DirectedEdge[i, i + slen]]; AppendTo[weights, v[[i + slen]]]]; 
 If[i > slen, AppendTo[edges, DirectedEdge[i, i - slen]]; AppendTo[weights, v[[i - slen]]]]; 
 If[Mod[i, slen] != 0, AppendTo[edges, DirectedEdge[i, i + 1]]; AppendTo[weights, v[[i + 1]]]]; 
 If[Mod[i, slen] != 1, AppendTo[edges, DirectedEdge[i, i - 1]]; AppendTo[weights, v[[i - 1]]]]]

is 100x slower than this:

edges = AppendTo[edges, Table[DirectedEdge[x*slen + y, (x + 1)*slen + y], {x, 0, slen - 2}, {y, 1, slen}]];
edges = AppendTo[edges, Table[DirectedEdge[x*slen + y, x*slen + y + 1], {x, 0, slen - 1}, {y, 1, slen - 1}]];
edges = AppendTo[edges, Table[DirectedEdge[x*slen + y, (x - 1)*slen + y], {x, 1, slen - 1}, {y, 1, slen}]];
edges = Flatten@AppendTo[edges, Table[DirectedEdge[x*slen + y + 1, x*slen + y], {x, 0, slen - 1}, {y, 1, slen - 1}]];
weights = AppendTo[weights, Table[v[[(x + 1)*slen + y]], {x, 0, slen - 2}, {y, 1, slen}]];
weights = AppendTo[weights, Table[v[[x*slen + y + 1]], {x, 0, slen - 1}, {y, 1, slen - 1}]];
weights = AppendTo[weights, Table[v[[(x - 1)*slen + y]], {x, 1, slen - 1}, {y, 1, slen}]];
weights = Flatten@AppendTo[weights, Table[v[[x*slen + y]], {x, 0, slen - 1}, {y, 1, slen - 1}]];

where slen=80, I guess that slower makes sense… but 100x?

6

For loops are slow. I’m not sure why, but I never use them. Mathematica has a function called Do, which are like a For loop. Use that instead. For exists, as far as I know, because of popular demand for something that looked exactly like C’s For loop. Mathematica also has Labels and Goto statements. These also exist by popular demand by people looking for very straightfoward ways to port old code. They probably aren’t very fast.

AppendTo can also be slow. “weights” and “edges” are being treated here as if they were linkedlists and I’m not sure that’s the case. I would try pre-allocating the memory for edges and weights and then filling it in. That’s probably quicker.