3
$\begingroup$

Let's say I have this graph (The code to generate the graph is at the end)

sample graph

How can I extract all the leaves comming from, let's say "cluster3"?, i.e. {100, 92, 87, 89}

sample graph

I guess I have to first extract the subgraph with "cluster3" as root vertex

sample graph

and then filter the result. This last part should be easy.

What I'm finding hard to get is extracting the subgraph. I tried using the Subgraph functions doing like:

Subgraph[myGraph, UndirectedEdge[_, cluster3]]

But I don't get what I want

sample graph 2

Probably this is trivial and I'm just not seeing it. Any kind of help would be super useful.

Thanx!

This is what I used to create the graph

Needs["HierarchicalClustering`"];

MakeClusteredTree[data_,leaves_,opts:OptionsPattern[]]:=Module[{clusters,expr,ett,edges,optsGraph=FilterRules[opts,Options[Graph]],optsAgglomerate=FilterRules[opts,Options[Agglomerate]]},clusters=Agglomerate[data->leaves,optsAgglomerate];expr=(i=1;Replace[clusters,Cluster[a_,b_,___]:>Symbol["cluster"<>ToString[i++]][a,b],{0,Infinity}]);ett=SparseArray`ExpressionToTree[expr];edges=UndirectedEdge@@@(ett[[All,All,1]]);Graph[(UndirectedEdge@@@edges),GraphLayout->{"LayeredEmbedding","RootVertex"->(UndirectedEdge@@@edges)[[1,1]]},VertexLabels->"Name",optsGraph,ImagePadding-> Full]]

data = {100, 43, 87, 1, 49, 32, 79, 42, 89, 92};

MakeClusteredTree[data, ToString /@ data, {Linkage -> "Average"}]

====Final Notes====

The MakeClusteredTree function is completely based on this post (highest of high fives to kguler). I just changed it a little bit for my original purpose and another little bit for this post (I'm using more complicated data, huge trees and originally, I only visibly label the leaves. I changed the VertexLabels for this example so I can show you the names of all nodes.

$\endgroup$
  • 1
    $\begingroup$ Please post the code you used to generate your graph. $\endgroup$ – seismatica Aug 5 '14 at 5:12
  • $\begingroup$ Sorry, I forgot to add that part. I already added the functions I use and the data. Thanx for the heads up. $\endgroup$ – xtian777x Aug 5 '14 at 5:46
3
$\begingroup$

First a question for you: is there any reason why the edges are undirected? Your graph looks like a tree graph to me, with a strict hierarchy. For this directed edges would be better.

We can switch to directed edges as follows:

Block[{UndirectedEdge = DirectedEdge},
 graph = MakeClusteredTree[data, ToString /@ data, {Linkage -> "Average"}]
]

Mathematica graphics

You can also change every appearance of UndirectedEdge to DirectedEdge in your code instead of the above. (Note that Graph objects are atoms, so we can't do graph /. UndirectedEdge -> DirectedEdge).

We can then use VertexOutComponent to find all the vertices below cluster3:

subvertices = VertexOutComponent[graph, cluster3]
{cluster3,100,cluster4,cluster5,92,87,89}

From these we want to select the leaves, i.e. those vertices that have only one incident edge:

leaves = Select[subvertices, VertexDegree[graph, #] === 1 &]
{100,92,87,89}

And just to be sure, let's highlight the leaves we've found:

HighlightGraph[graph, Subgraph[graph, leaves]]

Mathematica graphics

$\endgroup$
  • $\begingroup$ very nice and clear answer...VertexOutComponent...+1 $\endgroup$ – ubpdqn Aug 5 '14 at 9:36
  • $\begingroup$ very nice! +1.. $\endgroup$ – seismatica Aug 5 '14 at 14:03
  • $\begingroup$ I'm using undirected because, with the real data, I'm creating phylogenetic trees and just care about the leaves after clustering my data. I didn't think of a reason to have a directed graph, but, it's my first time doing real work with graphs so it's ignorance from my part too. Thanx a lot for your answer! Super helpful $\endgroup$ – xtian777x Aug 5 '14 at 17:02
  • $\begingroup$ Oh BTW, I just tried this with Mathematica 10 and VertexOutComponent now works with undirected graphs. $\endgroup$ – xtian777x Aug 5 '14 at 17:07
  • $\begingroup$ I just looked at the M10 documentation, but it doesn't seem VertexOutComponent will give the same answer for directed and undirected graphs. Can you perhaps confirm this? $\endgroup$ – Teake Nutma Aug 5 '14 at 17:12
4
$\begingroup$

I post this but Teake Nutma is the better answer.

Changing your code to directed edges:

Needs["HierarchicalClustering`"];

MakeClusteredTree[data_, leaves_, opts : OptionsPattern[]] := 
 Module[{clusters, expr, ett, edges, 
   optsGraph = FilterRules[opts, Options[Graph]], 
   optsAgglomerate = FilterRules[opts, Options[Agglomerate]]}, 
  clusters = Agglomerate[data -> leaves, optsAgglomerate]; 
  expr = (i = 1; 
    Replace[clusters, 
     Cluster[a_, b_, ___] :> 
      Symbol["cluster" <> ToString[i++]][a, b], {0, Infinity}]); 
  ett = SparseArray`ExpressionToTree[expr]; 
  edges = DirectedEdge @@@ (ett[[All, All, 1]]); 
  Graph[(DirectedEdge @@@ edges), 
   GraphLayout -> {"LayeredEmbedding", 
     "RootVertex" -> (UndirectedEdge @@@ edges)[[1, 1]]}, 
   VertexLabels -> "Name", optsGraph, ImagePadding -> Full]]

data = {100, 43, 87, 1, 49, 32, 79, 42, 89, 92};

g = MakeClusteredTree[data, ToString /@ data, {Linkage -> "Average"}]

Collect leaves:

leaves = Cases[# -> VertexDegree[g, #] & /@ 
   VertexList[g], (x_ -> 1) -> x]

Functions to find leaves:

func[v_] := 
 Last /@ Flatten[FindPath[g, v, #, Infinity, All] & /@ leaves, 1]
hgf[v_] := HighlightGraph[g, {Style[v, Yellow], Sequence @@ func[v]}]

Visualizing:

hgf[#] & /@ {cluster1, cluster2, cluster3, cluster4, cluster5, 
  cluster6, cluster7, cluster8, cluster9}

This is exported animated gif:

enter image description here

$\endgroup$
  • $\begingroup$ Every answer is useful. Thanx a lot for yours and awesome gif BTW! $\endgroup$ – xtian777x Aug 5 '14 at 17:14

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.