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

*To*: mathgroup at smc.vnet.net*Subject*: [mg117603] Re: "set" data structure in Mathematica? (speeding up graph traversal function)*From*: DrMajorBob <btreat1 at austin.rr.com>*Date*: Thu, 24 Mar 2011 06:28:55 -0500 (EST)

I'm always hitting "Send" too fast! The last solution (my favorite) should have been: 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 {1.60494, 47165} That could also start with nodes = Union@graph[[All, 1]]; In that case, two "singleton" paths are eliminated. Bobby On Wed, 23 Mar 2011 15:06:39 -0500, DrMajorBob <btreat1 at austin.rr.com> wrote: >> Another change was the use of Cases in place of ReplaceList, which is >> mostly responsible for the great difference in timing you get. > > No, it isn't. "next" is computed exactly ONCE for each node, so this is > all the time involved: > > Clear[next] > nodes = Union@Flatten[graph /. Rule -> List]; > next[i_Integer] := next[i] = Cases[graph, Rule[i, j_] :> j] > next /@ nodes; // Timing > > {0.001473, Null} > > Here's the same thing with ReplaceList: > > Clear[next] > nodes = Union@Flatten[graph /. Rule -> List]; > next[i_Integer] := next[i] = ReplaceList[i, graph] > next /@ nodes; // Timing > > {0.002368, Null} > > And here it is with Dispatch, in two different ways: > > Clear[next] > nodes = Union@Flatten[graph /. Rule -> List]; > next[i_Integer] := next[i] = ReplaceList[i, Dispatch@graph] > next /@ nodes; // Timing > > {0.001981, Null} > > Clear[next] > d = Dispatch@graph; > nodes = Union@Flatten[graph /. Rule -> List]; > next[i_Integer] := next[i] = ReplaceList[i, d] > next /@ nodes; // Timing > > {0.000291, Null} > > The last is a lot faster RELATIVELY, but not in absolute terms -- unless > your plan is to eliminate "next" entirely: > > Clear[path, p] > d = Dispatch@graph; > path[i_Integer] := path@p@i > path[p[a___, last_]] := > Module[{c = Complement[ReplaceList[last, d], {a, last}]}, > If[c == {}, > p[a, last], > path@p[a, last, #] & /@ c > ] > ] > (paths = (path /@ nodes); Length@Flatten@paths) // Timing > > {1.7552, 47165} > > But that's no better than this: > > 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], > path@p[a, last, #] & /@ c > ] > ] > ((paths = Flatten[path /@ nodes] /. p -> List) // Length) // Timing > > {1.74741, 47165} > > or this: > > 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[ReplaceList[last, d], {a, last}]}, > If[c == {}, p[a, last], path@p[a, last, #] & /@ c]] > (paths = (path /@ nodes); Length@Flatten@paths) // Timing > > {1.74914, 47165} > > I like that solution best. > > Bobby > > On Wed, 23 Mar 2011 13:58:37 -0500, Szabolcs Horv=E1t <szhorvat at gmail.com> > wrote: > >> Thank you for reading the lengthy post and replying, Bobby! >> >> Essentially what you are doing is replacing several calls to MemberQ >> by a single call to Complement. This indeed works well! >> >> Another change was the use of Cases in place of ReplaceList, which is >> mostly responsible for the great difference in timing you get. >> However, using Dispatch[graph] instead of just graph in ReplaceList >> appears to be faster than Cases. This can be combined with your idea >> to use Complement to get another speedup. >> >> Cheers, >> Szabolcs >> >> 2011/3/22 DrMajorBob <btreat1 at austin.rr.com>: >>> Here's an improvement, I think. >>> >>> For the test graph you listed below, I get >>> >>> Clear[next, path, p, listPath] >>> 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] >>> ] >>> ] >>> (paths = (path /@ nodes); Length@Flatten[pathways]) // Timing >>> >>> {1.73881, 405496} >>> >>> Omitting Flatten and using p -> List can get a structure like yours >>> (mostly): >>> >>> Clear[next, path, p, listPath] >>> 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] >>> ] >>> ] >>> ((paths = Flatten[path /@ nodes] /. p -> List) // Length) // Timing >>> >>> {1.85056, 47165} >>> >>> Compare the above with >>> >>> Clear[traverse] >>> traverse[path_][node_] := >>> With[{l = ReplaceList[node, graph], p = Append[path, node]}, >>> If[l === {}, {p}, >>> If[MemberQ[path, node], {}, Join @@ (traverse[p] /@ l)]]] >>> pathways = traverse[{}] /@ nodes; // Timing >>> >>> {8.09828, Null} >>> >>> paths == Cases[pathways, {__Integer}, Infinity] >>> >>> True >>> >>> Bobby >>> >>> On Tue, 22 Mar 2011 05:06:19 -0500, Szabolcs Horv=E1t >>> <szhorvat at gmail.com> >>> wrote: >>> >>>> Dear MathGroup, >>>> >>>> I am trying to speed up a function. >>>> >>>> I'm looking for an efficient set-like data structure, to be used as >>>> follows: >>>> >>>> I have a recursive function f, which works like this (omitting the >>>> details): >>>> >>>> f[set_][value_] := >>>> if value in set then >>>> return nothing >>>> otherwise >>>> newSet = insert value into set >>>> return f[newSet] /@ (list of computed values) >>>> >>>> In other words, the function calculates a list of values, then calls >>>> itself recursively with each of them. These values are collected >>>> into a >>>> set during the recursive calls, and one of the stopping conditions is >>>> that a value gets repeated. >>>> >>>> Note: of course there's another stopping condition as well, otherwise >>>> the function wouldn't return anything, but that is irrelevant here. >>>> >>>> Also note: each branch of the recursion will have its own collection >>>> (set) of values. >>>> >>>> The trivial solution would be just using a List of values, inserting >>>> new >>>> values with Append, and testing whether they're already in the list >>>> with >>>> MemberQ. I found that the function spends most of its time in >>>> MemberQ, >>>> so I am looking for a more efficient solution than a plain list that >>>> needs to be iterated over to find elements in it. >>>> >>>> I tried using newSet = Union[set, {value}] instead of append, and >>>> testing whether Length[newSet] === Length[set], but this turned out to >>>> be even slower. >>>> >>>> I wonder if there's a better solution. >>>> >>>> One way would be using "function definitions", i.e. "inserting" >>>> 'value' >>>> into 'set' as set[value] = True, and testing membership simply as >>>> TrueQ[set[value]], but this object can't easily be passed around in a >>>> recursive function because it is essentially a global variable. Note >>>> again that the recursion has several branches as the function is >>>> mapped >>>> over a whole list of values. >>>> >>>> Does anyone have an idea how to solve this problem? >>>> >>>> -- Szabolcs >>>> >>>> P.S. The problem I'm trying to solve is to find (actually just count) >>>> ALL acyclic paths in a directed graph, starting from a given node. >>>> Starting from a node, I descend along the connections until there's no >>>> way to go, or until I encounter a node that I have already visited. >>>> >>>> Perhaps it's better if I post the function ... >>>> >>>> traverse[graph_][path_][node_] := >>>> With[ >>>> {l = ReplaceList[node, graph], >>>> p = Append[path, node]}, >>>> If[l === {}, >>>> {p}, >>>> If[ >>>> MemberQ[path, node], >>>> {}, >>>> Join @@ (traverse[graph][p] /@ l) >>>> ] >>>> ] >>>> ] >>>> >>>> graph is a list of rules representing a simple directed graph, path is >>>> the list of already visited nodes (initially {}), node is the starting >>>> node. It's generally a good idea to pass the graph as a dispatch >>>> table >>>> (Dispatch[]), but then MemberQ[] takes even longer to evaluate than >>>> ReplaceList[]. >>>> >>>> If there are cycles in the graph, there will be a large number of >>>> paths, >>>> and the function will be slow. >>>> >>>> P.P.S >>>> >>>> Here's a small graph with some loops to test with: >>>> >>>> {1 -> 2, 3 -> 4, 5 -> 1, 5 -> 2, 6 -> 2, 6 -> 5, 7 -> 2, 7 -> 6, >>>> 8 -> 1, 8 -> 2, 8 -> 5, 8 -> 6, 9 -> 2, 9 -> 5, 9 -> 6, 9 -> 7, >>>> 10 -> 2, 10 -> 6, 10 -> 7, 11 -> 6, 11 -> 7, 12 -> 6, 12 -> 7, >>>> 13 -> 6, 13 -> 7, 14 -> 2, 14 -> 5, 14 -> 6, 14 -> 7, 15 -> 3, >>>> 15 -> 6, 15 -> 7, 15 -> 8, 16 -> 3, 16 -> 6, 16 -> 7, 16 -> 13, >>>> 17 -> 3, 17 -> 6, 17 -> 7, 17 -> 9, 17 -> 11, 17 -> 13, 18 -> 3, >>>> 18 -> 6, 18 -> 7, 18 -> 9, 18 -> 11, 18 -> 12, 18 -> 13, 18 -> 14, >>>> 18 -> 15, 18 -> 19, 18 -> 20, 19 -> 6, 19 -> 7, 19 -> 9, 19 -> 10, >>>> 19 -> 11, 19 -> 12, 19 -> 13, 19 -> 14, 19 -> 16, 19 -> 17, 19 -> 18, >>>> 19 -> 20, 20 -> 3, 20 -> 7, 20 -> 9, 20 -> 10, 20 -> 11, 20 -> 12, >>>> 20 -> 14, 20 -> 16, 20 -> 18, 20 -> 19, 21 -> 3, 21 -> 9, 21 -> 10, >>>> 21 -> 11, 21 -> 12, 21 -> 13, 21 -> 14, 21 -> 15, 21 -> 16, 21 -> 17, >>>> 21 -> 19, 21 -> 20, 22 -> 3, 22 -> 7, 22 -> 9, 22 -> 10, 22 -> 11, >>>> 22 -> 12, 22 -> 13, 22 -> 14, 22 -> 16, 22 -> 19, 22 -> 20, 23 -> 3, >>>> 23 -> 7, 23 -> 9, 23 -> 10, 23 -> 14, 23 -> 16, 23 -> 17, 23 -> 18, >>>> 23 -> 19, 23 -> 20, 24 -> 7, 24 -> 9, 24 -> 10, 24 -> 11, 24 -> 14, >>>> 24 -> 15, 24 -> 16, 24 -> 17, 24 -> 18, 24 -> 20, 25 -> 3, 25 -> 9, >>>> 25 -> 10, 25 -> 11, 25 -> 14, 25 -> 15, 25 -> 16, 25 -> 18, 25 -> 19, >>>> 25 -> 20, 26 -> 7, 26 -> 9, 26 -> 10, 26 -> 11, 26 -> 13, 26 -> 14, >>>> 26 -> 15, 26 -> 16, 26 -> 19, 26 -> 20, 27 -> 3, 27 -> 6, 27 -> 7, >>>> 27 -> 9, 27 -> 10, 27 -> 11, 27 -> 12, 27 -> 13, 27 -> 14, 27 -> 15, >>>> 27 -> 16, 27 -> 17, 27 -> 18, 27 -> 19, 27 -> 20, 27 -> 22, 27 -> 28, >>>> 28 -> 3, 28 -> 9, 28 -> 10, 28 -> 11, 28 -> 12, 28 -> 13, 28 -> 14, >>>> 28 -> 15, 28 -> 16, 28 -> 17, 28 -> 18, 28 -> 19, 28 -> 20, 28 -> 22, >>>> 28 -> 27, 28 -> 29, 29 -> 3, 29 -> 6, 29 -> 7, 29 -> 8, 29 -> 9, >>>> 29 -> 10, 29 -> 11, 29 -> 12, 29 -> 13, 29 -> 14, 29 -> 15, 29 -> 16, >>>> 29 -> 17, 29 -> 18, 29 -> 19, 29 -> 20, 29 -> 21, 29 -> 22, >>>> 29 -> 23, 29 -> 24, 29 -> 25, 29 -> 26, 29 -> 27, 29 -> 28} >>>> >>> >>> >>> -- >>> DrMajorBob at yahoo.com >>> > > -- DrMajorBob at yahoo.com

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

**create reusable graph style?**

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

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