SetDirectory["C:\\drorbn\\AcademicPensieve\\Talks\\Tokyo-230911"]

(*n=7;w=1;
SeedRandom[0];
pts={};
While[Length[pts]<(2^(4n/3)),pts=pts⋃{pt@@RandomInteger[(2^n)-1,2]}];
Echo[(2^n)+w n+w]
gb=Rasterize[ImageCrop@ArrayPlot[
SparseArray[
Join[
pts/. pt[x_,y_]:>{x+w n+w+1,y+w n+w+1}->1,
side=Flatten[Table[ds=IntegerDigits[k,2,n];Table[{1+w (j-1)+i,k+w n+w+1}->(1/4) (1+3 ds[[j]]),{i,0,w-1},{j,n}],{k,0,(2^n)-1}]],
side/. {x_,y_}:>{y,x}],
{(2^n)+w n+w,(2^n)+w n+w}
],
Frame -> False],RasterSize->(2^n)+w n+w]
Export["GameBoard-"<>ToString[n]<>".png",gb]*)

n=7;
SeedRandom[0];
pts={};
While[Length[pts]<(2^(4n/3)),pts=pts⋃{pt@@RandomInteger[(2^n)-1,2]}];
gb=Rasterize[ImageCrop@ArrayPlot[
SparseArray[
pts/. pt[x_,y_]:>{x+1,y+1}->1,
{(2^n),(2^n)}
],
Frame -> False],RasterSize->(2^n)]
Export["GameBoard-"<>ToString[n]<>".png",gb]

n=7;
ruler=Image[Table[IntegerDigits[k,2,n],{k,0,(2^n)-1}]\[Transpose]]
Export["Ruler-"<>ToString[n]<>".gif",ruler]

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.3)]}]
},
{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["GDExample",SeedRandom[0];
RandomGaussDiagram[100]
]

MakeImage["GD1",SeedRandom[0];
RandomGaussDiagram[56,{{Thickness[0.0025], Red},8,24,"D"},{{Thickness[0.0025], Red},40,16,"D"},{{Thickness[0.0025], Red},32,48,"D"}]
]

MakeImage["GD2",SeedRandom[0]; w=8;
RandomGaussDiagram[9w,
{{Thickness[0.0025], Purple},1w,6w,"P"},{{Thickness[0.0025], Purple},8w,3w,"P"},
{{Thickness[0.0025], Blue},4w,2w,"L"}, {{Thickness[0.0025], Blue},5w,7w,"L"}
]
]