Routines

Off[General::spell];
Needs["FeedbackLoops`"];

This routine transforms the complex weights into the normalized weights adjusting for conjugate pairs.  The routine works under the assumption that a conjugate pair of eigenvalues will be adjacent to each other in the comp (input vector); this is true for the way Mathematica reports the Eigenvalues and Eigenvectors out of the Eigensystem command.

ComplexToWeight[
          comp_] := 

Module[{j, θ, 
            W = {}},  
 (*not clean prgraming but all this variables are needed globally*)  
Theta = idx = {};                                
c = 
            Map[Last[levInit[[#]]] &, 
              Range[n]];       
                             (*itialize constant with initial state values*)            
                        
For[j = 1, 
            j ≤ Dimensions[
                  comp][[1]], j++,                  (*For every mode*) 
If[
                j < Dimensions[
                        comp][[1]]  &&  
Table[
                      0, {n}] == 
                    Chop[comp[[j]] - 
                        Conjugate[
                          comp[[j + 
                                1]]]],      
{                                                                                                             (*if part of conjugate*) 
W = 
                    Append[W, 
                      2*Sqrt[Re[comp[[j]]]^2 + 
                            Im[comp[[j]]]^2]];                             
                                                                                                            (*recorde the combined weight *) 
 (*the next two instructions are equivalent to the theta presented in the appendix of the paper*) 
θ = 
                    Arg[comp[[j]]] + Pi/2; 
Map[
                    If[Im[comp[[j, #]]] >= 0 && 
                          Re[comp[[j, #]]] < 
                            0, θ[[#]] = θ[[#]] - 
                            2  Pi] &, 
                    Range[Length[θ]]]; 

Theta = 
                    Append[Theta, θ];                  
c = c - 2*Re[comp[[j]]]; 
idx = 
                    Append[idx, 
                      j];                                                         (*record in idx extracted eigenvalue*)  
j++;                                                                                                  (*skip next mode -- is the conjugate *) 
Theta = 
                    Append[Theta, {}];                                              (*but add a black theta for it*) 
}, 
{                                                                                                                (*else,  
                    ie if not conjugate *) 
W = 
                    Append[W, 
                      Re[comp[[j]]]];                                         (*record the real part *) 
Theta = Append[Theta, {}]; 
c = 
                    c - Re[comp[[j]]];                                                                                                    
idx = 
                    Append[idx, 
                      j];                                                               (*record in idx extracted eigenvalue*)  
}
];
]; 
W
];

Model as graph

Nodes

nodelist=Join[xv,yv];

nodelist

Adjacency matrix

Mm=FromAdjacencyLists[
	Block[
		{t=Join[dsv,aux]},
		Map[(Map[First,Position[t,#]])&,nodelist]
	]
];

Edges

el=ToEdgeList[Mm]

edgelist = Map[nodelist[[#]] &, el, {2}]

Expressing loop and edge gains

List edge gains g[i,j]

eg = Map[Apply[gain, #] &, el]

Edge gains as functions of variables

egv=Map[
	Apply[
		Function[
			{x1,x2},
			If[x2<=n,
				If[x1<=n,
					D[dsv[[x2]],xv[[x1]]],
					D[dsv[[x2]],yv[[x1-n]]]
				],
				If[x1<=n,
					D[aux[[x2-n]],xv[[x1]]],
					D[aux[[x2-n]],yv[[x1-n]]]
				]
			]
		],
		#
	]&,
	el
] (* Edge gains, as functions of variables *)

subEgToEgv=Table[
        eg[[i]] -> egv[[i]], {i, Length[eg]}]

Jacobian

Uses the notation
x_dot=A.x+B.y
y=C.x+Dy
The systems Jacobian is given by 
J=A+B.(I-D)^-1.C

Am=Table[If[MemberQ[edgelist,{xv[[j]],xv[[i]]}],gain[j,i],0],{i,n},{j,n}];
Bm=Table[If[MemberQ[edgelist,{yv[[j]],xv[[i]]}],gain[j+n,i],0],{i,n},{j,p}];
Cm=Table[If[MemberQ[edgelist,{xv[[j]],yv[[i]]}],gain[j,i+n],0],{i,p},{j,n}];
Dm=Table[If[MemberQ[edgelist,{yv[[j]],yv[[i]]}],gain[j+n,i+n],0],{i,p},{j,p}];
Um=Inverse[IdentityMatrix[p]-Dm];
Jm=Am+Bm.Um.Cm//Expand;

Behavior Decomposition Weights (BDW)

Base case

Computation of the driving vector

This section recognizes that the model might be driven by a constant set of factors.  Since stocks cannot be directly influenced by these factors (other than through rates) the new system notation is 
	x_dot=Ax+By
	y=Cx+Dy+Eu
where u is the vector of system parameters and E links the effects of parameters to auxiliary variables.  Since we are not interested in changing  E, we can change the second equation to
	y=Cx+Dy+d.
 Solving for d
	d=(I-D)y-Cx
Now we can use the equation
	x_dot=J.x+B.(I-D)^-1.d
to estimate the initial net change rates, where J is still the systems Jacobian
	J=A+B.(I-D)^-1.C

auxa = Table[
              First[var[[i]]] -> Last[var[[i]]], {i, 
                Length[var]}] /. levInit /.  
          par;
  

d = 
        Dot[IdentityMatrix[p] - Dm, yv] - 
          Dot[Cm, Map[Last, levInit]];
db = d //. subEgToEgv //. auxa /. levInit /. 
          par;

Computation of weight matrix

After computing Alpha, the routine separates the zero and non-zero eigenvalues and estimates the appropriate wieght (αr for zero eigenvalues and αr/λ for non-zero values) and adds them up to create the equations.

J = Jm //. subEgToEgv //. auxa /. levInit /. 
          par;                                                          
nrt0 = J . xv + Bm . Um . db //. subEgToEgv //. auxa /. 
            levInit /. par;

    
{L, R} = Eigensystem[J];             
Lb = L;
z = 
      Count[Chop[L], 
        0];                   (*find the # of evalues = 
        0*)  
nz = Dimensions[L][[1]] - 
        z ;      (*find the # of evalues ≠ 
        0*) 

A = 
      Dot[Inverse[Transpose[R]], 
        Transpose[nrt0, {1}]];   (*Alpha*) 
lin = τ*
        Take[A, -z]*
        Take[R, -z];                                                          (*Take works because 0 are at end of evalue vector *) 
comp = 
      Take[A, nz]/Take[L, nz]*
        Take[R, nz];                            (*comp is (mode, stock) array*)    
WBase = 
      ComplexToWeight[
        comp];                                                            (*complex weights into std .  
          weights*) 

 (*Construct Mode Vector*) 
y = 
      Exp[τ*
          Re[L]];                                                                                         (*Exp [
        real part*t]*) 
Map[
      If
[
          Im[L[[#]]] ≠ 0, 
y[[#]] = 
            y[[#]]*
              Sin[τ*Im[L[[#]]] + 
                  Theta[[#]]],     (*If Im add Sine  & Theta*) 
y[[#]] = 
            Table[y[[#]], {n}]                                                        (*else add copies of real part *) 
]
 &, 
      Range[n]
];
m = 
      Transpose[
        WBase*y[[idx]]];                                                     (*Generate products *) 
Map[(m[[#]] = Total[m[[#]]]) &, 
      Range[n]];                            (*Add products*) 
                                                                                                                            
m = 
      m + Total[
          lin];                                                                                     (*lin Totaled in case of more than 1 evalue = 0*) 
M = 
      Table[First[lev[[i]]] -> m[[i]] + c[[i]], {i, 
          n}] ;    (*Add Stock name and constant*) 
r = 
      FullSimplify[
        Table[M[[i]][[2]]/Abs[c[[i]]], {i, 
            Length[M]}]];
                                                                                                                                     (*extract constant*) 
MatrixForm[M] //  Chop
MatrixForm[Abs[c]*r]
TableForm[PaddedForm[r, {5, 4}]]

Stock Behavior Decomposition (relative)

This section reports the graphs of the relative influence of each eigenvalue on the behavior of the stocks.  All graphs are normalized by dividing by the constant term, thus making the relative influence of each  eigenvalue comparable.

For[i = 1, 
      i ≤ 
        n, i++, 
Plot[
Evaluate[
          Map[r[[i]][[#]] &,  
            Range[Length[idx] + 1]]], 
{τ, 0, tmax}, 
        PlotRange -> All, 
        AxesLabel -> {Time, lev[[i]][[1]]}
]
]
Clear[i];

Stock Behavior Decomposition (absolute)

This section reports the graphs of the relative influence of each eigenvalue on the behavior of the stocks and plots them against the value of the stock.

i = 
      4;                                    (*Replace i with the number of the desired stock to analyze *) 
S = lev[[i]][[1]];              
ind = 
        Plot[Evaluate[S /. M], {τ, 0, tmax}, PlotRange -> All, 
          PlotStyle -> {Thickness[0.01]}, 
          AxesLabel -> {Time, S}];
Map[(S /. M)[[#]] &, 
        Range[Length[idx] + 1]];
com = 
        Plot[Evaluate[%], {τ, 0, tmax}, PlotRange -> All, 
          DisplayFunction -> Identity];
Show[ind, com,  AxesLabel -> {Time, S}, 
        DisplayFunction -> $DisplayFunction];
Clear[i,  S, ind, com];

BDW Elasticities

Estimate BDW Elasticities to Parameters

Estimates the elasticity of weights to model parameters by successively adjusting the value of each parameter (by a factor of 1.001) and then comparing it to the base case.
    All results are placed in the array PElas with (par, mode, state) structure.
    The routine only calculates the elasticity of weights to eigenvalues different from zero. If an eigenvalue is equal to zero, it is not possible to calculate the elasticity of the weight to that parameter.

\(Block[{T, k, s, J, nrt0, A, L, R, comp, 
        W}, 
PElas = \(PElasER = \(PElasEI = {}\)\); 
For[k = 1, 
        k ≤ 
          Length[par], \(k++\), \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  (*for\ every\ edge\ *) 
T = 
          Table[1, {j, 
              Length[par]}]; \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  (*define\ vector\ T\ of\ ones\ for\ each\ edge*) 
T = 
          ReplacePart[T, 1.001, 
            k]; \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  (*replace\ edge\ k\ with\ value\ 1.001*) 
parm = 
          Table[\(par[\([i]\)]\)[\([1]\)] -> \(par[\([i]\)]\)[\([2]\)]*
                T[\([i]\)], {i, 
              Length[par]}]\ \ ;  (*adjusting\ par\ values\ by\ T*) 

 (*need\ to\ re - 
            estimate\ the\ d\ vector\ because\ of\ the\ changes\ in\ the\ parameter\ values*) 
auxm = \(Table[
                First[var[\([i]\)]] -> Last[var[\([i]\)]], {i, 
                  Length[var]}] /. levInit\) /. \ 
            parm; 
 (*Transform\ var\ list\ into\ assignation\ list\ for\ aux\ variables\ *) 

dm = \(\(\(d //. subEgToEgv\) //. auxm\) /. levInit\) /. 
            parm; 

J = \(\(\(Jm //. 
                  subEgToEgv\) //. auxm\) /. levInit\) /. 
            parm; \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
nrt0 = \(\(\(J . xv + Bm . Um . dm //. subEgToEgv\) //. auxm\) /. levInit\) /. 
            parm; 

{L, R} = 
          Eigensystem[
            J]; \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  (*L -> e - values; \ R -> e - vectors*) 
A = 
          Dot[Inverse[Transpose[R]], 
            Transpose[
              nrt0, {1}]]; \  (*Alpha*) 
									 (*takes\ the\ same\ value\ of\ nz\ extimated\ in\ the\ base\ case*) 
comp = 
          Take[A, nz]/Take[L, nz]*
            Take[R, nz]; \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  (*comp\ is\ \((mode, 
              stock)\)\ array*) \ \ \ 

W = ComplexToWeight[
            comp]; \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  (*complex\ weights\ into\ std . \ weights*) 
PElas = 
          Append[PElas, 
            1000*\((\((W - WBase)\)/
                  WBase)\)]; \ \ \ \ \ \ \ \ \ \ \ \ \  (*PElas\ is\ \((par, \ mode, \ state)\)\ array*) 
PElasER = 
          Append[PElasER, 
            1000*\((Re[L[\([idx]\)]] - Re[Lb[\([idx]\)]])\)/
                Re[Lb[\([idx]\)]]]; \  (*\(PElas\ ER &\) 
            EI\ are\ \((par, mode)\)\ arrays*) 
PElasEI = 
          Append[PElasEI, 
            1000*\((Im[L[\([idx]\)]] - Im[Lb[\([idx]\)]])\)/
                Im[Lb[\([idx]\)]]];
]
]\)

Estimate BDW Elasticities to Links

Estimates the elasticity of weights to link gains by successively adjusting the gain for each link (by a factor of 1.001) and then comparing it to the base case.
    All results are placed in the array LElas with (link, mode, state) structure.
        The routine only calculates the elasticity of weights to eigenvalues different from zero. If an eigenvalue is equal to zero, it is not possible to calculate the elasticity of the weight to that parameter.

\(Block[{T, k, s, J, nrt0, A, L, R, comp, 
        W}, 
LElas = \(LElasER = \(LElasEI = {}\)\); 
For[k = 1, 
        k ≤ 
          Length[eg], \(k++\), \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  (*for\ every\ edge\ *) 
T = 
          Table[1, {j, 
              Length[eg]}]; \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  (*define\ vector\ T\ of\ ones\ for\ each\ edge*) 
T = 
          ReplacePart[T, 1.001, 
            k]; \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  (*replace\ edge\ k\ with\ value\ 1.001*) 
s = 
          Table[eg[\([i]\)] -> egv[\([i]\)]*T[\([i]\)], {i, 
              Length[eg]}]; \  (*adjusting\ edge\ gains\ by\ T*) 

J = \(\(\(Jm //. s\) //. auxa\) /. 
              par\)\  /. 
            levInit; \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
nrt0 = \(\(\(J . xv + Bm . Um . db //. s\) //. auxa\) /. 
              par\) /. levInit; 

{L, 
            R} = Eigensystem[
            J]; \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  (*L -> e - values; \ R -> e - vectors*) 
A = 
          Dot[Inverse[Transpose[R]], 
            Transpose[
              nrt0, {1}]];  (*Alpha*) 
									 (*takes\ the\ same\ value\ of\ nz\ extimated\ in\ the\ base\ case*) 
comp = 
          Take[A, nz]/Take[L, nz]*
            Take[R, nz]; \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  (*comp\ is\ \((mode, 
              stock)\)\ array*) 

W = 
          ComplexToWeight[
            comp]; \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \  (*complex\ weights\ into\ std . \ weights*) 
LElas = 
          Append[LElas, 
            1000*\((\((W - WBase)\)/
                  WBase)\)]; \ \ \ \ \ \ \ \ \ \ \ \ \  (*LElas\ is\ \((link, \ mode, \ state)\)\ array*) 
LElasER = 
          Append[LElasER, 
            1000*\((Re[L[\([idx]\)]] - Re[Lb[\([idx]\)]])\)/
                Re[Lb[\([idx]\)]]]; \  (*\(LElas\ ER &\) 
            EI\ are\ \((link, \ 
              mode)\)\ arrays*) 
LElasEI = 
          Append[LElasEI, 
            1000*\((Im[L[\([idx]\)]] - Im[Lb[\([idx]\)]])\)/
                Im[Lb[\([idx]\)]]];
]
]\)

Report Elasticity Tables

Stock and Mode numbers

Print["Stock numbers"];
Print[
        Table[{i, lev[[i]][[1]]}, {i, Length[lev]}] // 
          TableForm];
Print["Mode numbers"];
Print[
        Table[{i, L[[idx]][[i]]}, {i, Length[idx]}] // 
          TableForm];

Report Parameter Elasticity Tables

Report by Stock

Change the values of the Stock variable (s) to see the corresponding elasticity table.  The table will report the impact of all the behaviors modes in the selected stock and will be sorted by the descending elasticity of the selected behavior Mode (m).

s = 1;  m = 3;  
\(\(If[
        z > 0, 
{\(Print["WARNING: Some system eiganvalues=0. Elasticities of weights associated with those eigenvalue are nor reported."];\)
}];\)\)
\(\(Print["Stock: ", \(lev[\([s]\)]\)[\([1]\)], "   Mode: ", \(L[\([idx]\)]\)[\([m]\)]\ ];\)\)
PET = 
        Map[Prepend[PElas[[#,  All,  s]], par[[#]][[1]]] &, 
          Range[Length[par]]];
Print[
      PaddedForm[
        TableForm[
          PET[[Ordering[Abs[PET[[All, 1 + m]]], All, Greater]]], 
          TableHeadings -> {None, 
              Join[{"Parameter"}, Range[Length[idx]]]}], {5, 
          3}]]

Report by Behavior Mode

Change the values of the Mode variable (m) to see the corresponding elasticity table.  The table will report  the impact of the selected behavior mode in all stocks and will be sorted by descending elasticity on the selected stock (s).

m = 3;  s = 1;  
\(\(If[
        z > 0, 
{\(Print["WARNING: Some system eiganvalues=0. Elasticities of weights associated with those eigenvalue are nor reported."];\)
}];\)\)
\(\(Print["Stock: ", \(lev[\([s]\)]\)[\([1]\)], "   Mode: ", \(L[\([idx]\)]\)[\([m]\)]\ ];\)\)
PET = 
        Map[Prepend[PElas[[#,  m,  All]], par[[#]][[1]]] &, 
          Range[Length[par]]];
Print[
      PaddedForm[
        TableForm[
          PET[[Ordering[Abs[PET[[All, 1 + s]]], All, Greater]]], 
          TableHeadings -> {None, 
              Join[{"Parameter"}, 
                Table[lev[[i]][[1]], {i, Length[lev]}]]}], {5, 
          3}]]

Report with Eigenvalue Elasticity

Change the values of the Stock (s) and Mode variables (m) to see the corresponding elasticity table.  The table will report  the impact of the selected behavior mode in the selected stocks and will be sorted by descending weight elasticity.

m = 3;  s = 3;  
\(\(If[
        z > 0, 
{\(Print["WARNING: Some system eiganvalues=0. Elasticities of weights associated with those eigenvalue are nor reported."];\)
}];\)\)
\(\(Print["Stock: ", \(lev[\([s]\)]\)[\([1]\)], "   Mode: ", \(L[\([idx]\)]\)[\([m]\)]\ ];\)\)
PET = 
        Map[Prepend[{PElas[[#,  m,  s]], PElasER[[#, m]], 
                PElasEI[[#, m]]}, par[[#]][[1]]] &, 
          Range[Length[par]]];
\(Print[
      PaddedForm[
        TableForm[PET[\([Ordering[Abs[PET[\([All, 2]\)]], All, Greater]]\)], 
          TableHeadings -> {None, 
              Join[{"Parameter", "Weight", "Re[Eigenvalue]", "Im[Eigenvalue]"}]}]]]\)

Report Link Elasticity Tables

Report by Stock

Change the values of the Stock variable (s) to see the corresponding elasticity table.  The table will report the impact of all the reference modes the selected stock and will be sorted by the descending elasticity of the selected reference Mode (m).

s = 1;  m = 3;  
\(\(If[
        z > 0, 
{\(Print["WARNING: Some system eiganvalues=0. Elasticities of weights associated with those eigenvalue are nor reported."];\)
}];\)\)
\(\(Print["Stock: ", \(lev[\([s]\)]\)[\([1]\)], "   Mode: ", \(L[\([idx]\)]\)[\([m]\)]\ ];\)\)
ET = 
        Map[Join[edgelist[[#]], LElas[[#,  All,  s]]] &, 
          Range[Length[edgelist]]];
Print[
      PaddedForm[
        TableForm[
          ET[[Ordering[Abs[ET[[All, 2 + m]]], All, Greater]]], 
          TableHeadings -> {None, 
              Join[{"Input",  "Output"}, Range[Length[idx]]]}], {5, 
          3}]]

Report by Behavior Mode

Change the values of the Mode variable (m) to see the corresponding elasticity table.  The table will report  the impact of the selected reference mode in all stocks and will be sorted by descending elasticity on the selected stock (s).

\(\(\(\ \)\(m = 1; \ s = 3;\ 

    \(If[z > 
          0, 
{\(Print["WARNING: Some system eiganvalues=0. Elasticities of weights associated with those eigenvalue are nor reported."];\)
}];\)

    \(Print["Stock: ", \(lev[\([s]\)]\)[\([1]\)], "   Mode: ", \(L[\([idx]\)]\)[\([m]\)]\ ];\)

    \(ET = 
        Map[Join[edgelist[\([#]\)], LElas[\([#, \ m, \ All]\)]] &, 
          Range[Length[edgelist]]];\)

    Print[
      PaddedForm[
        TableForm[
          ET[\([Ordering[Abs[ET[\([All, 2 + s]\)]], All, Greater]]\)], 
          TableHeadings -> {None, 
              Join[{"Input", \ "Output"}, 
                Table[\(lev[\([i]\)]\)[\([1]\)], {i, Length[lev]}]]}], {5, 
          3}]]\)\)\)

Report with Eigenvalue Elasticity

Change the values of the Stock (s) and Mode variables (m) to see the corresponding elasticity table.  The table will report  the impact of the selected behavior mode in the selected stocks and will be sorted by descending weight elasticity.

m = 1;  s = 3;  
\(\(If[
        z > 0, 
{\(Print["WARNING: Some system eiganvalues=0. Elasticities of weights associated with those eigenvalue are nor reported."];\)
}];\)\)
\(\(Print["Stock: ", \(lev[\([s]\)]\)[\([1]\)], "   Mode: ", \(L[\([idx]\)]\)[\([m]\)]\ ];\)\)
ET = 
        Map[Join[
              edgelist[[#]], {LElas[[#,  m,  s]], 
                LElasER[[#, m]], LElasEI[[#, m]]}] &, 
          Range[Length[edgelist]]];
\(Print[
      PaddedForm[
        TableForm[ET[\([Ordering[Abs[ET[\([All, 3]\)]], All, Greater]]\)], 
          TableHeadings -> {None, 
              Join[{"Input", \ "Output", "Weight", "Re[Eigenvalue]", "Im[Eigenvalue]"}]}]]]\)