# Tree-like diagram with text as VertexLabels

I am searching Mathematica's Documentation about TreePlot and relevant functions but I cannot find the solution to my question. Say

TreePlot[{1 -> 4, 1 -> 6, 1 -> 8, 2 -> 6, 3 -> 8, 4 -> 5,
7 -> 8}, Automatic, 1, VertexLabels -> Automatic]


Is it possible to replace the numbers by text? Particularly, I want to achieve something like the following diagram

• This is tricky because Mathematica doesn't know how to nicely layout a graph whose vertex labels are arbitrary rectangles – M.R. May 1 '19 at 18:07
• @M.R. Thanks for the comment. The rectangles is not a problem:-)! I just need to have this forest like structure with the arrows and the text. – Dimitris May 1 '19 at 18:10

Defining proper VertexShapeFunction is the key (thanks to the advise in the comments). This is a start with a few options that can be tuned or expanded (in Style for instance):

vshape[w_][x_, s_, _] :=
Inset[Framed[Pane[Style[s,TextAlignment->Left],w],


Pane does the automated text wrapping over a given width that I make a make a variable via currying. Let's get some data for a long-text labels, which are here Wikipedia articles' titles:

ocd="Obsessive\[Dash]compulsive personality disorder";

"MaxLevelItems"->3,"MaxLevel"->3],Sort];


The code below will produce nice layout. Note I set the arrow head position manually at 0.65 length of the edge.

Graph[ocdlinks,
VertexShapeFunction -> vshape[70],
EdgeShapeFunction->
GraphElementData[{"ShortCarvedArcArrow",
"ArrowSize"->.03,"ArrowPositions"->.65}],
VertexStyle -> Black,
AspectRatio->1,
PerformanceGoal -> "Quality",
GraphLayout ->{"LayeredDigraphEmbedding",
"Orientation"->Left,
"RootVertex"->ocd}]


The function for VertexShapeFunction defined above will do a couple of more tricks. Let's get some other similar complex-text data:

syn="Acro\[Dash]dermato\[Dash]ungual\[Dash]lacrimal\[Dash]tooth syndrome";


I will try another layout and will remove manual arrow head placement. As you can see in this case arrow head always remains positioned at the boundary of the vertex label. Also text is reflowing nicely with help of the Pane.

Manipulate[
VertexShapeFunction -> vshape[w],
VertexStyle -> Black,
AspectRatio->1,
ImageSize->700{1,1},
PerformanceGoal -> "Quality",
,{{w,70},30,120}]


# OLDER

Here labels automatically break text and wrap frame tightly around:

The solution by @C.E. is not ideal as it does not wrap rectangles around text. This means that rectangles are "unaware" of the text size and shape and can go much bigger or much smaller than text and thus rectangles needs to be manually adjusted for better looks.

Here I suggest a wrapping solution, which is also not ideal, but still good alternative to learn. Start from a design of a nice simple frame:

frame[s_]:=Framed[
Pane[Style[s,TextAlignment->Left],70],
Background->LightYellow,


that controls:

• wrapping - automated frame awareness of text size (Framed)
• frame width / size (Pane)
• text alignment (Style)

Now lets define a special shape of edge that places arrow as far as possible statistically from frames in order not to get overlapped by a frame:

edge[pts_List, e_] := {Arrowheads[{{.02, .6}}], Arrow[pts]}


For a demo sake get some lengthy text labels graph:

l=WikipediaData["Electromagnetic radiation","LinksRules","MaxLevelItems"->3,"MaxLevel"->2]


Now here is a graph with another few needed options to make a figure at the top:

Graph[l,
VertexLabels->Placed["Name",Center,frame],
VertexShapeFunction->None,
EdgeShapeFunction->edge,

• could set VertexShapeFunction vshape[x_, s_, _] := Inset[Framed[Pane[Style[s, TextAlignment -> Left], 70], Background -> LightYellow, RoundingRadius -> 5], x] and define graph as Graph[l, VertexShapeFunction -> vshape, VertexStyle -> Black, GraphLayout -> {"LayeredEmbedding", "Orientation" -> Top, "RootVertex" -> "Electromagnetic radiation"}, PerformanceGoal -> "Quality"] for arrow to stop at the boundary. – halmir May 2 '19 at 13:15
• PerformanceGoal -> "Quality" ensures that edges end at the boundary of vertices. This way you don't need to move the arrowhead to the middle. – Szabolcs May 2 '19 at 13:55
• @halmir Please document this. If you hadn't mentioned it here on SE, I would never have learned of it. I think most people don't know this trick. – Szabolcs May 2 '19 at 13:56

You could try using VertexShape, here is an example:

shape[{x_, y_}, v_, {w_, h_}, text_: "Default"] := {
Rectangle[{x - w, y - h}, {x + w, y + h}],
Black,
Text[text, {x, y}]
}

registerText[v_, text_] := shape[{x_, y_}, v, {w_, h_}] := shape[{x, y}, v, {w, h}, text]

registerText[1, "Label 1"]
registerText[5, "Label 5"]

TreePlot[
{1 -> 4, 1 -> 6, 1 -> 8, 2 -> 6, 3 -> 8, 4 -> 5, 7 -> 8},
VertexShapeFunction -> shape,
VertexSize -> 0.5
]


For a more elegant implementation, one might try using SetProperty and other related property functions to store and retrieve the texts in a more natural way.

• These rectangles will not wrap around the text right? – Vitaliy Kaurov May 1 '19 at 19:56
• @VitaliyKaurov This is correct. – C. E. May 1 '19 at 20:13
• I posted an alternative, I often need this myself :-) – Vitaliy Kaurov May 2 '19 at 1:02
• @VitaliyKaurov That's nice. My shape function was, of course, only meant as an example. I'm not saying "use this exactly" but "here is how you define a function that gets all the available information from the layout algorithm so that you can implement your own shape however you want it." If you want to make it wrap the text or whatever, that's fine. The downside with your approach as I see it is that your frame function is not aware of the maximum width it can have before it collides with neighboring boxes. – C. E. May 2 '19 at 4:16
• Yes, absolutely. Also ArrowHead does not avoid disappearing under frame. – Vitaliy Kaurov May 2 '19 at 10:35