Define plot style options

size of graphics for output (journal column size)

onecol=3.4*72
twocol=6.7*72

style for text

tstyle={FontFamily->"Helvetica",FontSize->10,SingleLetterItalics->False};
txtFormat[text_,style_:tstyle]:=Style[text,style]

style for drawing frames

framestyle=Sequence[LabelOffset->-3,PlotRangeOffset->2,FrameStyle->Directive[AbsoluteThickness[0.5],Black],LabelStyle->tstyle];

style for lines in plots

linestyles[xopts_:{}]:={
Directive[Flatten[{RGBColor[0.8,0,0],AbsoluteThickness[1],xopts}]],
Directive[Flatten[{RGBColor[0.1,0.2,0.9],AbsoluteThickness[1],xopts}]],
Directive[Flatten[{RGBColor[0.0,0.5,0.1],AbsoluteThickness[1],xopts}]],
Directive[Flatten[{RGBColor[0.5,0.5,0.5],AbsoluteThickness[1],xopts}]],
Directive[Flatten[{Black,AbsoluteThickness[1],xopts}]]
}
linedashing=Directive[AbsoluteDashing[{2,4,2,4,2,4}]];
fillstyles[xopts_:{},mix_:0.75]:={
Directive[Flatten[{Blend[{RGBColor[0.8,0,0],White},mix],xopts}]],
Directive[Flatten[{Blend[{RGBColor[0.1,0.2,0.9],White},mix],xopts}]],
Directive[Flatten[{Blend[{RGBColor[0.0,0.5,0.1],White},mix],xopts}]],
Directive[Flatten[{Blend[{RGBColor[0.5,0.5,0.5],White},mix],xopts}]]
}

style for color scales

Module[{f},
cbarHot[alpha_,range_:{0,1},opfun_:((1.0)&)]:=Directive[f=Min[1,Max[0,(alpha-range[[1]])/(range[[2]]-range[[1]])]];
Blend[{
Blend[{ColorData["DeepSeaColors"][(1-f)^1.1],White},(1-f)^4],
RGBColor[1.0,0.5,0]},(f)^10
]
,Opacity[opfun[(alpha-range[[1]])/(range[[2]]-range[[1]])]]
]
];

Module[{f},
cbarBWR[alpha_,range_:{0,1},opfun_:((1.0)&)]:=Directive[f=Min[1,Max[0,(alpha-range[[1]])/(range[[2]]-range[[1]])]];
Blend[{RGBColor[1,0.3,0],RGBColor[0,0.4,1],White,Black},{Sin[f*Pi/2],Cos[f*Pi/2],Sin[f*Pi]^4*2+Sin[f*Pi]^16*4+Sin[f*Pi]^64*8+Sin[f*Pi]^256*32,Cos[f*Pi]^16}] ,Opacity[opfun[(alpha-range[[1]])/(range[[2]]-range[[1]])]]
]
];

ContourPlot[x,{x,0,1},{y,0,1},ColorFunction->cbarHot,Contours->40]

periodic color scale

a2p[r_,a_,o_:{0,0}]:=o+r*{Cos[a],Sin[a]}
wedge[r_,dr_,a_,da_,n_:10,o_:{0,0}]:=
Polygon[Join[{a2p[r-dr/2,a-da/2,o],a2p[r+dr/2,a-da/2,o]},
Table[a2p[r+dr/2,a-da/2+da*i/n,o],{i,0,n}],
{a2p[r+dr/2,a+da/2,o],a2p[r-dr/2,a+da/2,o]},
Table[a2p[r-dr/2,a+da/2-da*i/n,o],{i,0,n}]
]]
wheel[o_,r_,dr_,opts__:{ColorFunction->cbarPHI}]:=Graphics[Table[{(ColorFunction/.opts)[ t/(2Pi)],wedge[r,r*dr,t,2 Pi/180,3,o]},{t,0,2 Pi,2 Pi/180}]]

Remove[wheel]

wheel[{0,0},1,0.5,ColorFunction->cbarPHI]

Module[{f},
cbarPHI[alpha_,range_:{0,1},opfun_:((1.0)&)]:=
Directive[f=Min[1,Max[0,(alpha-range[[1]])/(range[[2]]-range[[1]])]];
Blend[{Black,White,RGBColor[0,0.4,0.9],RGBColor[1.0,0.3,0]},{0.5 Cos[f*Pi+Pi/4+Pi/4]^4,1Sin[ f Pi+Pi/4+Pi/4]^8,Cos[f Pi+Pi/4]^4,Cos[f Pi+Pi/2+Pi/4]^4}],Opacity[opfun[(alpha-range[[1]])/(range[[2]]-range[[1]])]]
]
];

plot markers

plotmark[style_:linestyles[][[1]],stylein_:Directive[White], sz_:2]:=Graphics[{EdgeForm[style],FaceForm[stylein],#}]&/@{
Disk[{0,0},Offset[{sz,sz}]],
Polygon[{Offset[{0,sz}*Sqrt[Pi/2]],Offset[{sz,0}*Sqrt[Pi/2]],Offset[{0,-sz}*Sqrt[Pi/2]],Offset[{-sz,0}*Sqrt[Pi/2]]}]
}

Discrete probs

builds a random doubly-stochastic matrix

Module[{M,mx,my},
mtxProb[n_]:=(
M=Table[RandomReal[]^2,{i,1,n},{j,1,n}];
mx=Table[RandomReal[]^2,{i,1,n}];mx/=Total[mx];
my=Table[RandomReal[]^2,{i,1,n}];my/=Total[my];
mymx=mx;mymy=my;
M/=Total[Flatten[M]];
Do[
M=M.DiagonalMatrix[mx/Total[M]];
M=DiagonalMatrix[my/(Total/@M)].M;,{i,1,10}];
M
)]

Module[{n,mx,my,mc},
pplot[m_,ic_:0]:=(n=Length[m];
mx=Total[m];my=Total/@m; mc=mx;
If[ic>0,mc=m[[ic]]/my[[ic]]];
Graphics[Flatten[{
EdgeForm[GrayLevel[0.8]],
Table[{cbarHot[m[[i+1,j+1]]],Rectangle[{i/n,-j/n},{(i+1)/n,-(j+1)/n}]},{i,0,n-1},{j,0,n-1}],
Table[{cbarHot[my[[i+1]]],Rectangle[{i/n,-1.1},{(i+1)/n,-1.1-1/n}]},{i,0,n-1}],
Table[{cbarHot[mx[[i+1]]],Rectangle[{1.1,-i/n},{1.1+1/n,-(i+1)/n}]},{i,0,n-1}],
Black,FaceForm[],EdgeForm[Black],Rectangle[{0,0},{1,-1}],
Rectangle[{1.1,0},{1.1+1/n,-1}],
Rectangle[{0,-1.1},{1,-1.1-1/n}],
Table[Text[ToString[i+1],Offset[{0,5},{(i+0.5)/n,0}],{0,-1}],{i,0,n-1}],
Table[Text[ToString[i+1],Offset[{-5,0},{0,-(i+0.5)/n}],{1,0}],{i,0,n-1}],
Text["P(A,B)",Offset[{-10,10},{0,0}],{1,-1}],
Text["P(A)",Offset[{0,10},{1.1+0.5/n,0}],{0,-1}],
Text["P(B)",Offset[{-10,0},{0,-1.1-0.5/n}],{1,0}],
EdgeForm[GrayLevel[0.8]],FaceForm[White],
If[ic==0,{Opacity[0],EdgeForm[Opacity[0]],FaceForm[Opacity[0]]},{}],
If[ic>0,Table[{cbarHot[mc[[i+1]]],Rectangle[{1.2+1/n,-i/n},{1.2+2/n,-(i+1)/n}]},{i,0,n-1}]],
EdgeForm[{Red,Thickness[0.005]}],FaceForm[],
Rectangle[{1.2+1/n,0},{1.2+2/n,-1}],
Rectangle[{(ic-1)/n,0},{ic/n,-1}],
Black,Text["P(A|B)",Offset[{0,10},{1.2+1.5/n,0}],{0,-1}]
}]
]

)
]

mm=mtxProb[5];

ppp=Show[pplot[mm,4],PlotRange->All]

DROOT=NotebookDirectory[];

Export[DROOT<>"probmatrix-2.pdf",ppp,"PDF"]

Continuous probs

builds a random doubly-stochastic probability function

ng=5;
glist=Table[{RandomReal[],RandomReal[],0.05+RandomReal[]/5},{i,1,ng}]
gauss[{x_,y_},{x0_,y0_,s_}]:=1/(2 Pi s^2) Exp[-((x-x0)^2+(y-y0)^2)/(2s^2)]
gnrm=Table[Integrate[gauss[{x,y},glist[[i]]],{x,0,1},{y,0,1}],{i,1,ng}];
gw=Table[RandomReal[],{i,1,ng}];gw/=Total[gw];
gw/=gnrm;

pf[x_,y_]:=Sum[gw[[i]]gauss[{x,y},glist[[i]]],{i,1,ng}]

fx[x_]:=NIntegrate[pf[x,y],{y,0,1}]
fy[y_]:=NIntegrate[pf[x,y],{x,0,1}]

px=Plot[fx[x],{x,0,1},PlotStyle->Directive[Red,Thick]]
py=Plot[fy[x],{x,0,1},PlotStyle->Directive[Red,Thick]]

sides=Graphics3D[
{Replace[px[[1,1,3]],{{x_,y_}:>{x,0,y}},{3}],
Replace[py[[1,1,3]],{{x_,y_}:>{0,x,y}},{3}]
}]

p3d=Plot3D[pf[x,y],{x,0,1},{y,0,1},PlotRange->All,ColorFunction->cbarHot];

op=Show[p3d,sides,AxesLabel->{"x","y","P"},ViewPoint->4{-1,-1.2,0.5},ImageSize->7*72,LabelStyle->Directive[FontFamily->"Helvetica",FontSize->11,Black]]

Export[DROOT<>"pmarginal3d.png",op,"PNG",ImageResolution->150]

Module[{M,mx,my},
mtxProb[n_]:=(
M=Table[RandomReal[]^2,{i,1,n},{j,1,n}];
mx=Table[RandomReal[]^2,{i,1,n}];mx/=Total[mx];
my=Table[RandomReal[]^2,{i,1,n}];my/=Total[my];
mymx=mx;mymy=my;
M/=Total[Flatten[M]];
Do[
M=M.DiagonalMatrix[mx/Total[M]];
M=DiagonalMatrix[my/(Total/@M)].M;,{i,1,10}];
M
)]

Module[{n,mx,my,mc},
pplot[m_,ic_:0]:=(n=Length[m];
mx=Total[m];my=Total/@m; mc=mx;
If[ic>0,mc=m[[ic]]/my[[ic]]];
Graphics[Flatten[{
EdgeForm[GrayLevel[0.8]],
Table[{cbarHot[m[[i+1,j+1]]],Rectangle[{i/n,-j/n},{(i+1)/n,-(j+1)/n}]},{i,0,n-1},{j,0,n-1}],
Table[{cbarHot[my[[i+1]]],Rectangle[{i/n,-1.1},{(i+1)/n,-1.1-1/n}]},{i,0,n-1}],
Table[{cbarHot[mx[[i+1]]],Rectangle[{1.1,-i/n},{1.1+1/n,-(i+1)/n}]},{i,0,n-1}],
Black,FaceForm[],EdgeForm[Black],Rectangle[{0,0},{1,-1}],
Rectangle[{1.1,0},{1.1+1/n,-1}],
Rectangle[{0,-1.1},{1,-1.1-1/n}],
Table[Text[ToString[i+1],Offset[{0,5},{(i+0.5)/n,0}],{0,-1}],{i,0,n-1}],
Table[Text[ToString[i+1],Offset[{-5,0},{0,-(i+0.5)/n}],{1,0}],{i,0,n-1}],
Text["P(A,B)",Offset[{-10,10},{0,0}],{1,-1}],
Text["P(A)",Offset[{0,10},{1.1+0.5/n,0}],{0,-1}],
Text["P(B)",Offset[{-10,0},{0,-1.1-0.5/n}],{1,0}],
EdgeForm[GrayLevel[0.8]],FaceForm[White],
If[ic==0,{Opacity[0],EdgeForm[Opacity[0]],FaceForm[Opacity[0]]},{}],
If[ic>0,Table[{cbarHot[mc[[i+1]]],Rectangle[{1.2+1/n,-i/n},{1.2+2/n,-(i+1)/n}]},{i,0,n-1}]],
EdgeForm[{Red,Thickness[0.005]}],FaceForm[],
Rectangle[{1.2+1/n,0},{1.2+2/n,-1}],
Rectangle[{(ic-1)/n,0},{ic/n,-1}],
Black,Text["P(A|B)",Offset[{0,10},{1.2+1.5/n,0}],{0,-1}]
}]
]

)
]

mm=mtxProb[5];

ppp=Show[pplot[mm,4],PlotRange->All]

DROOT=NotebookDirectory[];

Export[DROOT<>"probmatrix-2.pdf",ppp,"PDF"]