Files @ eba8261885e8
Branch filter:

Location: AENC/switchchain/triangle_canonical_mixingtime.m

eba8261885e8 5.8 KiB application/vnd.wolfram.mathematica.package Show Annotation Show as Raw Download as Raw
Tom Bannink
Change trimeevol plot for thesis
(* ::Package:: *)

gsraw=Import[NotebookDirectory[]<>"data/graphdata_canonical_mixingtime_histogram_merged.m"];
gdata=GatherBy[gsraw,{#[[1,2]]&}];
(* Data format: *)
(* gdata[[ tau index, n index, datatype index ]] *)
(* datatype index:
1: {n,tau}
2: { {time1, {samples1}}, {time2, {samples2}} , ... }  samples can also be a HistogramList kind of list
3: {uniform samples}
*)


(*Histogram[histogramdata[[All,2]],Automatic,"Probability",ChartLegends\[Rule]histogramdata[[All,1]]]*)

makeHistogram[run_,plotrange_,choices_]:=Module[{gridsize,labels,wd,uni},
uni=WeightedData[run[[3,All,1]],run[[3,All,2]]];(* Only in case of histogram-type file input *)
gridsize=Max[1,Mean[uni]/100];
labels="t = "<>ToString[NumberForm[N[#/run[[1,1]]],{3,1}]]<>" n"&/@run[[2,choices,1]];
wd=run[[2,choices,2]];
wd=Map[WeightedData[#[[All,1]],#[[All,2]]]&,wd];(* Only in case of histogram-type file input *)
Show[
SmoothHistogram[wd,gridsize,
PlotRange->plotrange,
PlotLegends->Placed[labels,Scaled[{0.7,0.7}]],
Epilog->Text["n = "<>ToString[run[[1,1]]]<>", \[Tau] = "<>ToString[run[[1,2]]],Scaled[{0.15,0.95}]],
ImageSize->300,
Frame->True,
FrameLabel->{"triangles","probability"}
],
SmoothHistogram[uni,gridsize,PlotRange->plotrange,PlotLegends->Placed[{"uniform"},Scaled[{0.7,0.7}]],PlotStyle->{Thick,Black}]]]

normalize[h_]:=Transpose[{h[[All,1]],h[[All,2]]/Total[h[[All,2]]]}];

makeHistogram2[run_,plotrange_,choices_]:=Module[{gridsize,labels,uni,probs},
uni=WeightedData[run[[3,All,1]],run[[3,All,2]]];(* Only in case of histogram-type file input *)
labels="t = "<>ToString[NumberForm[N[#/run[[1,1]]],{3,1}]]<>" n"&/@run[[2,choices,1]];
probs=run[[2,choices,2]];
probs=Map[normalize,probs];
Show[
ListPlot[probs,Joined->True,
PlotRange->plotrange,
PlotLegends->Placed[labels,Scaled[{0.7,0.7}]],
Epilog->Text["n = "<>ToString[run[[1,1]]]<>", \[Tau] = "<>ToString[run[[1,2]]],Scaled[{0.15,0.95}]],
ImageSize->300,
Frame->True,
FrameLabel->{"triangles","probability"}
],
ListPlot[normalize[run[[3]]],Joined->True,PlotRange->plotrange,PlotLegends->Placed[{"uniform"},Scaled[{0.7,0.7}]],PlotStyle->{Thick,Black}]]]

plot1=makeHistogram[gdata[[1,5]],{{3500,7800},{0,0.005}},{10,50,100}]
plot2=makeHistogram2[gdata[[3,5]],{{50,300},{0,0.04}},{10,20,30}]
plot3=makeHistogram2[gdata[[5,5]],{{0,70},{0,0.18}},{5,10,20}]
plot4=makeHistogram[gdata[[1,-1]],Automatic,{50,100,150,200}]


Export[NotebookDirectory[]<>"plots/triangle_distributions_over_time.pdf",plot2]


(* ::Section:: *)
(*Total variation distance*)


(* Get some sort of total variation distance between to sets of samples *)
getTVDistance1[samples1_,samples2_]:=Module[{max,probs1,probs2,binsize},
max=Max[Max[samples1],Max[samples2]];
binsize=Max[1,Floor[Mean[samples2]/500]];
binsize=1;
probs1=BinCounts[samples1,{0,max+binsize,binsize}];
probs1=probs1/Total[probs1];
probs2=BinCounts[samples2,{0,max+binsize,binsize}];
probs2=probs2/Total[probs2];
Total[Abs[probs1-probs2]]/2
]


(* Get some sort of total variation distance between to HistogramList-like objects *)
getTVDistance2[hist1_,hist2_,filterradius_]:=Module[{m,M,probs,probs1,probs2},
m=Min[hist1[[1,1]],hist2[[1,1]]];
M=Max[hist1[[-1,1]],hist2[[-1,1]]];
probs=ConstantArray[0,M-m+1];
probs1=hist1[[All,2]];
If[filterradius>1,probs1=GaussianFilter[probs1,10]]; (* test *) 
probs1=probs1/Total[probs1];
probs2=hist2[[All,2]];
If[filterradius>1,probs2=GaussianFilter[probs2,10]]; (* test *) 
probs2=probs2/Total[probs2];
probs[[1+hist1[[1,1]]-m;;1+hist1[[-1,1]]-m]]+=probs1;
probs[[1+hist2[[1,1]]-m;;1+hist2[[-1,1]]-m]]-=probs2;
Total[Abs[probs]]/2
]


(* ::Subsection:: *)
(*Plots*)


(*getRatios[run_]:=Module[{avg,sd,scalefactor},
avg=Mean[run[[3]]];
sd=StandardDeviation[run[[3]]];
scalefactor=1/(run[[1,1]]*Log[2,run[[1,1]]]^(1*(4-run[[1,2]])));
{"n,tau = "<>ToString[run[[1]]],
Map[{#[[1]]*scalefactor,Mean[#[[2]]]/avg}&,run[[2]]],
Map[{#[[1]]*scalefactor,(Mean[#[[2]]]-avg)/sd}&,run[[2]]],
}
]
ratios=Map[getRatios,gdata,{2}];
(*Map[ListPlot[#[[All,2]],Joined->True,PlotMarkers->Automatic,PlotRange->(1+{-0.15,+0.15}),PlotLegends->#[[All,1]],ImageSize->300]&,ratios]*)
(*Map[ListPlot[#[[All,3]],Joined->True,PlotMarkers->Automatic,PlotRange->(0+{-1,+1}),PlotLegends->#[[All,1]],ImageSize->300]&,ratios]*)
*)
getTVDs[run_]:=Module[{scaling},
scaling[step_,n_,tau_]:=step/(n*Log[n]^(4-tau));
{"n = "<>ToString[run[[1,1]]],"\[Tau] = "<>ToString[run[[1,2]]],
Map[{scaling[#[[1]],run[[1,1]],run[[1,2]]],getTVDistance2[#[[2]],run[[3]],30]}&,run[[2]]]}
]
TVDs=Map[getTVDs,gdata,{2}];


Map[Show[ListPlot[#[[All,3]],
Joined->True,(*PlotMarkers->Automatic,*)
PlotLegends->Placed[#[[All,1]],Center],ImageSize->500,
PlotRange->{0,1},Frame->True,FrameLabel->{"steps / (n (\!\(\*SubscriptBox[\(log\), \(2\)]\)n\!\(\*SuperscriptBox[\()\), \(4 - \[Tau]\)]\))","TV distance"},
PlotLabel->#[[1,2]]
],
Plot[{0.1,0.05},{x,0,20},PlotStyle->Directive[Black,Dashed]]
]&,TVDs]


(* ::Subsection:: *)
(*Mixing time from TV distance*)


getMixingTime[run_]:=Module[{i=1,timestamp=0,prevtimestamp=0},
While[i<=Length[run[[2]]],
    timestamp=run[[2,i,1]];
    If[getTVDistance2[run[[2,i,2]],run[[3]],20]<=0.1,
        Break[];
    ];
    prevtimestamp=timestamp;
    i++;
];
{run[[1,1]],run[[1,2]],prevtimestamp, timestamp} (* Range in which mixingtime lies *)
]
mixingtimes=Map[getMixingTime,gdata,{2}];


scaling[n_,tau_]:=n*Log[2,n]^(4-tau);
scaling[n_,tau_]:=n;
scaling[n_,tau_]:=n*Log[2,n]^1.5;

plotData=Map[{#[[1]],#[[4]]/scaling[#[[1]],#[[2]]]}&,mixingtimes,{2}]~Join~Map[{#[[1]],#[[3]]/scaling[#[[1]],#[[2]]]}&,mixingtimes,{2}];
fillings={1->{6},2->{7},3->{8},4->{9},5->{10}};
taulabels=Map["\[Tau] = "<>ToString[#[[1,2]]]&,mixingtimes];
ListPlot[plotData,
Joined->True,PlotMarkers->Automatic,ImageSize->500,
PlotRange->All,
PlotLegends->taulabels,
Filling->fillings,PlotStyle->{Automatic,Automatic,Automatic,Automatic,Automatic,None,None,None,None,None},
Frame->True,FrameLabel->{"n","ETMT / n"}]