Nested list to graph

Question

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]

Answer 1

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"}]

Answer 2

With IGraph/M running on Mathematica 11.3,

IGExpressionTree[li /. List -> Construct]

Answer 3

li //. {{x_, rest__} :> x[rest], {x_} :> x} // 
 TreeForm[#, DirectedEdges -> True] & 

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

Answer 4

Here's another way I think is interesting:

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

Answer 5

This doesn't directly answer the question, but can be used to create a tree graph from nested lists without the header element at each level. For example, lists such as {{a, {b, c}}, {d, e}}. Moreover, it represents internally each level of the graph with the hash of the corresponding expression, thus the generated graph identifies nodes corresponding to the same expression.

nestedListToGraph[expr_] := Reap[
  Map[
    CompoundExpression[
      Sow[Hash@#, "vertices"],
      If[Head@# =!= List, 
        Sow[Rule[Hash@#, ToString@#], "labels"]
      ],
      If[Head@# == List,
        Function[elem,
          Sow[DirectedEdge[Hash@#, Hash@elem], "edges"]
        ] /@ #
      ],
      #
    ] &,
    {expr}, Infinity
  ],
  {"vertices", "edges", "labels"}
] // Last // Map@First // Graph[#[[1]], #[[2]], VertexLabels -> #[[3]]] &;

SetProperty[
  nestedListToGraph@{{a, {b, c}}, {d, e}},
  GraphLayout -> "LayeredDigraphEmbedding"
]