Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

"set" data structure in Mathematica? (speeding up graph traversal

• To: mathgroup at smc.vnet.net
• Subject: [mg117648] "set" data structure in Mathematica? (speeding up graph traversal
• From: Ray Koopman <koopman at sfu.ca>
• Date: Tue, 29 Mar 2011 06:53:19 -0500 (EST)

First, some results from Szabolc's original routine:

Timing[Length /@ (u = traverse[graph][{}] /@ Range@m)]

{17.29 Second, {1, 1, 1, 1, 2, 3, 4, 7, 10, 8, 7, 7, 7, 10, 15, 15, 
32, 394, 355, 396, 863, 820, 1225, 891, 1211, 827, 11269, 13353, 15430}}

Here's a routine that gives the same output in much less time. 
It does only two things differerntly: it gets a major speedup by 
preprocessing graph into lists of links, and a very minor speedup 
by changing the nested If's to a single Which. I tried several ways 
to eliminate MemberQ, but none of them helped.

traverse2[L_][path_][node_] :=
  With[{p = Append[path, node]},
   Which[
    L[[node]] === {}   , {p},
    MemberQ[path, node], {},
    True               , Join @@ (traverse2[L][p] /@ L[[node]])
    ]
   ]

m = Max[graph/.Rule->List];
links = ReplaceList[#,graph]&/@Range@m];

Timing[Length /@ (u2 = traverse2[links][{}] /@ Range@m)]
u2 == u

{2.45 Second, {1, 1, 1, 1, 2, 3, 4, 7, 10, 8, 7, 7, 7, 10, 15, 15, 
32, 394, 355, 396, 863, 820, 1225, 891, 1211, 827, 11269, 13353, 15430}}
True

The routines in Bobby's last two posts are slower, 
and their results differ from Szabolcs' and mine.

Clear[next, path, p]
d = Dispatch@graph;
nodes = Union@Flatten[graph /. Rule -> List];
next[i_Integer] := next[i] = ReplaceList[i, d]
path[i_Integer] := path@p@i
path[p[a___, last_]] :=
  Module[{c = Complement[next@last, {a, last}]},
   If[c == {}, p[a, last], path@p[a, last, #] & /@ c]]
(paths = (path /@ nodes); Length@Flatten@paths) // Timing

{3.73 Second,47165}

Clear[next, path, p]
nodes = Union@Flatten[graph /. Rule -> List];
next[i_Integer] := next[i] = Cases[graph, Rule[i, j_] :> j]
path[i_Integer] := path@p@i
path[p[a___, last_]] :=
  Module[{c = Complement[next@last, {a, last}]},
   If[c == {},
    p[a, last],
    Flatten[path@p[a, last, #] & /@ c]
    ]
   ]
(paths2 = (path /@ nodes); Length@Flatten@paths2) // Timing

{4.29 Second, 47165}

paths == paths2
Flatten@paths == Flatten@paths2

False
True

Besides having a 'p' head on each path,
singleton paths are given as scalars.
Here are the first 5 rows:

Take[u,5]
Flatten/@Take[paths,5]/.p->List

{{{1,2}},{{2}},{{3,4}},{{4}},{{5,1,2},{5,2}}}
{{{1,2}}, {2} ,{{3,4}}, {4} ,{{5,1,2},{5,2}}}