3
$\begingroup$

I'd like to create a graph that resembles a flowsheet in process simulation applications. A concrete example would be this graph:

enter image description here

I was able to recreate it by manually specifying the vertex coordinates:

streams = {"feed" -> <|{"From" -> "RefineryFeed", "To" -> "Mix"}, 
     "Class" -> "Product"|>,
   "mixedFeed" -> <|{"From" -> "Mix", "To" -> "Flash"}, 
     "Class" -> "Product"|>,
   "flashVapour" -> <|{"From" -> "Flash", "To" -> "RefineryProduct"}, 
     "Class" -> "Product"|>,
   "flashLiquid" -> <|{"From" -> "Flash", "To" -> "Split"}, 
     "Class" -> "Product"|>,
   "splitProduct" -> <|{"From" -> "Split", "To" -> "RefineryProduct"},
      "Class" -> "Product"|>,
   "splitRecycle" -> <|{"From" -> "Split", "To" -> "Pump"}, 
     "Class" -> "Product"|>,
   "pumpRecycle" -> <|{"From" -> "Pump", "To" -> "Recycle"}, 
     "Class" -> "Product"|>,
   "recycleFeed" -> <|{"From" -> "Recycle", "To" -> "Mix"}, 
     "Class" -> "Product"|>
   };

flowsheetGraph = 
 Graph[Labeled[streams[[#, 2]]["From"] -> streams[[#, 2]]["To"], 
     streams[[#, 1]]] & /@ Range [Length[streams]], 
  VertexShapeFunction -> "Square", VertexSize -> Large, 
  VertexLabels -> Placed["Name", Center], 
  VertexCoordinates -> {{0, 0}, {1, 0}, {2, 0}, {3, -1}, {3, 0}, {3, 
     1}, {1, 1}}, DirectedEdges -> True]

enter image description here

Now I was wondering if there was a way to create a similar graph without manually specifying the coordinates. If I omit the VertexCoordinates Mathematica does a good job at selecting coordinates for the vertices, but it would be great if the appearance would be more "grid-like" like in the graph above.

enter image description here

$\endgroup$
4
$\begingroup$

You could try using "MultipartiteEmbedding" as the vertex layout method, and perhaps adjust vertex partitions accordingly. Here is a stab at it:

graphData = KeyValueMap[Labeled[#2["From"] -> #2["To"], #1] &] @ Association @ streams;

Graph[
  graphData, VertexShapeFunction -> "Square", VertexSize -> Large,
  VertexLabels -> Placed["Name", Center], DirectedEdges -> True,

  GraphLayout -> {"VertexLayout" -> {"MultipartiteEmbedding", "VertexPartition" -> {3, 3, 1}}}
]

resulting graph with multipartite embedding

You would probably want to re-order the vertices or partition them differently from what I've done here, but it should still be less work than explicitly setting vertex coordinates.

Note that I took the liberty of rewriting the way you obtained your graph data using explicit Association functionality, since your data structure was almost there anyway.

| improve this answer | |
$\endgroup$
3
$\begingroup$

A custom layout combining grid embedding and multipartite embedding:

ClearAll[multipartiteOnGrid]
multipartiteOnGrid[{r_, c_}, columnpositions_] /; c == Length @ columnpositions := 
 Module[{grd = Partition[Tuples[Range /@ {c, r}], r], 
   prts = columnpositions /. 
     {All -> r, i_Integer?Negative :> r + 1 + i} /. Span[a_, b_] :> Range[a, b]}, 
  Extract[grd, Join @@ MapIndexed[Thread[{#2[[1]], #}] &, prts]]]

The first argument gives the dimensions of grid and the second the positions in each column.

Playing with the two arguments of multipartiteOnGrid and the ordering of the vertex list in the first argument of Graph we get a variety of grid layouts:

Examples:

Using graphData from @MarcoB's answer and the list of vertices in the desired order in the first argument of Graph:

Graph[{"RefineryFeed", "Mix", "Recycle", "Flash", "RefineryProduct",  "Split", "Pump"}, 
 graphData, 
 GraphStyle -> "VintageDiagram", 
 VertexSize -> {.25, .1}, 
 VertexCoordinates -> multipartiteOnGrid[{3, 4}, {{2}, 2 ;;, {2}, 1 ;;}]]

enter image description here

With VertexCoordinates -> multipartiteOnGrid[{3, 4}, {{1}, {1, 3}, {1}, 1 ;;}] we get

enter image description here

Graph[{"RefineryFeed", "Flash", "Mix", "Recycle", "RefineryProduct", "Split", "Pump"}, 
 graphData, 
 GraphStyle -> "VintageDiagram", 
 VertexSize -> {.25, .1}, 
 VertexCoordinates -> multipartiteOnGrid[{3, 4}, {{2}, 1 ;;, {}, 1 ;;}]]

enter image description here

SeedRandom[1]
rg = RandomGraph[{16, 25}, DirectedEdges -> True];
Graph[Range[16], EdgeList @ rg, GraphStyle -> "VintageDiagram", 
 VertexCoordinates -> multipartiteOnGrid[{4, 6}, 
   {{1, 3, 4}, {1, 2, 3}, {2, 3}, {2}, 1 ;;, 2 ;;}]]

enter image description here

ckt = CompleteKaryTree[3, 3, DirectedEdges -> True]; 

ckt1 = Graph[Range[13], EdgeList@ckt, ImageSize -> 1 -> 40, 
  GraphStyle -> "VintageDiagram", 
  VertexCoordinates -> multipartiteOnGrid[{9, 3}, {{5}, {3, 5, 7}, 1 ;;}]];

ckt2 = Graph[{1, 5, 2, 7, 8, 3, 10, 11, 4, 13, 6, 9, 12}, EdgeList@ckt, 
  ImageSize -> 1 -> 40, GraphStyle -> "VintageDiagram",
  VertexCoordinates -> multipartiteOnGrid[{9, 7}, 
     {{5}, {}, {}, {}, {1, 2, 3, 4, 5, 6, 7, 8, 9}, {}, {2, 5, 8}}]];

ckt3 = Graph[{2, 1, 4, 3, 5, 6, 7, 8, 9, 10, 11, 12, 13}, EdgeList@ckt, 
  ImageSize -> 1 -> 40, GraphStyle -> "VintageDiagram",
  VertexCoordinates -> multipartiteOnGrid[{9, 5}, {{1, 5, 9}, {5}, {}, {}, 1 ;;}]];

ckt4 = Graph[{1, 3, 2, 8, 10, 4, 5, 6, 7, 9, 11, 12, 13}, EdgeList@ckt, 
  ImageSize -> 1 -> 50, GraphStyle -> "VintageDiagram", 
  VertexCoordinates -> multipartiteOnGrid[{9, 4},
  {{5}, {5}, {3, 4, 6, 7}, {2, 3, 4, 5, 6, 7, 8}}]];

Row[{ckt1, ckt2, ckt3, ckt4}, Spacer[10]]

enter image description here

| improve this answer | |
$\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.