Graphics commands

AllZero[x_,opts___] := And @@ Thread[Chop[x,opts]==0]

Needs["Splines`"]

Midpoints[c_,x_] := With[{y=(x/(Plus @@ x))},
c (Drop[FoldList[Plus,0,y],1]-(y/2)) - (c/2)] /;  ((c≥Plus @@ x) && !AllZero[x])

Midpoints[c_,x_] := Drop[FoldList[Plus,0,x],1]-(x/2)-(c/2)-((-c+Plus @@ x)/2) /; c<Plus @@ x

Midpoints[c_,{}] := {};
Midpoints[c_,x_] := Table[0,{Length[x]}] /; AllZero[x]

DrawLink[link[C_,xy_ : {.5,0} ,L_ : 1,name_ : "link",opts___]] := 
If[C==0,{},With[{x=xy[[1]],y=xy[[2]]},
Graphics[{
{GrayLevel[.8],Opacity[.5],
Rectangle[{x-L/2,y+C/2},{x+L/2,y-C/2}],
Disk[{x-L/2,y},{.1 L,C/2},{Pi/2,3Pi/2}] ,
Disk[{x+L/2,y},{.1 L,C/2},{-Pi/2,Pi/2}]},
Circle[{x-L/2,y},{.1 L,C/2}] ,
Circle[{x+L/2,y},{.1 L,C/2},{-Pi/2,Pi/2}],
Line[{{x-L/2,y+C/2},{x+L/2,y+C/2}}],
Line[{{x-L/2,y-C/2},{x+L/2,y-C/2}}]
}] ]]

DrawLinkLabel[link[C_,xy_ : {.5,0},L_:1,name_:"link",opts___],load_] := Module [ {label},
labelfunc = Label /. {opts} /. {Label->None};
If[labelfunc===None,{},labelfunc[C,load,xy]]
]

LinkName[link[C_,xy_ : {.5,0}, L_ : 1, name_ : "link",rest___]] := name

LinkCapacity[link[C_,rest___]] := C

LinkLength[link[C_,xy_ : {.5,0},L_:1,rest___]] := L

LinkCoord[link[C_,xy_:{.5,0},rest___]] := xy

FlowName[flow[rate_,waypoints_,name_]] := name

FlowRate[flow[rate_,rest___]] := rate

LinksUsed[flow[rate_,waypoints_,name_]] := Cases[waypoints, _String ]

Waypoints[flow[rate_,waypoints_,rest___]] := waypoints

Second[x_] := x[[2]]

Indicator[True] = 1;
Indicator[False] = 0;

(* Spline from start to link, line through link, spline through midpoint to next link, line through link, spline to end *)
(* Spline from start to link, line through link, spline to end *)

DrawFlow[{point[p1_],uselink[{p2_,len_},mp_],path__}] := {
Spline[{p1,p2+{-len/2-.2,mp},p2+{-len/2,mp}},Bezier],
DrawFlow[{uselink[{p2,len},mp],path}]}

DrawFlow[{uselink[{p1_,len1_},mp1_],uselink[{p2_,len2_},mp2_],path__}] :=
{Line[{p1+{-len1/2,mp1},p1+{len1/2,mp1}}],
Spline[{p1+{len1/2,mp1},p1+{len1/2+.2,mp1},(p1+{len1/2+.2,mp1}+p2+{-len2/2-.2,mp2})/2,p2+{-len2/2-.2,mp2},p2+{-len2/2,mp2}},CompositeBezier],
DrawFlow[{uselink[{p2,len2},mp2],path}]}

DrawFlow[{uselink[{p1_,len_},mp_],point[p2_]}] := {
Line[{p1+{-len/2,mp},p1+{len/2,mp}}],
Spline[{p1+{len/2,mp},p1+{len/2+.2,mp},p2},Bezier]}

DrawFlow[{uselink[{p1_,len1_},mp1_],uselink[{p2_,len2_},mp2_]}] := {
Line[{p1+{-len1/2,mp1},p1+{len1/2,mp1}}],
Spline[{p1+{len1/2,mp1},p1+{len1/2+.2,mp1},(p1+{len1/2+.2,mp1}+p2+{-len2/2-.2,mp2})/2,p2+{-len2/2-.2,mp2},p2+{-len2/2,mp2}},CompositeBezier],
Line[{p2+{-len2/2,mp2},p2+{len2/2,mp2}}] }

CleanLine[line_] := Module [ {s,a,b,cleansegment,res,inds},
cleansegment[s_Spline] := Table[s[[3]][x],{x,0,Length[First[s]]-1,1/10}];
cleansegment[Line[{a_,b_}]] := {a,b};
res = Flatten[cleansegment /@ line,1];
inds = Prepend[Select[Range[Length[res]],res[[#]]≠res[[#-1]]&],1];
Line[Part[res,inds]]
]

ShowNetwork[objects_,opts___] := Module [ {links,flows,linknames,linkdefs,flownames,linksused,adjacency,midpoints,GetMidpoints,flowdesc,flowpaths,cols,thicks,plotrange,loads},
links = Cases[objects,_link];
flows = Cases[objects,_flow];
linknames = Thread[Rule[LinkName /@ links,Range@Length@links]];
linkdefs = Thread[Rule[LinkName /@ links,{LinkCoord[#],LinkLength[#]}& /@ links]];
flownames = Thread[Rule[FlowName /@ flows, Range@Length@flows]];
linksused = LinksUsed /@ flows;
adjacency = Function[{linkname},Indicator@MemberQ[#,linkname]& /@ linksused] /@ (First /@ linknames);
(* What are the midpoints at each link? *)
midpoints = Thread[Midpoints[LinkCapacity /@ links,(FlowRate /@ flows #)& /@ adjacency]];
(* For each flow, what is its midpoint at each link it passes through? *)
GetMidpoints[links_List,flownum_] := If[!StringQ[#],#,uselink[#,midpoints[[# /. linknames,flownum]]]]& /@ links;
(* What is the load at each link? *)
loads = (FlowRate /@ flows #)& /@ adjacency;
(* Now, draw *)
flowdesc = MapThread[GetMidpoints,{Waypoints /@ flows, Range@Length@flows}] /. linkdefs;
flowpaths = CleanLine@Flatten@DrawFlow[#] & /@ flowdesc;
cols = FlowStyle /. {opts} /. {FlowStyle->FlowColours[Length@flows]};
plotrange = PlotRange /. {opts} /. {PlotRange->{{Min[First /@ (LinkCoord /@ links) - (LinkLength /@ links)/2]-1,
Max[First /@ (LinkCoord /@ links) + (LinkLength /@ links)/2]+1},
{Min[Second /@ (LinkCoord /@ links) - (LinkCapacity /@ links)/2-1],
Max[Second /@ (LinkCoord /@ links) + (LinkCapacity /@ links)/2]+1}}};
thicks = Thickness /@ ((FlowRate /@ flows)/(plotrange[[1,2]]-plotrange[[1,1]]));
Show[{Graphics@Transpose[{cols, thicks,flowpaths}],
DrawLink /@ links,
Graphics@MapThread[DrawLinkLabel,{links,loads}]},
PlotRange->plotrange,Sequence @@ FilterRules[FilterRules[{opts},Options[Graphics]],Except[PlotRange]]]
]

FlowColours[n_] := Table[ColorData["Pastel"][i],{i,0,1,1/(n-1)}];

FormatCapacity[x_,suffix_:""] := ToString[NumberForm[x,{3,0},NumberPadding->" ",NumberPoint->""]]<>suffix

FormatWnd[w_,suffix_:""] := ToString[NumberForm[w,{3,2},NumberPadding->" ",NumberPoint->"."]] <>suffix

FormatTime[x_] := ToString[NumberForm[1000 x,{3,0},NumberPadding->" ",NumberPoint->""]]<>" ms"

ShowLoad[C_,loads_,xy_] := Style[Text[NumberForm[100 (Plus @@ loads),{3,1}],xy,{1,0}],"Legend"]

ShowEachLoad[C_,loads_,xy_] := Style[Text[NumberForm[100 #,{3,1}]& /@ Reverse@loads,xy,{-1,0}],"Legend"]

ShowDrop[p_][C_,loads_,xy_] := Style[Text[ToString@NumberForm[100 p[C,Plus@@loads],{3,1}]<>"%",xy,{0,0}],"Legend"]

ShowVal[v_][C_,loads_,xy_] := Style[Text[ToString@NumberForm[100. v,{3,2}]<>"%",xy,{0,0}],"Legend"]

PressedIf[pressed_] = If[pressed,{"DialogBox","Pressed"},"DialogBox"];

General setup

drop[C_,y_] = Max[0,1-C/y];

updatemodel[fm_,topo_,pars_,x0_] := Module [ {res,subs,Vars,eqs,eqsi,n,terms,drifts,d0},
n = Length[fm];
terms = fm[[All,1]]; drifts=fm[[All,2]];
d0 = drifts /. topo /. Thread[terms->x0] /. pars;
If[AllZero[d0,(10^(-5))],
None,
subs = Table[terms[[i]]->Vars[i][t],{i,n}];
eqs = Table[Vars[i]'[t]==drifts[[i]],{i,n}];
eqsi = Table[Vars[i][0]==x0[[i]],{i,n}];
res = First@NDSolve[
Join[eqs,eqsi]/. topo /. subs /. pars,
Table[Vars[i],{i,n}],
{t,0,10}];
terms /. subs /. {t->10} /. res ]]

{cola1,cola2,colb1,colb2,colc1,colc2} = {RGBColor[0.76,.47,.94],Lighter[RGBColor[.76,.47,.94],.5],RGBColor[.94,.79,.59],Lighter[RGBColor[.94,.79,.59],.3],RGBColor[0.79,0.89,0.83],Darker[RGBColor[0.79,0.89,0.83],.1]};

cold = Lighter[Blue,.6];

4 parallel links

ladder4 = {
xa1->xa1(xa1+xa2)((1-p1)(xa1/(rtt (((xa1+xa2))^2)))(((((xa1+xa2)/(2 xa1))))^ϕ)-p1 (xa1/2)rtt),
xa2->xa2(xa1+xa2)((1-p2)(xa2/(rtt(((xa1+xa2))^2)))(((((xa1+xa2)/(2 xa2))))^ϕ)-p2 (xa2/2)rtt),
xb1->xb1(xb1+xb2)((1-p2)(xb1/(rtt(((xb1+xb2))^2)))(((((xb1+xb2)/(2 xb1))))^ϕ)-p2 (xb1/2)rtt),
xb2->xb2(xb1+xb2)((1-p3)(xb2/(rtt(((xb1+xb2))^2)))(((((xb1+xb2)/(2 xb2))))^ϕ)-p3 (xb2/2)rtt),
xc1->xc1(xc1+xc2)((1-p3)(xc1/(rtt(((xc1+xc2))^2)))(((((xc1+xc2)/(2 xc1))))^ϕ)-p3 (xc1/2)rtt),
xc2->xc2(xc1+xc2)((1-p4)(xc2/(rtt(((xc1+xc2))^2)))(((((xc1+xc2)/(2 xc2))))^ϕ)-p4 (xc2/2)rtt)};

ladder4plot[pars_,topo_,x0_] := Module[{vals},
vals = Thread[{xa1,xa2,xb1,xb2,xc1,xc2}->x0];
ShowNetwork[{
link[0,{-2,1},1,"srca"],
link[0,{-2,3},1,"srcb"],
link[0,{-2,5},1,"srcc"],
link[0,{3,1},1,"desta",Label->ShowLoad],
link[0,{3,3},1,"destb", Label->ShowLoad],
link[0,{3,5},1,"destc",Label->ShowLoad],
link[c1/100 /. pars,{0,0},1,"link1",Label->ShowVal[p1 /. topo /. vals /. pars]],
link[c2/100 /. pars,{0,2},1,"link2",Label->ShowVal[p2 /. topo /. vals /. pars]],
link[c3/100 /. pars ,{0,4},1,"link3",Label->ShowVal[p3 /. topo /. vals /. pars]],
link[c4/100 /. pars ,{0,6},1,"link4",Label->ShowVal[p4 /. topo /. vals /. pars]],
flow[xa1/100 /. vals /. pars,{"srca","link1","desta"},"flowa1"],
flow[xa2/100 /. vals /. pars,{"srca","link2","desta"},"flowa2"],
flow[xb1/100 /. vals /. pars,{"srcb","link2","destb"},"flowb2"],
flow[xb2/100 /. vals /. pars,{"srcb","link3","destb"},"flowb3"],
flow[xc1/100 /. vals /. pars,{"srcc","link3","destc"},"flowc3"],
flow[xc2/100 /. vals /.pars,{"srcc","link4","destc"},"flowc4"]
},PlotRange->{{-2,3},{-1,7}}, ImageSize->Scaled[.35],
FlowStyle->{cola1,cola2,colb1,colb2,colc1,colc2}]
]

ladder4topo = {p1->drop[c1,xa1],p2->drop[c2 ,xa2+xb1],p3->drop[c3 ,xb2+xc1],p4->drop[c4 ,xc2]};

ladder4pars = {c1->100,c2->100,c3->100,c4->54,rtt->.1,ϕ->0};

txt = {" ","Resource pooling means:","",
"Congestion due to reduced capacity etc.","can be shared across the entire network"};

PressedIf[pressed_] = If[pressed,{"DialogBox","Pressed"},"DialogBox"];
Manipulate[
DynamicModule[{X={30,30,30,30,30,30},Xnew},
Dynamic[Refresh[
With[{pars={c1->cap1,c2->cap2,c3->cap3,c4->cap4,rtt->.1,ϕ->phi}},
If[(Xnew=updatemodel[ladder4,ladder4topo,pars,X])===None,,  X=Xnew];
ladder4plot[pars,ladder4topo,X]],
TrackedSymbols:>{cap1,cap2,cap3,cap4,X,phi}] ]],
Row[{Spacer[10],Column[{Grid[{
{"",Row[{Button["coupled",phi=0,Appearance->PressedIf[phi==0]],Button["TCP/2",phi=2,Appearance->PressedIf[phi==2]]}]},
{"ϕ",Control[{{phi,0,""},0,2,.2}],Dynamic[NumberForm[phi,{2,1}]]},
{"(Subscript[C, 1])",Control[{{cap4,100,""},1,200,1}],Dynamic@FormatCapacity[cap4," pkt/s"]},
{"(Subscript[C, 2])",Control[{{cap3,100,""},1,200,1}],Dynamic@FormatCapacity[cap3," pkt/s"]},
{"(Subscript[C, 3])",Control[{{cap2,100,""},1,200,1}],Dynamic@FormatCapacity[cap2," pkt/s"]},
{"(Subscript[C, 4])",Control[{{cap1,100,""},1,200,1}],Dynamic@FormatCapacity[cap1," pkt/s"]}},
Dividers->{False,{False,False,True}},Spacings->{1,{1,1,2,1,1,1,1}},Alignment->{{Right,Left,Left},Center}],
Sequence@@(Style[#,20]& /@ txt)}]
}, Alignment->{{Right,Left,Left},Center}],
ControlPlacement->Right,
SaveDefinitions->True
]

3 links, 3 routes

link33 = {
xa1->xa1(xa1+xa2)((1-p1)(xa1/(rtt(((xa1+xa2))^2)))-p1 (xa1/2)rtt),
xa2->xa2(xa1+xa2)((1-p2-p3)(xa2/(rtt(((xa1+xa2))^2)))-(p2+p3)(xa2/2)rtt),
xb->(xb^2)((1-p2)(1/(rtt xb))-p2 (xb/2)rtt),
xc->(xc^2)((1-p3)(1/(rtt xc))-p3 (xc/2)rtt),
xd->(xd^2)((1-p1)(1/(rtt xd))-p1 (xd/2)rtt)};

link33topo = {p1->drop[c1,xa1+xd],p2->drop[c2 ,xa2+xb],p3->drop[c3 ,xa2+xc]};

link33plot[pars_,topo_,x0_] := Module[{vals},
vals = Thread[{xa1,xa2,xb,xc,xd}->x0];
ShowNetwork[{
link[0,{-2,-.5},1,"srcb"],
link[0,{3,-.5},.2,"srcc"],
link[0,{-2,2},1,"srca"],
link[0,{0,3},1,"srcd"],
link[0,{1.5,-1},.1,"destb", Label->ShowLoad],
link[0,{6,-1},.1,"destc",Label->ShowLoad],
link[0,{6,2},1,"desta",Label->ShowLoad],
link[0,{5,3},1,"destd",Label->ShowLoad],
link[c1/100 /. pars,{2,2},1,"link1",Label->ShowVal[p1 /. topo /. vals /. pars]],
link[c2/100 /. pars,{0,0},1,"link2",Label->ShowVal[p2 /. topo /. vals /. pars]],
link[c3/100 /. pars ,{4,0},1,"link3",Label->ShowVal[p3 /. topo /. vals /. pars]],
flow[xb/100 /. vals /. pars,{"srcb","link2","destb"},"flowb"],
flow[xc/100 /. vals /. pars,{"srcc","link3","destc"},"flowc"],
flow[xa2/100 /. vals /. pars,{"srca","link2","link3","desta"},"flowa2"],
flow[xa1/100 /. vals /. pars,{"srca","link1","desta"},"flowa1"],
flow[xd/100 /. vals /. pars,{"srcd","link1","destd"},"flowd"]
},PlotRange->{{-2,7},{-2,4}}, ImageSize->Scaled[.35],
FlowStyle->{cola1,colc1,colb1,colb2,cold}]
]

txt = {"","Actually,","Congestion isn't equalized","Flows don't get equal throughputs","","Congestion is distributed, unevenly"};

txt = {"","The bigger (Subscript[C, 1]),","the more easily (Subscript[C, 2]) and (Subscript[C, 3])","can shed their load"};

Manipulate[
DynamicModule[{X={40,25,92,92,65},Xnew},
Dynamic[Refresh[
With[{pars={c1->cap1,c2->cap2,c3->cap3,rtt->.2}},
If[(Xnew=updatemodel[link33,link33topo,pars,X])===None,,  X=Xnew];
link33plot[pars,link33topo,X]],
TrackedSymbols:>{cap1,cap2,cap3,X}] ]],
Row[{Spacer[10],Column[{Grid[{
{"(Subscript[C, 1])",Control[{{cap1,100,""},1,200,1}],Dynamic@FormatCapacity[cap1," pkt/s"]},
{"(Subscript[C, 2])",Control[{{cap2,120,""},1,200,1}],Dynamic@FormatCapacity[cap2," pkt/s"]},
{"(Subscript[C, 3])",Control[{{cap3,120,""},1,200,1}],Dynamic@FormatCapacity[cap3," pkt/s"]}
}, Alignment->{{Right,Left,Left},Center}],
Sequence@@(Style[#,18]& /@ txt)}]}],
ControlPlacement->Right,
SaveDefinitions->True
]

3 links, 2 routes

link32 = {
xa1->xa1(xa1+xa2)((1-p1)(xa1/(rtt(((xa1+xa2))^2)))-p1 (xa1/2)rtt),
xa2->xa2(xa1+xa2)((1-p2-p3)(xa2/(rtt(((xa1+xa2))^2)))-(p2+p3)(xa2/2)rtt),
xb1->xb1(xb1+xb2)((1-p2)(xb1/(rtt(((xb1+xb2))^2)))-p2 (xb1/2)rtt),
xb2->xb2(xb1+xb2)((1-p3)(xb2/(rtt(((xb1+xb2))^2)))-p3 (xb2/2)rtt),
xd->(xd^2)((1-p1)(1/(rtt xd))-p1 (xd/2)rtt)};

link32topo = {p1->drop[c1,xa1+xd],p2->drop[c2 ,xa2+xb1],p3->drop[c3 ,xa2+xb2]};

link32plot[pars_,topo_,x0_] := Module[{vals},
vals = Thread[{xa1,xa2,xb1,xb2,xd}->x0];
ShowNetwork[{
link[0,{-2,-1},1,"srcb"],
link[0,{-2,2},1,"srca"],
link[0,{0,3},1,"srcd"],
link[0,{2,-1},.1,"dum1"],
link[0,{2,-1},.1,"dum2"],
link[0,{6,-1},.1,"destb",Label->ShowLoad],
link[0,{6,2},1,"desta",Label->ShowLoad],
link[0,{5,3},1,"destd",Label->ShowLoad],
link[c1/100 /. pars,{2,2},1,"link1",Label->ShowVal[p1 /. topo /. vals /. pars]],
link[c2/100 /. pars,{0,0},1,"link2",Label->ShowVal[p2 /. topo /. vals /. pars]],
link[c3/100 /. pars ,{4,0},1,"link3",Label->ShowVal[p3 /. topo /. vals /. pars]],
flow[xb2/100 /. vals /. pars,{"srcb","dum2","link3","destb"},"flowb2"],
flow[xb1/100 /. vals /. pars,{"srcb","link2","dum1","destb"},"flowb1"],
flow[xa2/100 /. vals /. pars,{"srca","link2","link3","desta"},"flowa2"],
flow[xa1/100 /. vals /. pars,{"srca","link1","desta"},"flowa1"],
flow[xd/100 /. vals /. pars,{"srcd","link1","destd"},"flowd"]
},PlotRange->{{-2,7},{-2,4}}, ImageSize->Scaled[.35],
FlowStyle->{colc2,colc1,colb1,colb2,cold}]
];

txt = {"","Extra path diversity","also impacts","ability to shift load"};

Manipulate[
DynamicModule[{X={40,25,52,52,65},Xnew},
Dynamic[Refresh[
With[{pars={c1->cap1,c2->cap2,c3->cap3,rtt->.2}},
If[(Xnew=updatemodel[link32,link32topo,pars,X])===None,,  X=Xnew];
link32plot[pars,link32topo,X]],
TrackedSymbols:>{cap1,cap2,cap3,X}] ]],
Row[{Spacer[10],Column[{Grid[{
{"(Subscript[C, 1])",Control[{{cap1,100,""},1,200,1}],Dynamic@FormatCapacity[cap1," pkt/s"]},
{"(Subscript[C, 2])",Control[{{cap2,120,""},1,200,1}],Dynamic@FormatCapacity[cap2," pkt/s"]},
{"(Subscript[C, 3])",Control[{{cap3,120,""},1,200,1}],Dynamic@FormatCapacity[cap3," pkt/s"]}
}, Alignment->{{Right,Left,Left},Center}],
Sequence@@(Style[#,18]& /@ txt)}] }],
ControlPlacement->Right,
SaveDefinitions->True
]

All simulations