Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: Graph issue

• To: mathgroup at smc.vnet.net
• Subject: [mg101992] Re: [mg101968] Graph issue
• From: Daniel Lichtblau <danl at wolfram.com>
• Date: Sat, 25 Jul 2009 04:18:46 -0400 (EDT)
• References: <200907241015.GAA17472@smc.vnet.net>

Stuart Nettleton wrote:
> Hi friends, a change appears to have occurred in the behaviour of  
> MakeGraph between Versions 6 and 7.01 (which has caused me some grief!)  
> Below is a small example problem that produces the wrong answer in Version  
> 7.01.0, both 32bit and 64bit. A small topological sort I have included  
> shows Combinatorica's topological sort also gives the wrong answer. Ant  
> thoughts would be appreicated! Stuart
> 
> << Combinatorica`
> myverts1 = {a, b, c, h, d, e, f, g};
> myedges1 = {{g, h}, {a, c}, {b, d}, {c, e}, {d, f}, {e, g}, {f, g}};
> mygraph1 =
>    MakeGraph[myverts1, (MemberQ[myedges1, {#1, #2}]) &,
>     Type -> Directed, VertexLabel -> True];
> ShowGraph[mygraph1]
> Print["Before Edges: ", myedges1]
> Print["After Edges: ", Map[myverts1[[#]] &, Edges[mygraph1]]]
> Print["Before Leaves: ", {a, b}]
> Print["After Leaves: ", Pick[myverts1, InDegree[mygraph1], 0]]
> Print["Topological sort1: ", myverts1[[TopologicalSort[mygraph1]]]]
> 
> Clear[visit];
> toposort = {}; nodes = myverts1;
> visited = Table[False, {t, Length[nodes]}];
> visit[n_] := Module[{},
>     If[Pick[visited, nodes, n] == {False},
>      visited[[Position[nodes, n][[1, 1]]]] = True;
>      Map[visit,
>       Cases[Map[Reverse, myedges1], {a_, b_} /; a == n][[All, 2]]];
>      toposort = Append[toposort, n]
>      ]
>     ];
> Map[visit, nodes];
> Print["Topological sort2: ", toposort]

So far as I can tell, TopologicalSort gives a valid result. I cannot 
figure out what your code does.

Here is code that works reasonably fast for a dense coding of the 
directed edge 0-1 matrix. It uses Range[n] to denote the n vertices. You 
can convert to letters or whatever after the fact.

toposort3C = Compile[{{mat, _Integer, 2}}, Module[
    {v, n = Length[mat], k, m, res},
    v = Total[mat];
    m = 0;
    res = Table[0, {n}];
    While[m < n,
     m++;
     For[k = 1, k <= n, k++, If[v[[k]] == 0, Break[]]];
     v[[k]] = -1;
     v -= mat[[k]];
     res[[m]] = k;
     ];
    res
    ]]

One can get better algorithmic complexity using a sparse representation.

Daniel Lichtblau
WOlfram Research

• References:
  • Graph issue
    • From: "Stuart Nettleton" <stuart.nettleton@optusnet.com.au>