TransWikia.com

How to fix EdgeWeights when a vertex is deleted from a directed graph (BUG?)

Mathematica Asked on January 13, 2021

I have the following Codes (developed by @Mr.Wizard and @kglr, respectively):

multiplierB[M_?MatrixQ, 
sec_Integer] := ((#/Tr[#] & /@ N[M[Transpose]])[Transpose] // 
 Take[#, sec, sec] & // Inverse[IdentityMatrix[sec] - #] &);

UnweightedTransmission[matrixA_?MatrixQ,matrixB_?MatrixQ,t1_Real, 
 t2_Real] :=
 Module[{indices = 
    Union @@ (Partition[#, 2, 1] & /@ 
     FindPath[
      AdjacencyGraph[
       Map[Boole[t1 <= # <= t2] &, 
        matrixA, {-1}]], #[[1]], #2[[1]], [Infinity], All])}, 
HighlightGraph[
 Graph[DirectedEdge @@@ indices, 
  EdgeWeight -> Extract[matrixB, indices], 
  EdgeLabels -> "EdgeWeight", ##3], {#, #2}]] &;

Example: Using the above Codes, I perform the following calculations:

mat = {{10, 60, 5, 9, 12, 4}, {20, 30, 40, 30, 30, 50}, {10, 20,  20, 90, 60, 200}, {30, 12, 24, 120, 90, 324}, {6, 24, 12, 21, 15,  222}, {24, 54, 299, 330, 93, 0}};  
multp = multiplierB[mat, 5];
SeedRandom[01];
trans = RandomInteger[6, {5, 5}];

gr1 = UnweightedTransmission[multp, trans, 0.1, 1.5][{1}, {5}, 
   VertexLabels -> "Name"]
gr1 = Graph[gr1, 
   VertexCoordinates -> 
   GraphEmbedding[gr1]];  (*fixes the vertex coordinates of "gr"*)

Below, I show the original digraph gr1 (on the left) and the digraph after deleting vertex 2 from gr1 (on the right). Obviously, EdgeWeights in gr1 are not preserved in the digraph on the right. How can I fix the coordinates of edges and weights in gr1 after deleting vertex 2 from gr1? I tried the above operations with various examples, and all of them give the contradictory mapping of the edge weights after deleting a vertex from the original digraph.

{gr1, VertexDelete[gr1, {2}]}

enter image description here

Add your own answers!

Ask a Question

Get help from others!

© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP