4

I want to thank you both for your help above. I'm going to abandon my quest for a number to label substitution using VertexRenderingFunction; because I need the labels to appear inside the yellow boxes as in:

LayeredGraphPlot[{"Tile & Marble Setter" -> "Construction Foreman", 
  "Construction Foreman" -> "Bricklayer", 
  "Stonemason" -> "Construction Foreman", 
  "Tile & Marble Setter" -> "Bricklayer", 
  "Bricklayer" -> "Tile & Marble Setter", 
  "Tile & Marble Setter" -> "Stonemason", 
  "Bricklayer" -> "Stonemason", "Stonemason" -> "Bricklayer", 
  "Apprentice Tile & Marble Setter" -> "Tile & Marble Setter", 
  "Apprentice Tile & Marble Setter" -> "Apprentice Bricklayer", 
  "Apprentice Tile & Marble Setter" -> "Apprentice Stonemason", 
  "Apprentice Bricklayer" -> "Apprentice Tile & Marble Setter", 
  "Apprentice Bricklayer" -> "Bricklayer", 
  "Apprentice Bricklayer" -> "Apprentice Stonemason", 
  "Apprentice Stonemason" -> "Apprentice Bricklayer", 
  "Apprentice Stonemason" -> "Stonemason", 
  "Helper/Finisher" -> "Apprentice Tile & Marble Setter", 
  "Helper/Finisher" -> "Apprentice Bricklayer", 
  "Helper/Finisher" -> "Apprentice Stonemason"}, 
 VertexLabeling -> True, 
 VertexCoordinateRules -> {{3, 6}, {6, 9}, {6, 6}, {9, 6}, {3, 3}, {6,
     3}, {9, 3}, {6, 0}}]

The question now becomes; how can I get single double-arrows joining:

Tile & Marble Setter <---> Bricklayer;

Bricklayer <---> Stonemason;

Apprentice Tile & Marble Setter <---> Apprentice Bricklayer;

Apprentice Bricklayer <---> Apprentice Stonemason;

in the above LayeredGraphPlot?

Thanks again!

atapaka
  • 3,954
  • 13
  • 33

2 Answers2

9

Here's my take:

lbl = {"Construction Foreman", "Tile & Marble Setter", "Bricklayer", 
   "Stonemason", "Apprentice Tile & Marble Setter", 
   "Apprentice Bricklayer", "Apprentice Stonemason", 
   "Helper/Finisher"};
ef[pts_List, e_] := {Arrowheads[{{0.05, RandomReal[{0.5, 0.7}]}}], 
  Arrow[pts]}
vc = ({2, 1}*#) & /@ {{6, 9}, {3, 6}, {6, 6}, {9, 6}, {3, 3}, {6, 
     3}, {9, 3}, {6, 0}};
g = Graph[{2 -> 1, 3 -> 1, 4 -> 1, 2 -> 3, 3 -> 2, 2 -> 4, 3 -> 4, 
   4 -> 3, 5 -> 2, 5 -> 6, 5 -> 7, 6 -> 5, 6 -> 3, 6 -> 7, 7 -> 6, 
   7 -> 4, 8 -> 5, 8 -> 6, 8 -> 7},
  VertexShapeFunction -> (Inset[
      Framed[lbl[[#2]], Background -> White], #1] &),
  VertexSize -> 
   Thread[Range[
       8] -> (ImageDimensions[Image@Rasterize@Text@#] & /@ lbl)]*50,
  GraphLayout -> {"LayeredDigraphEmbedding", "Orientation" -> Top},
  EdgeShapeFunction -> ef,
  VertexCoordinates -> vc
  ]

enter image description here

M.R.
  • 31,425
  • 8
  • 90
  • 281
5

VertexCoordinateRules apply to elements in the absolute order given, so by leading with 2 in 2 -> 1 you need to give its coordinate first.

titles = {"Construction Foreman",
   "Tile & Marble Setter",
   "Bricklayer",
   "Stonemason",
   "Apprentice Tile & Marble Setter",
   "Apprentice Bricklayer",
   "Apprentice Stonemason",
   "Helper/Finisher"};

LayeredGraphPlot[{2 -> 1, 3 -> 1, 4 -> 1, 2 -> 3, 3 -> 2, 2 -> 4, 3 -> 4, 4 -> 3, 
  5 -> 2, 5 -> 6, 5 -> 7, 6 -> 5, 6 -> 3, 6 -> 7, 7 -> 6, 7 -> 4, 8 -> 5, 8 -> 6, 
  8 -> 7},
 VertexCoordinateRules ->
   {{3, 6}, {6, 9}, {6, 6}, {9, 6}, {3, 3}, {6, 3}, {9, 3}, {6, 0}}, 
 VertexRenderingFunction -> 
   (Text[Style[titles[[#2]], Background -> White] ~Rotate~ (-20 °), #] &)
]

enter image description here

Mr.Wizard
  • 271,378
  • 34
  • 587
  • 1,371