0
$\begingroup$

Take the following data:

countryMM = {
{{{0, 0.47, 0.07, 0.07, 0.14},
  {0.38, 0, 0.16, 0.13, 0.23}, 
  {0.29, 0.30, 0, 0.24, 0.35},
  {0.58, 0.39, 0.14, 0, 0.51},
  {0.15, 0.22, 0.06, 0.07, 0}},
{{0, 0.95, 0.30, 0.44, 0.42},
 {0.19, 0, 0.33, 0.40, 0.35},
 {0.07, 0.15, 0, 0.37, 0.26}, 
 {0.09, 0.13, 0.09, 0, 0.25}, 
 {0.05, 0.15, 0.08, 0.15, 0}}},
{{{0, 0.43, 0.06, 0.07, 0.14},
  {0.41, 0, 0.13, 0.13, 0.24},
  {0.30, 0.30, 0, 0.24, 0.37},
  {0.46, 0.32, 0.13, 0, 0.40},
  {0.17, 0.23, 0.06, 0.08, 0}},
 {{0, 0.90, 0.26, 0.45, 0.41},
  {0.19, 0, 0.27, 0.40, 0.34},
  {0.06, 0.14, 0, 0.35, 0.25},
  {0.07, 0.10, 0.09, 0, 0.19},
  {0.05, 0.16, 0.08, 0.16, 0}}}
};

and

priceTransmission = {
{1, 1.9, 1.3, 2.7, 1.5},
{0.4, 1, 0.6, 1.3, 0.7},
{0.7, 1.4, 1, 1.9, 1.1},
{0.3, 0.7, 0.4, 1, 0.5},
{0.6, 1.2, 0.8, 1.7, 1}
};  

marketPower[c1_, c2_, c3_, c4_, c5_, c6_]  
:= { 
     {1, (1+c3), 1, (1+c4), (1+c6)}, 
     {(1+c1), 1, 1, 1, 1}, 
     {1, (1+c2), 1, 1, (1+c6)},
     {(1+c4), (1+c5), (1+c4), 1, (1+c2)},
     {(1+c2), (1+c1), (1+c3), 1, (1+c5)}
   };

sector = 5;
v = {AGF, CO12, MA1, MA2, EGW};
v1 = {1 -> "AGF", 2 -> "CO12", 3 -> "MA1", 4 -> "MA2", 5 -> "EGW"};
v2 = {"AGF", "CO12", "MA1", "MA2", "EGW"};
vLabels = {1 -> AGF, 2 -> CO12, 3 -> MA1, 4 -> MA2, 5 -> EGW};
labelsV = {AGF -> 1, CO12 -> 2, MA1 -> 3, MA2 -> 4, EGW -> 5};

legends = {"[1] AGF: Agriclture/hunting/fishery", "[2] CO12: Crude oil/mining", "[3] MA1: Manufacturing/petroleum refining", "[4] MA2: Manufacturing\[Dash]other", "[5] EGW: Electricity/gas/water supply"};

sectorLegends = {"AGF: Agriclture/hunting/fishery", "CO12: Crude oil/mining", "MA1: Manufacturing/petroleum refining", "MA2: Manufacturing\[Dash]other", "EGW: Electricity/gas/water supply"};

sectorFullNames = { "Agriclture/hunting/fishery", "Crude oil/mining",   "Manufacturing/petroleum refining", "Manufacturing\[Dash]other", "Electricity/gas/water supply"};

indCountry = { "ioMatrix[1]", "ioMatrix[2]"};
listCountry = { {CNT1, Country1}, {CNT2, Country2}};
countries = { "Country 1", "Country 2"};

Table[mpaPriceTrans[i][c1_, c2_, c3_,c4_, c5_, c6_] := marketPower[c1, c2, c3, c4, c5, c6]*priceTransmission, {i,2}];

The above data are used in the following Code:

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}]] &;

MultiplierWeightedTransmission[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[matrixA*matrixB, indices], EdgeLabels -> "EdgeWeight", ##3], {#, #2}]] &;

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]}]] &;

multiplierType = {"Backward Multiplier Matrix", "Forward Multiplier Matrix"};
transType = {UnweightedTransmission, MultiplierWeightedTransmission};
testType = {EdgeBetweennessCentrality, DegreeCentrality};

Manipulate[
Grid[{
{
Legended[
  DecimalForm[  
  gr = transType[[transmissionType]][
  countryMM[[Country, matrixType]], 
  mpaPriceTrans[Country][c1, c2, c3, c4, c5, c6], lowerBound,upperBound][Style[sourceTarget, Green], Style[sinkTarget, Red], VertexLabels -> {v_ :> Placed[v /. vLabels, Center]},       VertexSize -> 0.4, PerformanceGoal -> "Quality", PlotLabel -> "Network of Reform and Impact Sectors", ImageSize -> 300], 2],
 Placed[SwatchLegend[{Green, Red}, {"Sector for policy reform", "Sector for policy impact"}, LegendLayout -> "Row", 
   LabelStyle -> Black, LegendMarkers -> ChartElementData[SwatchLegend][[1]], 
   LegendMarkerSize -> 20], Below]
 ], 
 DecimalForm[ 
 CommunityGraphPlot[gr, ConnectedComponents[gr], 
  CommunityRegionStyle -> LightGray, Method -> "Centrality", 
  ImageSize -> 300, 
  PlotLabel -> "Communities in the Reform-Impact Network"], 2]
},
{
gr = Graph[gr, VertexCoordinates -> GraphEmbedding[gr], 
  ImageSize -> 300];  (*fixes the vertex coordinates of "gr"*)
vRange = SortBy[VertexList[gr], N];
DecimalForm[{gr, VertexDelete[EdgeDelete[gr, IncidenceList[gr, deletedSectors]], {deletedSectors}]}, 2]},
   {
   pathvalue = {Table[
    Times @@ edgeW[gr, sourceTarget, sinkTarget][[i, 2]], {i, 
     Length[edgeW[gr, sourceTarget, sinkTarget]]}]} // Transpose;
  TableForm[
  Table[{{edgeW[gr, sourceTarget, sinkTarget][[i, 1]] /. 
     vLabels}, {pathvalue[[i]]}}, {i, 
   Length[edgeW[gr, sourceTarget, sinkTarget]]}], 
 TableHeadings -> {None, {"Pathway", "Pathway Multiplier"}}],
Table[
  EdgeList[subGraphF[gr, sourceTarget, sinkTarget]][[i]], {i, 
   Ordering[
     testType[[signTestType]][
      subGraphF[gr, sourceTarget, sinkTarget]], -numSignLinks] // 
    Reverse}] /. vLabels,
 TableForm[Transpose@{sectorLegends}, 
  TableHeadings -> {None, {"Sector names"}}]
 }
 }],
 Spacer[30],
 Delimiter,
Style["Country and Type of Multiplier Matrix", Bold, Medium],
{{Country, 1, "Choose a country"}, 
Thread[Range[Length[countries]] -> countries], 
ControlType -> PopupMenu},
{{matrixType, 1, "Choose the type of multiplier matrix"}, 
Thread[Range[Length[multiplierType]] -> multiplierType], 
ControlType -> PopupMenu},
{{transmissionType, 1, "Choose the type of price transmission"}, 
Thread[Range[Length[transType]] -> transType], 
ControlType -> PopupMenu},
Delimiter,
Style["Multiplier Interval", Bold, Medium],
{{lowerBound, 0.01, "Choose a lower bound"}, 0.001, 1, 0.01, 
Appearance -> "Labeled"},
{{upperBound, 0.30, "Choose an upper bound"}, 0.001, 1, 0.01, 
Appearance -> "Labeled"}, 
Delimiter,
Style["Policy Reform-Impact Network and Communities", Bold, Medium], {{sourceTarget, 2, "Choose a sector for policy reform"}, 
Thread[Range[Length[sectorLegends]] -> sectorLegends], 
ControlType -> PopupMenu}, {{sinkTarget, 4, "Choose a sector for policy impact"}, Thread[Range[Length[sectorLegends]] -> sectorLegends], ControlType -> PopupMenu},
Delimiter,
Style["Significant Sectors", Bold, Medium],
{{signTestType, 1, "Choose a significance test type"}, 
Thread[Range[Length[testType]] -> testType], 
ControlType -> PopupMenu}, {{numSignLinks, 1, 
"Choose the number of most significant paths"}, Range[3], 
ControlType -> PopupMenu},
Delimiter,
Style["Significant Sectors", Bold, Medium],
{{deletedSectors, vRange[[1]], 
"Choose a sector to test\n(by removing it from the red network)"}, Thread[vRange -> sectorLegends[[vRange]]], ControlType ->   PopupMenu},
Delimiter,
Style["Market Power Parameters for Upstream-Downstream Sectors", 
Bold, Medium],
{{c1, 0.10, "Case 1"}, 0, 1, 0.05, Appearance -> "Labeled"},
{{c2, 0.20, "Case 2"}, 0, 1, 0.05, Appearance -> "Labeled"},
{{c3, 0.40, "Case 3"}, 0, 1, 0.05, Appearance -> "Labeled"},
{{c4, 0.08, "Case 4"}, 0, 1, 0.05, Appearance -> "Labeled"},
{{c5, 0.06, "Case 5"}, 0, 1, 0.05, Appearance -> "Labeled"},
{{c6, 0.04, "Case 6"}, 0, 1, 0.05, Appearance -> "Labeled"},
FrameLabel -> {{"", ""}, {"", 
Style["Market power-adjusted price transmission network", Larger, 
 Bold, Black]}}
]

This is really the simplest example I could prepare for my question. For a given set of parameters, when I run this Code without using Manipulate, it just works nicely because there is no up and down in parameter setting when Manipulate is used. However, my goal is to run this Manipulate.

  1. vRange is creating trouble. After constructing a graph, I find the vertex list of the graph, and from this list, I want to delete one vertex. (In fact, I want to delete more than one vertex at a time but I could not find the way to do it.) When I choose a vertex to delete using the Control, I receive an error message that vRange does not have the right form. What is wrong with the vRange? I use If statement to pick a feasible vertex from vRange but this If statement does not work either. If the vertex to be deleted is an element of vRange then I want to proceed with the deletion. If not, I just want to Quit with a message saying that it is not feasible.

  2. I want to do the calculations at each step after confirming the calculations done at the earlier stages. For example, after picking a multiplier range in the second Control, I want to know whether the range is empty or not. If empty, then Quite with a message again choose another range. Basically, all the Controls should be confirmed one by one to establish a running Manipulate.

I will stop here because this has been a long question.

$\endgroup$
1
  • $\begingroup$ I have edited my question due to a missing part of the Code. Apologies. Now it should be working for suggestions. $\endgroup$ Aug 9 '20 at 19:36
2
$\begingroup$

Your problem is in the line:

gr = Graph[gr, VertexCoordinates -> GraphEmbedding[gr], ImageSize -> 300];

Just change gr to gr2 in two places (there may be others):

gr2 = Graph[gr, VertexCoordinates -> GraphEmbedding[gr], ImageSize -> 300];
vRange = SortBy[VertexList[gr2], N];

Now your code runs inside the Manipulate without the vRange error. Of course, you still have other errors. The first one I see is that MatrixA is undefined.

Why does this happen? Manipulate is like a big loop construct... it runs the code over and over until nothing changes. If you have a structure like:

var = function[var]

then it will keep changing, perhaps forever.

enter image description here

$\endgroup$
0
$\begingroup$

I copied Your code and started to debug.

a) I entered on another input

vRange

b) I change the Range1 input and undid the change.

c) After each change I reran the code part input.

d) I got that result:

GUI ran correct

e) I changed the GUI selector dropdown field from top to bottom.

f) After changing the dropdown field

warning list abbreviated after interruption, abortion

warning list abbreviated before interruption, abortion

enter image description here

So to me the state of your question shows You are in need of cleaning up the notebook as a preparation for the next run. And than take care each input line is excuteted.

There is some help in debugging possible from mathematica.stackexchange.com. For example

This very large. Bugtracking is harder than programming.

StateInspector[]

working with upvalues and downvalues with

You see by this investigation Your project is already really very huge. The analysis stopps my iMac with 8 GB form performing nicely at this stage.

Since this seeme to be a well design GUI and well though of background logic there is chance that my advice already suffices to reach a well operating state.

$\endgroup$
1
  • $\begingroup$ You have checked the Code thoroughly, and I can understand it up to a point but then I am lost because I do not know how to go on. I can get a full answer from the Code if I run it without using Manipulate. The Code does not have a problem at individual commands. But the vRange in the Control panel needs to update itself when I change the dimension of the directed graph. I am positive that if I can manage to make vRange a Dynamic variable then it will work because the Code works without Manipulate. $\endgroup$ Aug 13 '20 at 19:50

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.