Files @ 5027d9d4aa05
Branch filter:

Location: AENC/switchchain/triangle_canonical_mixingtime.m

5027d9d4aa05 2.0 KiB application/vnd.wolfram.mathematica.package Show Annotation Show as Raw Download as Raw
Tom Bannink
Add new mixingtime method
(* ::Package:: *)

gsraw=Import[NotebookDirectory[]<>"data/graphdata_canonical_mixingtime.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}} , ... }
3: {uniform samples}
*)


choices={1,2,3,6,8,12,14};
(*Histogram[histogramdata[[All,2]],Automatic,"Probability",ChartLegends\[Rule]histogramdata[[All,1]]]*)

makeHistogram[run_,choices_]:=Module[{gridsize,labels},
gridsize=Max[0.5,Mean[run[[3]]]/200];
labels="t = "<>ToString[#/run[[1,1]]]<>"\[CenterDot]n"&/@run[[2,choices,1]];
Show[
SmoothHistogram[run[[2,choices,2]],gridsize,PlotRange->{All,Automatic},PlotLegends->labels,PlotLabel->"n = "<>ToString[run[[1,1]]],ImageSize->500],
SmoothHistogram[run[[3]],gridsize,PlotLegends->{"uniform"},PlotStyle->{Thick,Black}]]]

makeHistogram[gdata[[1,-1]],choices]
makeHistogram[gdata[[-1,-1]],choices]


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


getRatios[run_]:=Module[{avg,sd,scalefactor},
avg=Mean[run[[3]]];
sd=StandardDeviation[run[[3]]];
scalefactor=1/(run[[1,1]]*Log[run[[1,1]]]^0);
{"n,tau = "<>ToString[run[[1]]],
Map[{#[[1]]*scalefactor,Mean[#[[2]]]/avg}&,run[[2]]],
Map[{#[[1]]*scalefactor,(Mean[#[[2]]]-avg)/sd}&,run[[2]]],
Map[{#[[1]]*scalefactor,getTVDistance[#[[2]],run[[3]]]}&,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]
Map[ListPlot[#[[All,4]],Joined->True,PlotMarkers->Automatic,PlotRange->({0,1}),PlotLegends->#[[All,1]],ImageSize->300]&,ratios]