1
$\begingroup$

The following code generates:

enter image description here

The first element is a layered graph of the original system sam. The second element is a list of all the pathways from L to G. The third element is a directed graph in which the extracted pathways are highlighted. The fourth element is this highlighted subgraph. I like to achieve the following:

  1. In the first element LayeredGraph, edge weights should be placed on each edge with properly distanced edge lengths. Currently, the edge between A and L does not appear properly.

  2. The fourth element should be formatted like the first layered graph. Currently, vertex names inside circles and edge weights are all missing.

Here is what I have developed:

ClearAll[vnames, sam];
vnames = {"A", "X", "Q", "L", "K", "H", "G", "CA", "YTAX", "STAX", "TAR", "ROW"};
sam = {{0, PX QX, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, PD QD, 0, 0, 0, 0, 
  0, 0, 0, -TE, exr pwe QE}, {PQ QINT, 0, 0, 0, 0, PQ QH, PQ QG, 
  PQ QINV, 0, 0, 0, 0}, {PL QL, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
  0}, {PK QK, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, PL QL, 
  PK QK, 0, TR[H, g], 0, 0, 0, 0, exr TR[H, rw]}, {0, 0, 0, 0, 0, 0, 
  0, 0, YTAX, STAX, TAR, exr TR[g, rw]}, {0, 0, 0, 0, 0, 
  s YH (1 - t[H]), SAV[g], 0, 0, 0, 0, exr SAV[rw]}, {0, 0, 0, 0, 0, 
  YH t[H], 0, 0, 0, 0, 0, 0}, {0, 0, STAX, 0, 0, 0, 0, 0, 0, 0, 0, 
  0}, {0, 0, TM, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, exr pwm QM, 0, 0, 
  0, 0, 0, 0, 0, 0, 0}};
    
    (*from @KGLR*)
    edgeW = Module[{g = #, 
         e = DirectedEdge @@@ Partition[#, 2, 1] & /@ 
           FindPath[##, \[Infinity], All]}, 
        Transpose[{e, PropertyValue[{g, #}, EdgeWeight] & /@ # & /@ e}]] &;
    subGraphF = Module[
        {el = edgeW[##][[All, 1]]},
        Graph[DeleteDuplicates[Flatten@el], 
         VertexCapacity -> {v_ :> PropertyValue[{#, v}, VertexCapacity]}, 
         EdgeWeight -> {e_ :> PropertyValue[{#, e}, EdgeWeight]}]] &;
    
    wag = WeightedAdjacencyGraph[vnames, 
       Transpose@sam /. {0 -> \[Infinity]}, VertexLabels -> "Name", 
       EdgeLabels -> "EdgeWeight", ImageSize -> 300];
    
    source = "L";
    sink = "G";
    {
     LayeredGraphPlot[{"A" -> "Q", "A" -> "L", "A" -> "K", "X" -> "A", 
       "Q" -> "X", "Q" -> "STAX", "Q" -> "TAR", "Q" -> "ROW", "L" -> "H", 
       "K" -> "H", "H" -> "Q", "H" -> "CA", "H" -> "YTAX", "G" -> "Q", 
       "G" -> "H", "G" -> "CA", "CA" -> "Q", "YTAX" -> "G", "STAX" -> "G",
        "TAR" -> "X", "TAR" -> "G", "ROW" -> "X", "ROW" -> "H", 
       "ROW" -> "G", "ROW" -> "CA"}, Left, VertexLabeling -> True, 
      EdgeRenderingFunction -> ({Brown, Arrow[#1, 0.4]} &), 
      VertexRenderingFunction -> ({LightGray, EdgeForm[Black], 
          Disk[#, .3], Black, Text[#2, #1]} &), ImageSize -> 400],
     TableForm[edgeW[wag, source, sink]],     
      HighlightGraph[wag, subGraphF[wag, source, sink], 
      GraphHighlight -> {source, sink}, ImageSize -> 400, 
      EdgeLabels -> "EdgeWeight"],
     subGraphF[wag, source, 
      sink]     (* all paths from source to sink: a subgraph *)
     }
$\endgroup$
2
  • $\begingroup$ looks like you are using version 11.*? $\endgroup$
    – kglr
    Jun 5 at 22:35
  • $\begingroup$ @kglr: Yes indeed, I use version 11.3. $\endgroup$ Jun 5 at 23:01
1
$\begingroup$

1.

options = {EdgeLabels -> Placed["EdgeWeight", 11/20], 
  ImageSize -> 600, VertexSize -> Large, 
  VertexStyle -> Directive[LightGray, EdgeForm[Black]], 
  VertexLabels -> Placed["Name", Center], EdgeStyle -> Brown, 
  VertexShapeFunction -> (Disk[#, Offset[16]] &), 
  PerformanceGoal -> "Quality", AspectRatio -> 3/4}; 

Graph[wag, GraphLayout -> {"LayeredDigraphEmbedding", "Orientation" -> Left}, options]

enter image description here

Note: In versions 12.+, you can also use LayeredGraphPlot[wag, Left, options] to get a Graphics object with the same picture.

2.

Graph[subGraphF[wag, source, sink], options]

enter image description here

$\endgroup$
5
  • $\begingroup$ Thank you so much. It works perfectly. $\endgroup$ Jun 5 at 23:09
  • $\begingroup$ @TugrulTemel, my pleasure. Thank you for accepting. $\endgroup$
    – kglr
    Jun 5 at 23:10
  • $\begingroup$ Thanks a lot for the new edition, which is much more compact relative to the previous version. $\endgroup$ Jun 6 at 21:05
  • $\begingroup$ Can you color "source" and "sink" with Red, for example, in order to clearly illustrate the start and target vertices? $\endgroup$ Jun 6 at 21:14
  • 1
    $\begingroup$ @TugrulTemel, try SetProperty[Graph[subGraphF[wag, source, sink], options], VertexStyle -> {(source | sink) -> Red}]. $\endgroup$
    – kglr
    Jun 7 at 0:02

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.