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
    Commented Jun 5, 2021 at 22:35
  • $\begingroup$ @kglr: Yes indeed, I use version 11.3. $\endgroup$ Commented Jun 5, 2021 at 23:01

1 Answer 1

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$ Commented Jun 5, 2021 at 23:09
  • $\begingroup$ @TugrulTemel, my pleasure. Thank you for accepting. $\endgroup$
    – kglr
    Commented Jun 5, 2021 at 23:10
  • $\begingroup$ Thanks a lot for the new edition, which is much more compact relative to the previous version. $\endgroup$ Commented Jun 6, 2021 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$ Commented Jun 6, 2021 at 21:14
  • 1
    $\begingroup$ @TugrulTemel, try SetProperty[Graph[subGraphF[wag, source, sink], options], VertexStyle -> {(source | sink) -> Red}]. $\endgroup$
    – kglr
    Commented Jun 7, 2021 at 0:02

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.