Creating an animated graph model based on equations

Question

So I have a graph that looks like this

graph = Graph[{"Russia" \[DirectedEdge] "Crimea", "Russia" \[DirectedEdge]"Donetsk", "Russia" \[DirectedEdge] "Luhansk", "Russia" \[DirectedEdge] "Kharkiv", "Russia" \[DirectedEdge] "Sumy", "Russia" \[DirectedEdge] "Chernihiv", "Crimea" \[DirectedEdge] "Kherson", "Donetsk" \[DirectedEdge] "Luhansk", "Luhansk" \[DirectedEdge] "Donetsk", "Luhansk" \[DirectedEdge] "Kharkiv", "Kharkiv" \[DirectedEdge] "Luhansk", "Kharkiv" \[DirectedEdge] "Sumy", "Sumy" \[DirectedEdge] "Kharkiv","Sumy" \[DirectedEdge] "Chernihiv", "Chernihiv" \[DirectedEdge] "Sumy", "Donetsk" \[DirectedEdge] "Kharkiv", "Kharkiv" \[DirectedEdge] "Donetsk", "Kherson" \[DirectedEdge] "Zaporizhzhya", "Zaporizhzhya" \[DirectedEdge] "Kherson", "Zaporizhzhya" \[DirectedEdge] "Donetsk", "Donetsk" \[DirectedEdge] "Zaporizhzhya", "Kherson" \[DirectedEdge] "Dnipropetrovsk", "Dnipropetrovsk" \[DirectedEdge] "Kherson", "Dnipropetrovsk" \[DirectedEdge] "Zaporizhzhya", "Zaporizhzhya" \[DirectedEdge] "Dnipropetrovsk", "Dnipropetrovsk" \[DirectedEdge] "Donetsk", "Donetsk" \[DirectedEdge] "Dnipropetrovsk", "Dnipropetrovsk" \[DirectedEdge] "Kharkiv", "Kharkiv" \[DirectedEdge] "Dnipropetrovsk", "Kherson" \[DirectedEdge] "Crimea", "Dnipropetrovsk" \[DirectedEdge] "Poltava", "Poltava" \[DirectedEdge] "Dnipropetrovsk", "Poltava" \[DirectedEdge] "Kharkiv", "Kharkiv" \[DirectedEdge] "Poltava", "Poltava" \[DirectedEdge] "Sumy", "Sumy" \[DirectedEdge] "Poltava","Poltava" \[DirectedEdge] "Chernihiv", "Chernihiv" \[DirectedEdge] "Poltava", "Chernihiv" \[DirectedEdge] "Kiev", "Kiev" \[DirectedEdge] "Chernihiv", "Kiev" \[DirectedEdge] "Cherkassy", "Cherkassy" \[DirectedEdge] "Kiev", "Cherkassy" \[DirectedEdge] "Kirovohrad", "Kirovohrad" \[DirectedEdge] "Cherkassy", "Kiev" \[DirectedEdge] "Poltava", "Poltava" \[DirectedEdge] "Kiev","Poltava" \[DirectedEdge] "Cherkassy", "Cherkassy" \[DirectedEdge] "Poltava", "Kirovohrad" \[DirectedEdge] "Poltava", "Poltava" \[DirectedEdge] "Kirovohrad", "Kirovohrad" \[DirectedEdge] "Dnipropetrovsk", "Dnipropetrovsk" \[DirectedEdge] "Kirovohrad", "Kirovohrad" \[DirectedEdge] "Mykolayiv", "Mykolayiv" \[DirectedEdge] "Kirovohrad", "Mykolayiv" \[DirectedEdge] "Dnipropetrovsk", "Dnipropetrovsk" \[DirectedEdge] "Mykolayiv", "Mykolayiv" \[DirectedEdge] "Kherson", "Kherson" \[DirectedEdge] "Mykolayiv", "Mykolayiv" \[DirectedEdge] "Odessa", "Odessa" \[DirectedEdge] "Mykolayiv", "Odessa" \[DirectedEdge] "Kirovohrad", "Kirovohrad" \[DirectedEdge] "Odessa", "Odessa" \[DirectedEdge] "Vinnytsia", "Vinnytsia" \[DirectedEdge] "Odessa", "Vinnytsia" \[DirectedEdge] "Kirovohrad", "Kirovohrad" \[DirectedEdge] "Vinnytsia", "Vinnytsia" \[DirectedEdge] "Cherkassy", "Cherkassy" \[DirectedEdge] "Vinnytsia", "Vinnytsia" \[DirectedEdge] "Kiev", "Kiev" \[DirectedEdge] "Vinnytsia", "Vinnytsia" \[DirectedEdge] "Zhytomyr", "Zhytomyr" \[DirectedEdge] "Vinnytsia", "Zhytomyr" \[DirectedEdge] "Kiev", "Kiev" \[DirectedEdge] "Zhytomyr", "Vinnytsia" \[DirectedEdge] "Khmelnytsky", "Khmelnytsky" \[DirectedEdge] "Vinnytsia", "Khmelnytsky" \[DirectedEdge] "Zhytomyr", "Zhytomyr" \[DirectedEdge] "Khmelnytsky", "Khmelnytsky" \[DirectedEdge] "Rivne", "Rivne" \[DirectedEdge] "Khmelnytsky", "Rivne" \[DirectedEdge] "Zhytomyr", "Zhytomyr" \[DirectedEdge] "Rivne", "Vinnytsia" \[DirectedEdge] "Chernivtsi", "Chernivtsi" \[DirectedEdge] "Vinnytsia", "Chernivtsi" \[DirectedEdge] "Khmelnytsky", "Khmelnytsky" \[DirectedEdge] "Chernivtsi", "Chernivtsi" \[DirectedEdge] "Ternopil", "Ternopil" \[DirectedEdge] "Chernivtsi", "Ternopil" \[DirectedEdge] "Khmelnytsky", "Khmelnytsky" \[DirectedEdge] "Ternopil", "Ternopil" \[DirectedEdge] "Rivne", "Rivne" \[DirectedEdge] "Ternopil", "Rivne" \[DirectedEdge] "Lutsk", "Lutsk" \[DirectedEdge] "Rivne", "Lutsk" \[DirectedEdge] "Lviv", "Lviv" \[DirectedEdge] "Lutsk", "Lviv" \[DirectedEdge] "Ternopil", "Ternopil" \[DirectedEdge] "Lviv", "Lviv" \[DirectedEdge] "Ivano-Frankivsk", "Ivano-Frankivsk" \[DirectedEdge] "Lviv", "Ivano-Frankivsk" \[DirectedEdge] "Ternopil", "Ternopil" \[DirectedEdge] "Ivano-Frankivsk", "Ivano-Frankivsk" \[DirectedEdge] "Chernivtsi", "Chernivtsi" \[DirectedEdge] "Ivano-Frankivsk", "Ivano-Frankivsk" \[DirectedEdge] "Uzhgorod", "Uzhgorod" \[DirectedEdge] "Ivano-Frankivsk", "Uzhgorod" \[DirectedEdge] "Lviv", "Lviv" \[DirectedEdge] "Uzhgorod"}, VertexLabels -> "Name", ImagePadding -> 10]

Then I did so

trans = Transpose[Normal[AdjacencyMatrix[graph]]];
Total[Normal[AdjacencyMatrix[graph]]];
input = Table[0, {l, 1, 27}]; (input[[#]] = 1) & /@ Position[Total[Normal[AdjacencyMatrix[graph]]], 0] // Flatten; input

{1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}

Coloured it in

grr = Graphics[{Red, PointSize[0.05], Point[{0, 0}]}];
grg = Graphics[{Green, PointSize[0.05], Point[{0, 0}]}];
AdjacencyGraph[Transpose[trans], ImageSize -> Medium,
  VertexStyle -> Table[i -> If[input[[i]] == 1, Red, Green], {i, 1, 26}]]

Now I want to find a way to animate my graph. I want to attach a system of differential equations to each node and I want each node to turn Red (or stay Green) depending on whether the x comes out victorious or y (after say t amount of time) in say the following differential equations:

eqns = {x'[t] == a*y[t] - b*x[t], y'[t] == c*x[t] - d*y[t],x[0] == 60937, y[0] == 13797};

Where c = (1-a) and d = (1-b) and a and b are constants, but are different for each individual node (or element). How would I do this?

a would be

{{"Crimea", 0.77}, {"Cherkassy", 0.067}, {"Chernihiv",0.103}, {"Chernivtsi",0.053}, {"Dnipropetrovsk", 0.32}, {"Donetsk", 0.749}, {"Ivano-Frankivsk", 0.018}, {"Kharkiv",0.443}, {"Kherson", 0.249}, {"Khmelnytskyi", 0.041}, {"Kirovohrad",0.035}, {"Kiev", 0.072}, {"Luhansk", 0.688}, {"Lviv", 0.038}, {"Mykolaiv", 0.293}, {"Odessa", 0.419}, {"Poltava",0.095}, {"Rivne", 0.027}, {"Sumy", 0.156}, {"Ternopil",0.012}, {"Vinnytsia", 0.047}, {"Lutsk", 0.025}, {"Zakarpattia",0.029}, {"Zaporizhzhya", 0.482}, {"Zhytomyr", 0.066}};

b would be

{{"Zhytomyr", 0}, {"Zaporizhzhya", 0.003}, {"Zakarpattia",0}, {"Lutsk", 0.008}, {"Vinnytsia", 0.001}, {"Ternopil",0.008}, {"Sumy", 0.006}, {"Rivne", 0.004}, {"Poltava",0.002}, {"Odessa", 0.021}, {"Mykolaiv", 0}, {"Lviv", 0.040}, {"Luhansk", 0.035}, {"Kiev", 0.622}, {"Kirovohrad", 0.001}, {"Khmelnytskyi", 0.002}, {"Kherson", 0.004}, {"Kharkiv",0.077}, {"Ivano-Frankivsk", 0.018}, {"Donetsk",0.127}, {"Dnipropetrovsk", 0.014}, {"Chernivtsi", 0.005}, {"Chernihiv", 0.002}, {"Cherkassy", 0.001}, {"Crimea",0.658}};

For each element.

Answer 1

Here is an updated version where I changed a few names in order to get coordinates:

• "Russia" -> "Moscow"
• "Crimea" -> "Sevastopol"
• "Vinnytsia" -> "Vinnytsya"
• "Khmelnytsky" -> "Khmelnytskyi".

Code:

(* variables *)
list = {"Moscow" -> "Sevastopol", "Moscow" -> "Donetsk", "Moscow" -> "Luhansk", "Moscow" -> "Kharkiv", "Moscow" -> "Sumy", "Moscow" -> "Chernihiv", "Sevastopol" -> "Kherson", "Donetsk" -> "Luhansk", "Luhansk" -> "Donetsk", "Luhansk" -> "Kharkiv", "Kharkiv" -> "Luhansk", "Kharkiv" -> "Sumy", "Sumy" -> "Kharkiv", "Sumy" -> "Chernihiv", "Chernihiv" -> "Sumy", "Donetsk" -> "Kharkiv", "Kharkiv" -> "Donetsk", "Kherson" -> "Zaporizhzhya", "Zaporizhzhya" -> "Kherson", "Zaporizhzhya" -> "Donetsk", "Donetsk" -> "Zaporizhzhya", "Kherson" -> "Dnipropetrovsk", "Dnipropetrovsk" -> "Kherson", "Dnipropetrovsk" -> "Zaporizhzhya", "Zaporizhzhya" -> "Dnipropetrovsk", "Dnipropetrovsk" -> "Donetsk", "Donetsk" -> "Dnipropetrovsk", "Dnipropetrovsk" -> "Kharkiv", "Kharkiv" -> "Dnipropetrovsk", "Kherson" -> "Sevastopol", "Dnipropetrovsk" -> "Poltava", "Poltava" -> "Dnipropetrovsk", "Poltava" -> "Kharkiv", "Kharkiv" -> "Poltava", "Poltava" -> "Sumy", "Sumy" -> "Poltava", "Poltava" -> "Chernihiv", "Chernihiv" -> "Poltava", "Chernihiv" -> "Kiev", "Kiev" -> "Chernihiv", "Kiev" -> "Cherkassy", "Cherkassy" -> "Kiev", "Cherkassy" -> "Kirovohrad", "Kirovohrad" -> "Cherkassy", "Kiev" -> "Poltava", "Poltava" -> "Kiev", "Poltava" -> "Cherkassy", "Cherkassy" -> "Poltava", "Kirovohrad" -> "Poltava", "Poltava" -> "Kirovohrad", "Kirovohrad" -> "Dnipropetrovsk", "Dnipropetrovsk" -> "Kirovohrad", "Kirovohrad" -> "Mykolayiv", "Mykolayiv" -> "Kirovohrad", "Mykolayiv" -> "Dnipropetrovsk", "Dnipropetrovsk" -> "Mykolayiv", "Mykolayiv" -> "Kherson", "Kherson" -> "Mykolayiv", "Mykolayiv" -> "Odessa", "Odessa" -> "Mykolayiv", "Odessa" -> "Kirovohrad", "Kirovohrad" -> "Odessa", "Odessa" -> "Vinnytsya", "Vinnytsya" -> "Odessa", "Vinnytsya" -> "Kirovohrad", "Kirovohrad" -> "Vinnytsya", "Vinnytsya" -> "Cherkassy", "Cherkassy" -> "Vinnytsya", "Vinnytsya" -> "Kiev", "Kiev" -> "Vinnytsya", "Vinnytsya" -> "Zhytomyr", "Zhytomyr" -> "Vinnytsya", "Zhytomyr" -> "Kiev", "Kiev" -> "Zhytomyr", "Vinnytsya" -> "Khmelnytskyi", "Khmelnytskyi" -> "Vinnytsya", "Khmelnytskyi" -> "Zhytomyr", "Zhytomyr" -> "Khmelnytskyi", "Khmelnytskyi" -> "Rivne", "Rivne" -> "Khmelnytskyi", "Rivne" -> "Zhytomyr", "Zhytomyr" -> "Rivne", "Vinnytsya" -> "Chernivtsi", "Chernivtsi" -> "Vinnytsya", "Chernivtsi" -> "Khmelnytskyi", "Khmelnytskyi" -> "Chernivtsi", "Chernivtsi" -> "Ternopil", "Ternopil" -> "Chernivtsi", "Ternopil" -> "Khmelnytskyi", "Khmelnytskyi" -> "Ternopil", "Ternopil" -> "Rivne", "Rivne" -> "Ternopil", "Rivne" -> "Lutsk", "Lutsk" -> "Rivne", "Lutsk" -> "Lviv", "Lviv" -> "Lutsk", "Lviv" -> "Ternopil", "Ternopil" -> "Lviv", "Lviv" -> "Ivano-Frankivsk", "Ivano-Frankivsk" -> "Lviv", "Ivano-Frankivsk" -> "Ternopil", "Ternopil" -> "Ivano-Frankivsk", "Ivano-Frankivsk" -> "Chernivtsi", "Chernivtsi" -> "Ivano-Frankivsk", "Ivano-Frankivsk" -> "Uzhgorod", "Uzhgorod" -> "Ivano-Frankivsk", "Uzhgorod" -> "Lviv", "Lviv" -> "Uzhgorod"};
graph = Graph[list];
lista = (Sort@{{"Sevastopol", 0.77}, {"Cherkassy",0.067}, {"Chernihiv", 0.103}, {"Chernivtsi", 0.053}, {"Dnipropetrovsk", 0.32}, {"Donetsk", 0.749}, {"Ivano-Frankivsk", 0.018}, {"Kharkiv", 0.443}, {"Kherson", 0.249}, {"Khmelnytskyi", 0.041}, {"Kirovohrad", 0.035}, {"Kiev", 0.072}, {"Luhansk", 0.688}, {"Lviv", 0.038}, {"Mykolaiv", 0.293}, {"Odessa", 0.419}, {"Poltava", 0.095}, {"Rivne", 0.027}, {"Sumy", 0.156}, {"Ternopil", 0.012}, {"Vinnytsya", 0.047}, {"Lutsk", 0.025}, {"Zakarpattia", 0.029}, {"Zaporizhzhya", 0.482}, {"Zhytomyr", 0.066}})[[All, 2]];
listc = (1 - lista) ;
listb = (Sort@{{"Zhytomyr", 0}, {"Zaporizhzhya",0.003}, {"Zakarpattia", 0}, {"Lutsk", 0.008}, {"Vinnytsya", 0.001}, {"Ternopil", 0.008}, {"Sumy", 0.006}, {"Rivne", 0.004}, {"Poltava", 0.002}, {"Odessa", 0.021}, {"Mykolaiv", 0}, {"Lviv", 0.040}, {"Luhansk", 0.035}, {"Kiev", 0.622}, {"Kirovohrad", 0.001}, {"Khmelnytskyi", 0.002}, {"Kherson", 0.004}, {"Kharkiv", 0.077}, {"Ivano-Frankivsk", 0.018}, {"Donetsk", 0.127}, {"Dnipropetrovsk", 0.014}, {"Chernivtsi", 0.005}, {"Chernihiv", 0.002}, {"Cherkassy", 0.001}, {"Sevastopol", 0.658}})[[All, 2]];
listd = (1 - listb);
(* equation part *)
eqns[t_] = DSolve[{x'[t] == #*y[t] - #2*x[t], y'[t] == #3*x[t] - #4*y[t], 
  x[0] == 60937, y[0] == 13797}, {x[t], y[t]}, t][[1, All, 2]] & @@@ 
  Thread[{lista, listb, listc, listd}];
(* coloring *)
col[t_] := (Flatten@Position[eqns[t][[#]], (Max /@ eqns[t])[[#]]] & /@
  Range@Length@lista) /. {1 -> Red, 2 -> Green, {1, 2} -> Blue}
(* coordinates of the cities *)
coords = CityData[#, "Coordinates"] & /@ VertexList[graph];
(* background map *)
map = ({EdgeForm[Thin], [email protected],  CountryData[#, "Polygon"] & /@ 
  {"Russia", "Ukraine"}});
(* graph *)
Graph[list, VertexCoordinates -> Reverse[coords, 2], Prolog -> map, 
  VertexLabels -> "Name", ImagePadding -> {{0, 40}, {0, 20}}, 
  ImageSize -> 600, EdgeStyle -> Directive[[email protected], Dashed], 
  VertexStyle -> Rule @@@ Thread[{Sort@Delete[VertexList@graph, 1], col[12]}]]

Manipulate[
  Graph[list, VertexCoordinates -> Reverse[coords, 2], Prolog -> map, 
  VertexLabels -> "Name", ImagePadding -> {{0, 40}, {0, 20}}, 
  ImageSize -> 600, EdgeStyle -> Directive[[email protected], Dashed], 
  VertexStyle -> Rule @@@ Thread[{Sort@Delete[VertexList@graph, 1], col[t]}]],
  {t, 0, 200, 10}]