9
$\begingroup$

Given a LayeredGraph:

LayeredGraphPlot[{1 -> 3, 3 -> 1, 1 -> 5, 3 -> 6, 1 -> 6, 2 -> 4, 
    2 -> 6, 3 -> 4, 3 -> 5, 3 -> 6, 4 -> 6, 5 -> 6}, 
    VertexLabeling -> True];

enter image description here

I like to present it on a three-layer surface:

enter image description here

Such that vertices {3,1,2} be placed on the top layer; {5,4} on the middle layer; and {6} on the bottom layer. Directed arrows from the top layer towards bottom should be Blue and from the bottom towards the top be Gray.

$\endgroup$
15
$\begingroup$
edges = {1 -> 5, 1 -> 6, 1 -> 3, 5 -> 2, 5 -> 4, 6 -> 7, 2 -> 6, 2 -> 3, 3 -> 4, 7 -> 4};

vertices = {4, 3, 7, 1, 2, 6, 5};

layers = {1, 2, 4};

vcoords = Thread[vertices -> 
    Join @@ MapThread[Join[##, 2] &, 
     {MapIndexed[CirclePoints[#2[[1]]/4, #] &, layers] /. {{a_?NumericQ, _}} :> {{0, 0}}, 
      MapIndexed[ConstantArray[#2 - 1, #] &, layers]}]];

Graph3D[edges, 
  VertexCoordinates -> vcoords, VertexLabels -> "Name", ImageSize -> Medium]

enter image description here

Show[Graphics3D[{Opacity[.4], EdgeForm[Thin], Lighting -> "Neutral", 
   LightBlue, InfinitePlane[{0, 0, #}, {{1, 0, 0}, {1, 1, 0}}] & /@ 
    Range[0, 2]}, Boxed -> False], 
 Graph3D[edges, VertexCoordinates -> vcoords, VertexLabels -> "Name", 
  ImageSize -> Medium], 
 PlotRange -> All, PlotRangePadding -> Scaled[.2]]

enter image description here

Alternatively, use FaceGrids to indicate the planes:

facegrids = {#, {{}, {0, 1, 2}}} & /@ Join[#, -#] & @ Most[IdentityMatrix[3]];

Graph3D[edges, VertexCoordinates -> vcoords, VertexLabels -> "Name", 
 ImageSize -> Medium, 
 FaceGrids -> facegrids, 
 PlotRangePadding -> Scaled[.2]]

enter image description here

Update: Styling edges:

Graph3D[edges, VertexCoordinates -> vcoords, VertexLabels -> "Name", 
 VertexSize -> Medium, BaseStyle -> Arrowheads[Large], 
 EdgeShapeFunction -> (Arrow @ Tube[#, .03] &), 
 EdgeStyle -> MapIndexed[# -> ColorData[97][#2[[1]]] &, edges], 
 ImageSize -> Medium, FaceGrids -> facegrids, 
 PlotRangePadding -> Scaled[.2]]

enter image description here

Graph3D[edges, VertexCoordinates -> vcoords, 
 VertexLabels -> Placed["Name", Center], ImageSize -> Medium, 
 FaceGrids -> facegrids, PlotRangePadding -> Scaled[.2], 
 VertexSize -> Medium, EdgeStyle -> Black, 
 EdgeShapeFunction -> ({Arrowheads[Large, Appearance -> "Projected"], Thick, 
   Arrow[BezierCurve[{#[[1]], {#[[1, 1]], #[[1, 2]], #[[-1, 3]]}, #[[-1]]}], .1]}&), 
 Properties -> {(5 \[DirectedEdge] _) -> {EdgeStyle -> Directive[Dashed, Red]}}]

enter image description here

$\endgroup$
7
  • $\begingroup$ The structure of the layered graph is fine, but I wanted to show each layer on a separate plane (surface) so that the web of links between the layers is apparent. Also, how do you set the colors of linkages between the layers? $\endgroup$ Dec 29 '19 at 1:36
  • $\begingroup$ Yes, this is what I had in mind. Perfect!!! $\endgroup$ Dec 29 '19 at 2:01
  • $\begingroup$ Is there a way to choose edge colors? In the current graphs, edges are difficult to differentiate, and the arrows and edges are blurry somehow, maybe due to my computer. $\endgroup$ Dec 29 '19 at 13:16
  • 1
    $\begingroup$ @Tugrul, please see the update. $\endgroup$
    – kglr
    Dec 29 '19 at 13:54
  • $\begingroup$ I just wonder: Is it a legitimate question if I ask the MMA Stack Exchange Forum to help me in developing a new LayeredGraph3D[...] function to perform your above answer in a more systematic manner? Sorry if I asked you an improper question. Thanks. $\endgroup$ Dec 30 '19 at 12:51

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.