1
$\begingroup$

REVISED Question:

My only request is to know how to monitor the evolution of {agentStates, steps} in simulateSlow[...] function. In particular, how can I insert Monitor[Nest[...], StepMonitor :> Print[{agentStates, steps}] in simulateSlow[...]? All other questions should be ignored.

I keep the original question for those interested in such problems.

ORIGINAL Question:

My goal is to link a contagion network model (by Christopher Wolfram) to the evolution of an endogenous system. The following contagion model (originally developed for undirected graphs) assumes a directed network.

1. Contagion model as a directed graph

ClearAll[g, agentNeighborhoods, neighbors, meetingCounts, recoveryTime, agentStates, meetings];

SeedRandom[49];
g = RandomGraph[{10, 30}, DirectedEdges -> True, 
   VertexLabels -> "Name"];
agentNeighborhoods[g_] := 
  Merge[Catenate[{#1 -> #2} & @@@ EdgeList[g]], Identity];
neighbors = agentNeighborhoods[g]
meetingCounts = 
  AssociationThread[Keys[neighbors], ExponentialDistribution[2]];
recoveryTime = ExponentialDistribution[1/5];
agentStates = Join[
  AssociationThread[Keys[neighbors], "S"],
  AssociationMap[{"I", Floor@RandomVariate[recoveryTime]} &, 
   RandomSample[Keys[neighbors], 2]]  (*two sectors start inflicted*)
  ]
meetings = DeleteDuplicatesBy[
  Flatten[
   Function[a,
     {a, #} & /@
      RandomSample[
       neighbors[a],
       Clip[
        Round[RandomVariate[meetingCounts[a]]], {0, 
         Length[neighbors[a]]}]]
     ] /@ Keys[neighbors],
   1], Sort
  ]

The important outputs from the above code are threefold. The first output gives a complete list of directed edges from a vertex in directed graph g. For example, 1->{2,3,8} states that vertex 1 has three directed edges as {1->2, 1->3, 1->8} and so on. We obtain a complete list of directed edges in graph g.

enter image description here

The second output randomly assigns a state to each vertex from a set of three states, {S, I, R}. For example, vertex 1 and 2 are assigned state S. Vertex 4 is assigned state {I, 7}, implying that vertex 4 is in state I and remains in that state for 7 simulation steps, after which it recovers back to the original state S.

enter image description here

The third output gives a randomly selected 3 directed edges to start the contagion process. For example, three directed edges, 1->2, 7->6, 10->6, are randomly selected to start the simulation process.

enter image description here

The following simulation code starts with the above randomly selected three directed edges.

SeedRandom[49];
runStep[agentStates_, neighbors_, meetingCounts_, recoveryTime_] :=
  Module[
   {meetings, agentMeetings},
    meetings =
            DeleteDuplicatesBy[Flatten[
                Function[a,
                        {a, #} & /@
                            RandomSample[neighbors[a],
                                
          Clip[Round[RandomVariate[meetingCounts[a]]], {0, 
            Length[neighbors[a]]}]]
                    ] /@ Keys[neighbors],
                1],
            Sort];
    agentMeetings = 
    Merge[Catenate[{#1 -> #2} & @@@ meetings], Identity];  
        AssociationMap[
            Replace[agentStates[#], {
                "S" :> If[
                        
         MemberQ[Lookup[agentStates, agentMeetings[#]], {"I", _}],
                        {"I", RandomVariate[recoveryTime]},
                        "S"],
                {"I", n_} :> If[n > 0, {"I", n - 1}, "R"],
                "R" -> "R"
            }] &,
        Keys[agentStates]]
   ];

simulateSlow[neighbors_, meetingCounts_, recoveryTime_, 
   initialInfected_, maxSteps_ : Infinity] :=
  Module[
   {agentStates, steps},
    agentStates = Join[
            AssociationMap["S" &, Keys[neighbors]],
            AssociationMap[{"I", RandomVariate[recoveryTime]} &, 
      RandomSample[Keys[neighbors], initialInfected]]
        ];
    steps = NestWhileList[
            runStep[#, neighbors, meetingCounts, recoveryTime] &,
            agentStates,
            MemberQ[{"I", _}],
            1,
            maxSteps
        ];
    {Count[#, {"I", _}], Count[#, "S"], Count[#, "R"]} & /@ steps
   ];

output = 
 simulateSlow[neighbors, meetingCounts, recoveryTime, 2, Infinity]

Generates the following triples presented as a stacked plot:

enter image description here

 StackedListPlot[Transpose[output], 
 Frame -> {{True, False}, {True, False}}, 
 FrameLabel -> {"number of domino steps", "number of banks"}]

enter image description here

The output triples above need to be linked to the following endogenous system to observe the changes in this system when the directed network experiences a change. As seen from the sequence of triples, the number of vertices with different states continuously changes as the simulation progresses until no vertex is inflicted any more. The question is what happens to the endogenous system dynamics as the changes in the contagion model progress. The question boils down to the linking the triples to the data framework given below.

2. An endogenous system to be linked to the above contagion model.

A randomly generated data framework represents the endogenous system concerned.

ClearAll[assets, interLoan, interBorrow, borrowings, deposits, 
  capital, data, header, ds, bSheet];

SeedRandom[49];
simpleGraph[m_] := m - DiagonalMatrix[Diagonal[m]];
(assets = RandomInteger[{25, 100}, 10]) // MatrixForm;
(interLoan = simpleGraph[RandomInteger[{50, 10}, {10, 10}]]) // 
  MatrixForm;
(interBorrow = simpleGraph[RandomInteger[{50, 10}, {10, 10}]]) // 
  MatrixForm;
(borrowings = RandomInteger[{25, 100}, 10]) // MatrixForm;
(deposits = RandomInteger[{25, 100}, 10]) // MatrixForm;
(capital = RandomInteger[{200, 500}, 10]) // MatrixForm;

data = {Range[10], assets, interLoan, interBorrow, borrowings, 
   deposits, capital};
header = {"banks", "assets", "interLoan", "interBorrow", "borrowings",
    "deposits", "capital"};
ds = Dataset@Map[AssociationThread[header, #] &]@Transpose[data];

Using this data framework, I calculate the following:

ClearAll[bSheet, newCapital, newAssets, pNewCapital, pNewAssets];

bSheet = Thread[
   Table[ds@Query[i, "banks"], {i, 10}] -> Table[
     {ds@
       Query[i, "assets"], (ds@Query[i, "interLoan"] // 
        Normal), (ds@Query[i, "interBorrow"] // Normal), 
      ds@Query[i, "borrowings"], ds@Query[i, "deposits"], 
      ds@Query[i, "capital"]}, {i, 10}
     ]
   ];

newCapital = 
 Table[(bSheet[[i]][[2, 6]] - bSheet[[i]][[2, 2, 3]]), {i, 10}]
newAssets = 
 Table[(bSheet[[i]][[2, 1]] + Total@bSheet[[i]][[2, 2]] - 
    bSheet[[i]][[2, 2, 3]]), {i, 10}]

pNewCapital = ListLinePlot[
   newCapital,
   Joined -> True,
   PlotStyle -> Blue,
   ImagePadding -> 25,
   Frame -> {True, True, True, False},
   FrameStyle -> {Automatic, Blue, Automatic, Automatic}
   ];
pNewAssets = ListLinePlot[
   newAssets,
   Joined -> True,
   PlotStyle -> Red,
   Axes -> False,
   ImagePadding -> 25,
   Frame -> {False, False, False, True},
   FrameTicks -> {None, None, None, All},
   FrameStyle -> {Automatic, Automatic, Automatic, Red}
   ];

Labeled[
 Overlay[{pNewCapital, pNewAssets}],
 Style[#, 14, #2, ShowStringCharacters -> False] & @@@ 
  Transpose[{{Rotate["New capital", 90 Degree], 
     Rotate["New assets", 90 Degree], "Banks"}, {Blue, Red, 
     Black}}], {Left, Right, Bottom}
 ]

enter image description here

This figure is not yet linked to the contagion model. How can I link the output triples to the data framework presented above and observe the changes in the endogenous system as soon as the contagion model goes through some changes.

The final output should have two figures: a stacked plot of the contagion model and the two-y axes plot placed adjacent to each other. The best presentation would be a single stacked plot including the outputs from both the contagion model and the endogenous system.

3. Linking the contagion model with the data framework

Specifically, the model should be linked to the dataset ds through vertices in the directed graph g. Characteristics of vertex i in g are given in the i-th row in ds. Whenever vertex i is infected, then the bank characterized by the i-th row in ds experiences changes in its assets and capital. Such changes are assumed to take place only in state I (infection). Other states have no bearing on the characteristics of the vertex concerned.

$\endgroup$
8
  • 1
    $\begingroup$ This is a big post with a lot of code, discussion, and a lot of domain specific points. Can you point out specific problems you're having? I don't really understand what you mean by 'link' here. If you need to observe changing state, consider Monitor or Dynamic. $\endgroup$
    – flinty
    Commented Dec 30, 2023 at 20:11
  • $\begingroup$ @flinty: In fact, the only thing I want to know is to Monitor the changes in the triples. The linking means to observe the changes in the data framework whenever the contagion model changes its triples. A specific question is then how can I monitor the changes in the triples? Once I know the changes in the triples (i.e., vertices experiencing the changing states), then using the changing states of vertices I can make computations using the data framework. Thanks for reminding me Monitor, which I did not know. $\endgroup$ Commented Dec 30, 2023 at 21:51
  • $\begingroup$ @flinty: How can I monitor the change in a triple? For example, concerning a change from {2, 6, 1} to {2, 5, 2}, I need to first know which sectors in the former triple are in state I (2) and which ones are in S (6) and which ones are in R (1). Likewise, regarding the latter triple, I need to know the same information so that I can make some computations using the data framework. $\endgroup$ Commented Dec 30, 2023 at 22:08
  • 1
    $\begingroup$ Check the documentation of "Dynamic` and related functions. $\endgroup$
    – bbgodfrey
    Commented Dec 31, 2023 at 2:44
  • 1
    $\begingroup$ Try evaluating Dynamic[{agentStates, steps}] in a separate cell and watching that evolve during your computation. $\endgroup$ Commented Dec 31, 2023 at 12:52

1 Answer 1

1
$\begingroup$

Thanks to the comments received, I now have an answer to my question.

The following code has been adjusted as follows:

simulateSlow[neighbors_, meetingCounts_, recoveryTime_, 
   initialInfected_, maxSteps_ : Infinity] :=
  Module[
   {agentStates, steps},
   agentStates = Join[
            AssociationMap["S" &, Keys[neighbors]],
            AssociationMap[{"I", RandomVariate[recoveryTime]} &, 
      RandomSample[Keys[neighbors], initialInfected]]
        ];
   steps = NestWhileList[
            runStep[#, neighbors, meetingCounts, recoveryTime] &,
            agentStates,
            MemberQ[{"I", _}],
            1,
            maxSteps
        ];
   {
    {Count[#, {"I", _}], Count[#, "S"], Count[#, "R"]}, 
    {runStep[#, neighbors, meetingCounts, recoveryTime]}
   }&/@steps (*`This line gives what I was after`*)
   ];
$\endgroup$

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.