0
$\begingroup$

I have the following code which serves my purpose for a single matrix input. For one or two matrices, the operation can be done manually, but I have 65 matrices and need to run the same code for all of the 65 matrices and keep each output with an index name.

ClearAll[vLabels, legends];
<< IGraphM`;
<< BoolEval`;
SeedRandom[13];
a1=RandomReal[{0.1, 0.5}, {10, 10}];
vLabels = {1 -> A1, 2 -> B1, 3 -> C1, 4 -> D1, 5 -> E1, 6 -> F1, 
     7 -> G1, 8 -> J1, 9 -> K1, 10 -> L1};
legends = {"AGF","CO12","MA1","MA2","EGW","WHS","HOT","TSC","FIN","EST"};
selectBetweenCRI[θ1_, θ2_] := 
BoolEval[θ1 <= a1 < θ2];
subgraphBetweenCRI[θ1_, θ2_] := 
AdjacencyGraph[selectBetweenCRI[θ1, θ2], 
  PlotLabel -> θ1 <= Subscript[m, ij] < θ2, 
  VertexSize -> 0.3, VertexLabels -> vLabels, ImagePadding -> 20, 
  ImageSize -> 150];
{
{"CRI_Weighted index of total number of links", 
 Sum[ θ1*
    EdgeCount[subgraphBetweenCRI[θ1, Max[a1]]], {θ1, 0, 
    Max[a1], 0.01}]},
ListLinePlot[
Table[{θ1, θ1*
    EdgeCount[subgraphBetweenCRI[θ1, Max[a1]]]}, {θ1, 
    0, Max[a1], 0.01}], 
AxesLabel -> {"Threshold \nmultiplier: \\!\(\*SubscriptBox[\(θ\), \(CRI\)]\)", "Weighted index \nof linkages: I(\!\(\*SubscriptBox[\(θ\), \\(CRI\)]\))"}]
 }

I tried the following but I am stuck with it:

ClearAll[vLabels, make, a1, a2, a3, a4, a5, a6, selectBetween, 
 subgraphBetween];
SeedRandom[13];
vLabels = {1 -> A1, 2 -> B1, 3 -> C1, 4 -> D1, 5 -> E1, 6 -> F1, 
   7 -> G1, 8 -> J1, 9 -> K1, 10 -> L1};
make[] := RandomReal[{0.1, 0.5}, {10, 10}];
{a1, a2, a3, a4, a5, a6} = {make[], make[], make[], make[], make[], 
  make[]};

selectBetween[m_?MatrixQ, θ1_, θ2_] := 
   BoolEval[θ1 <= m < θ2];
subgraphBetween[m_?MatrixQ, θ1_, θ2_] := 
   AdjacencyGraph[selectBetween[m, θ1, θ2], 
   PlotLabel -> θ1 <= Subscript[m, ij] < θ2, 
   VertexSize -> 0.3, VertexLabels -> vLabels, ImagePadding -> 20, 
   ImageSize -> 150];
sum[m_?MatrixQ, θ1_, θ2_] := 
Sum[ θ1*
EdgeCount[subgraphBetween[m, θ1, θ2]], {θ1, 
0.1, θ2, 0.01}];

ListLinePlot[
  Table[{θ1, θ1*
  EdgeCount[subgraphBetween[m, θ1, θ2]]}, {θ1, 
  0, θ2, 0.01}]]

UPDATE

This generates the result I want, but I think there is a more elegant way to do this.

<< IGraphM`;
<< BoolEval`;

SeedRandom[13];
vLabels = {1 -> AGF, 2 -> CO12, 3 -> MA1, 4 -> MA2, 5 -> EGW, 
   6 -> CST, 7 -> WHS, 8 -> HOT, 9 -> TSC, 10 -> FIN};
legends = {AGF, CO12, MA1, MA2, EGW, CST, WHS, HOT, TSC, FIN};

make[] := RandomReal[{0.1, 0.5}, {10, 10}];
{a1, a2, a3, a4, a5, a6} = {make[], make[], make[], make[], make[], 
  make[]};

{
out[#]= {
selectBetweenCRI[\[Theta]1_, \[Theta]2_] := 
BoolEval[\[Theta]1 <= # < \[Theta]2];
subgraphBetweenCRI[\[Theta]1_, \[Theta]2_] := 
AdjacencyGraph[selectBetweenCRI[\[Theta]1, \[Theta]2],
  PlotLabel -> \[Theta]1 <= Subscript[m, ij] < \[Theta]2, 
  VertexSize -> 0.3, VertexLabels -> vLabels, ImagePadding -> 20, 
  ImageSize -> 150];

{
  {"CRI_Weighted index of total number of links", 
  Sum[ \[Theta]1*
   EdgeCount[
    subgraphBetweenCRI[\[Theta]1, Max[mmCRI]]], {\[Theta]1, 0, 
   Max[mmCRI], 0.01}]},
sectorCRI = {legends, 
     Sum[\[Theta]1*
       DegreeCentrality[
        subgraphBetweenCRI[\[Theta]1, Max[mmCRI]]], {\[Theta]1, 0,
        Max[mmCRI], 0.01}]}\[Transpose] // Reverse // TableForm,
ListLinePlot[
 Table[{\[Theta]1, \[Theta]1*
    EdgeCount[
     subgraphBetweenCRI[\[Theta]1, Max[mmCRI]]]}, {\[Theta]1, 0, 
   Max[mmCRI], 0.01}], 
 AxesLabel -> {"Threshold \nmultiplier: \!\(\*SubscriptBox[\(\
 \[Theta]\), \(CRI\)]\)", 
   "Weighted index \nof linkages: I(\!\(\*SubscriptBox[\(\[Theta]\
 \), \(CRI\)]\))"}]
 }
 }} & /@ {a1, a2, a3, a4, a5, a6}
$\endgroup$
  • $\begingroup$ @Mr.Wizard: To reduce the work of the Community Expert like you, editing my questions, I like to know how you inserted θ1 in place of \Theta alike. Can you tell me how you replaced these terms? $\endgroup$ – Tugrul Temel Jan 23 at 18:18
  • 6
    $\begingroup$ If you are using Chrome then use this $\endgroup$ – Rohit Namjoshi Jan 23 at 18:26
  • $\begingroup$ @Rohit: I did not understand what you meant. I went to the link you refer to but then wht should I do? $\endgroup$ – Tugrul Temel Jan 23 at 18:47
  • 2
    $\begingroup$ It is a Chrome extension. Add it to Chrome from the link and buttons will appear on the top left of the "Ask Question" and "Answer" forms. More details here. $\endgroup$ – Rohit Namjoshi Jan 23 at 18:53
  • 2
    $\begingroup$ halirutan's buttons extension is available for other browsers as well, like Firefox. $\endgroup$ – Mr.Wizard Jan 24 at 1:58
1
$\begingroup$
ClearAll[foo]
foo = Module[{mat = #, max = Max[#], legends = #2, vlabels = Thread[Range[Length@#] -> #2], 
      subgraphBetweenCRI, wecnt, windex, degcent, llp}, 
    subgraphBetweenCRI = AdjacencyGraph[UnitStep[mat - #] (1 - UnitStep[mat - #2])] &;
    wecnt = #*EdgeCount[subgraphBetweenCRI[#, max]] &;
    windex = Sum[wecnt[t], {t, 0, max, 0.01}];
    degcent = Sum[t*DegreeCentrality[subgraphBetweenCRI[t, max]], {t, 0, max,  0.01}];
    llp = ListLinePlot[Table[{t, wecnt[t]}, {t, 0, max, 0.01}], 
      AxesLabel -> {"Threshold \nmultiplier:" <> 
         ToString[Subscript[\[Theta], CRI], StandardForm], 
        "Weighted index \nof linkages: " <> 
         ToString[ Subscript[I\[Theta], CRI], StandardForm]}];
    {{"CRI_Weighted index of total number of links", windex},
     TableForm@Reverse@Transpose[{legends, degcent}], llp}] &;

Examples:

SeedRandom[13];
vLabels = {1 -> AGF, 2 -> CO12, 3 -> MA1, 4 -> MA2, 5 -> EGW, 
   6 -> CST, 7 -> WHS, 8 -> HOT, 9 -> TSC, 10 -> FIN};
legends = {AGF, CO12, MA1, MA2, EGW, CST, WHS, HOT, TSC, FIN};

matrixlist = {a1, a2, a3, a4, a5, a6} = RandomReal[{0.1, 0.5}, {6, 10, 10}];


foo[a2, legends]

enter image description here

foo[#, legends] & /@ matrixlist // Short

enter image description here

|improve this answer|||||
$\endgroup$
  • $\begingroup$ I have to correct myself, very sorry. subgraphBetweenCRI should be subgraphBetween everywhere in foo[...] and after this correction, when I use matrix a2, for example, in foo[a2, legends], the subscript CRI should be automatically replaced with matrix name a2. This would produce a completely defined output, which you have already produced. Thank you very much $\endgroup$ – Tugrul Temel Jan 24 at 1:18
0
$\begingroup$

This is my answer to my own question, but still, I am not satisfied with it because I cannot give an index name for each matrix in out[...].

out[m_?MatrixQ] := {
   selectBetween[\[Theta]1_, \[Theta]2_] := BoolEval[\[Theta]1 <= m < \[Theta]2];
   subgraphBetween[\[Theta]1_, \[Theta]2_] := 
      AdjacencyGraph[selectBetween[\[Theta]1, \[Theta]2],
      PlotLabel -> \[Theta]1 <= Subscript[m, ij] < \[Theta]2, 
      VertexSize -> 0.3, VertexLabels -> vLabels, ImagePadding -> 20, 
      ImageSize -> 150];
{
  {"Weighted index of total number of links", 
  Sum[ \[Theta]1*EdgeCount[subgraphBetween[\[Theta]1, Max[m]]], {\[Theta]1, 0, 
   Max[m], 0.01}]},
  sectorCRI = {legends, Sum[\[Theta]1*
       DegreeCentrality[subgraphBetween[\[Theta]1, Max[m]]], {\[Theta]1, 0, 
       Max[m], 0.01}]}\[Transpose] // Reverse // TableForm,
  ListLinePlot[Table[{\[Theta]1, \[Theta]1*
    EdgeCount[subgraphBetween[\[Theta]1, Max[m]]]}, {\[Theta]1, 0,
    Max[m], 0.01}], 
  AxesLabel -> {"Threshold \nmultiplier: \!\(\*SubscriptBox[\(\
    \[Theta]\), \(CRI\)]\)", 
   "Weighted index \nof linkages: I(\!\(\*SubscriptBox[\(\[Theta]\
   \), \(CRI\)]\))"}]
  }
 };
|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.