SetDirectory["C:\\drorbn\\AcademicPensieve\\Talks\\KOS-211021"]

RandomGaussDiagram[n_]:=Module[{i,j},
Graphics[{
Arrowheads[0.015],
Arrow@Line[{{0,0},{2n+2,0}}],
Arrowheads[0.01],
Table[
{i,j}=a;
Arrow@BezierCurve[{{i,0},{((i+j)/2),Abs[((i-j)/2)]},{j,0}}],
{a, Partition[PermutationList@RandomPermutation[2n],2]}
]
}]
];
RandomGaussDiagram[50]

RandomGaussDiagram[n_,as___]:=Module[{i,j,a,is},
is=Range[n];
Graphics[{
Arrowheads[0.015],
Disk[{0,0},0.2],
Arrow@Line[{{0,0},{n+2,0}}],
Arrowheads[0.01],
Flatten@Table[
{i,j}=List@@a[[{2,3}]];
is=Complement[is,{i,j}];
{
a[[1]],
Arrow@BezierCurve[{{i,0},{((i+j)/2),Abs[((i-j)/2)]},{j,0}}],
Text[Style[a[[4]],56],{((i+j)/2),Abs[((i-j)/3.5)]}]
},
{a,{as}}
],
Black,
Table[
{i,j}=a;
Arrow@BezierCurve[{{i,0},{((i+j)/2),Abs[((i-j)/2)]},{j,0}}],
{a, Partition[is[[PermutationList@RandomPermutation@Length@is]],2]}
]
}]
];
RandomGaussDiagram[100,{{Thick, Red},12,30,"R"}]

MakeImage["GD1",
RandomGaussDiagram[56,{{Thickness[0.0025], Red},8,24,"R"},{{Thickness[0.0025], Red},40,16,"R"},{{Thickness[0.0025], Red},32,48,"R"}]
]

MakeImage["GD2",
Graphics[Join[
First@RandomGaussDiagram[56,{{Thickness[0.0025], Red},8,24,"R"},{{Thickness[0.0025], Green},40,16,"G"},{{Thickness[0.0025], Red},32,48,"R"}],
{
Text[Style["(Subscript[q, 1])",56],{8,-1}],
Text[Style["(Subscript[q, 2])",56],{24,-1}],
Text[Style["(Subscript[p, 1])",56],{32,-1}],
Text[Style["(Subscript[p, 2])",56],{48,-1}],
}
]]
]

MakeImage["GD3",
RandomGaussDiagram[88,{{Thickness[0.0025], Red},8,40,"R"},{{Thickness[0.0025], Green},72,16,"G"},{{Thickness[0.0025], Red},64,24,"R"},{{Thickness[0.0025], Green},32,56,"G"},{{Thickness[0.0025], Red},80,48,"R"}]
]

Logs[n_,p_]:=Graphics3D[{
Table[{
If[Random[]<p,Red,LightRed], Tube[Line[{{3k-1,-3,1},{3k-1,3n+4,1}}]]
},
{k,n}
],
Table[{
If[Random[]<p,Green,LightGreen], Tube[Line[{{-3,3k-1,-1},{3n+4,3k-1,-1}}]]
},
{k,n}
]
}, Boxed->False];
Logs[20,0.5]

MakeImage["Logs",Logs[20,0.5]]

Spine[n_]:=Graphics3D[{
Table[{
Red, Tube[Line[{{3k-1,-3,1/2},{3k-1,3n+4,1/2}}]],
ParametricPlot3D[
{3k-1+Cos[θ],t,Sin[θ]},
{t,-3,3n+4},{θ,0,π},
Mesh->False,PlotStyle->Directive[Blue,Opacity[0.2]]
][[1]]
},
{k,n}
],
Table[{
Green, Tube[Line[{{-3,3k-1,-1/2},{3n+4,3k-1,-1/2}}]],
ParametricPlot3D[
{t,3k-1+Cos[θ],-Sin[θ]},
{t,-3,3n+4},{θ,0,π},
Mesh->False,PlotStyle->Directive[Blue,Opacity[0.2]]
][[1]]
},
{k,n}
],
Opacity[0.2], Blue, Polygon[{{-3,-3,0},{-3,3n+4,0},{3n+4,3n+4,0},{3n+4,-3,0}}]
}, Boxed->False];
Spine[3]