8
$\begingroup$

The following nested list can be regarded as a representation of a (tree) graph:

li = {"fig", {"date", {"kumquat"}, {"papaya", {"peach"}, {"apple"}}},
             {"mango", {"orange", {"pear"}, {"avocado"}}}, 
             {"banana"}}

In the above, a string is a node in the tree, and any lists that follow it are subtrees rooted at that node.

What are some of the ways by which this can be converted into a graph (or more concretely, a list of DirectedEdges)? I've come up with one way, listed below. But I wanted to learn about other interesting approaches - for instance, pattern replacements might be used?

This is what I came up with:

h[{str_String}] := Sequence[];
h[{str_String, ls__List}] := {DirectedEdge[str, #[[1]]], h@#} & /@ {ls};

edges = Flatten@h@li

(* 
{"fig" \[DirectedEdge] "date", "date" \[DirectedEdge] "kumquat", 
 "date" \[DirectedEdge] "papaya", "papaya" \[DirectedEdge] "peach", 
 "papaya" \[DirectedEdge] "apple", "fig" \[DirectedEdge] "mango", 
 "mango" \[DirectedEdge] "orange", "orange" \[DirectedEdge] "pear", 
 "orange" \[DirectedEdge] "avocado", "fig" \[DirectedEdge] "banana"}
*)

TreePlot[Rule @@@ edges, Automatic, "fig", DirectedEdges -> True, 
 VertexLabeling -> True]

Don't you wish this were an actual tree?

$\endgroup$
8
$\begingroup$
edges = Cases[li,
   {node_String, subtrees__List} :> (
     node \[DirectedEdge] #[[1]] & /@ {subtrees}),
   {0, ∞}] // Flatten

Note the level specification within Cases.

Graph[edges,
 VertexLabels -> "Name",
 ImagePadding -> 30,
 GraphLayout -> {
   "LayeredEmbedding",
    "RootVertex" -> "fig"}]
$\endgroup$
2
$\begingroup$
li //. {{x_, rest__} :> x[rest], {x_} :> x} // 
 TreeForm[#, DirectedEdges -> True] & 

enter image description here

A similar rule can be used to parse JSON data and display with TreeForm

$\endgroup$
  • 1
    $\begingroup$ If the goal was just produce a visual tree, then this would do fine... but the question was about converting the nested list representation to a "true" graph. $\endgroup$ – Aky Jun 23 '14 at 19:13
2
$\begingroup$

With IGraph/M running on Mathematica 11.3,

IGExpressionTree[li /. List -> Construct]

enter image description here

$\endgroup$
1
$\begingroup$

Here's another way I think is interesting:

Flatten@Rest@
  Reap@Scan[Sow[Thread[First@# \[DirectedEdge] First /@ Rest@#]] &, 
    li, {0, -3}]
$\endgroup$

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.