MathGroup Archive 2011

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

Search the Archive

Re: "set" data structure in Mathematica? (speeding up graph traversal function)

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

traverse3 is pretty good. I have only one suggestion, for the setup 
stage. In order for links[[node]] to get the right sublist of links, 
the nodes must be numbered 1...m; i.e., nodes == Range@Last@nodes. 
Then Complement[nodes,sources] == Flatten@Position[links,{}], and 
there's no need for sources.

I also have a question. I have the impresssion that you prefer /; 
conditional definitions to If tests in the body of a function. 
If that's correct, do you have evidence that it's faster, or is it 
just a stylistic preference -- you think the code is easier to read, 
maintain, etc?

----- DrMajorBob <btreat1 at austin.rr.com> wrote:
> Here's a solution in Ray's format, twice as fast:
> 
> Clear[traverse3]
> Timing[
>   nodes = Union@Flatten[graph /. Rule -> List];
>   sources = Union@graph[[All, 1]];
>   links = ReplaceList[#, Dispatch@graph] & /@ nodes;
>   (traverse3[path_][#] := List@Append[path, #]) & /@
>    Complement[nodes, sources];
>   traverse3[path_][node_] /; MemberQ[path, node] = {};
>   traverse3[path_][node_] :=
>    Join @@ (traverse3[Append[path, node]] /@ links[[node]]);
>   Length /@ (u3 = traverse3[{}] /@ nodes)
>   ]
> 
> {0.46727, {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}}
> 
> Timing[
>   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;
>   Length /@ (u2 = traverse2[links][{}] /@ Range@m)]
> 
> {0.92439, {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}}
> 
> u2 == u3
> 
> True
> 
> .92439/.46727
> 
> 1.97828
> 
> The following seemed promising but wasn't as good as traverse3:
> 
> Clear[traverse4]
> Timing[
>   nodes = Union@Flatten[graph /. Rule -> List];
>   sources = Union@graph[[All, 1]];
>   links = ReplaceList[#, Dispatch@graph] & /@ nodes;
>   (traverse4[path_][#] := List@Append[path, #]) & /@
>    Complement[nodes, sources];
>   traverse4[path_][node_] /; MemberQ[path, node] = {};
>   traverse4[path_][node_] := With[{p = Append[path, node]},
>     Join @@ (traverse4[p] /@ Complement[links[[node]], p])];
>   Length /@ (u4 = traverse4[{}] /@ nodes)
>   ]
> 
> {0.762191, {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}}
> 
> u2 == u3 == u4
> 
> True
> 
> Bobby
> 
> On Sat, 26 Mar 2011 04:49:43 -0500, Ray Koopman <koopman at sfu.ca> wrote:
> 
>> I read this group on Google and it's been almost 48 hours since the
>> last posts appeared, so please excuse me if I've missed something.
>>
>> 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}}}
> 
> 
> -- 
> DrMajorBob at yahoo.com


  • Prev by Date: Re: "set" data structure in Mathematica? (speeding up
  • Next by Date: Re: StreamPlot or streamlines in 3D?
  • Previous by thread: Re: "set" data structure in Mathematica? (speeding up graph traversal function)
  • Next by thread: Re: "set" data structure in Mathematica? (speeding up graph traversal function)