Changeset - ea18a7bd1a0d
[Not reviewed]
0 2 0
Tom Bannink - 8 years ago 2017-07-03 17:22:59
tombannink@gmail.com
Plot log version of exponential fit for mixing time
2 files changed with 15 insertions and 3 deletions:
0 comments (0 inline, 0 general)
triangle_analysis.m
Show inline comments
 
@@ -165,102 +165,114 @@ ListPlot[coarseData,Joined->True,PlotRange->{0*minCount,maxCount},DataRange->{0,
 

	
 
selectedData=gdata[[1,1]];
 
measureSkip=1;
 
minCount=Min[Map[Min[#[[2]]]&,selectedData]];
 
maxCount=Max[Map[Max[#[[2]]]&,selectedData]];
 
maxTime=Max[Map[Length[#[[2]]]&,selectedData]];
 
maxTime=30000;
 
skipPts=Max[1,Round[maxTime/100]]; (* Plotting every point is slow. Plot only once per `skipPts` timesteps *)
 
coarseData=Map[#[[2,1;;maxTime;;skipPts]]&,selectedData];
 
labels=Map["{n,tau} = "<>ToString[#[[1]]]&,selectedData];
 
plot1=ListPlot[coarseData[[1;;5]],Joined->True,PlotRange->{0*minCount,maxCount},DataRange->{0,measureSkip*maxTime}]
 
plot2=ListPlot[coarseData[[6;;10]],Joined->True,PlotRange->{0*minCount,maxCount},DataRange->{0,measureSkip*maxTime}]
 
plot3=ListPlot[coarseData[[11;;15]],Joined->True,PlotRange->{0*minCount,maxCount},DataRange->{0,measureSkip*maxTime}]
 
plot4=ListPlot[coarseData[[16;;20]],Joined->True,PlotRange->{0*minCount,maxCount},DataRange->{0,measureSkip*maxTime}]
 

	
 

	
 
(* For export *)
 
numPlots=20;
 
selectedData=gdata[[2,1]][[-numPlots;;-1]];
 
measureSkip=1;
 
minCount=Min[Map[Min[#[[2]]]&,selectedData]];
 
maxCount=Max[Map[Max[#[[2]]]&,selectedData]];
 
maxTime=Max[Map[Length[#[[2]]]&,selectedData]];
 
(* maxTime=30000; *)
 
skipPts=Max[1,Round[maxTime/5000]]; (* Plotting every point is slow. Plot only once per `skipPts` timesteps *)
 
coarseData=Map[#[[2,1;;maxTime;;skipPts]]&,selectedData];
 
labels=Map["{n,tau} = "<>ToString[#[[1]]]&,selectedData];
 
plotTimeEvol=ListPlot[coarseData,Joined->True,PlotRange->{0*minCount,maxCount},DataRange->{0,measureSkip*maxTime},Frame->True,FrameLabel->{"timesteps","number of triangles"},ImageSize->300]
 
(* Map[ListPlot[#,Joined->True,PlotRange\[Rule]{minCount,maxCount},DataRange\[Rule]{0,maxTime}]&,coarseData] *)
 

	
 

	
 
Export[NotebookDirectory[]<>"plots/timeevol.pdf",plotTimeEvol]
 

	
 

	
 
movingAvg=Map[MovingAverage[#[[2]],2000][[1;;-1;;skipPts]]-Mean[#[[2,-20000;;-1]]]&,selectedData[[1;;-1;;5]]];
 
plotMovingAvg=ListPlot[movingAvg,Joined->True,PlotRange->All,DataRange->{0,measureSkip*maxTime},Frame->True,FrameLabel->{"timesteps","number of triangles"}]
 

	
 

	
 
(* ::Subsection:: *)
 
(*Fit exponential to triangles time evolution*)
 

	
 

	
 
fitList=Map[NonlinearModelFit[#[[2]],Exp[-(t-t0)/tmix]+c,{{tmix,1000},{t0,10000},{c,2000}},t]&,selectedData];
 
(* tmix*Log[1/epsilon] gives the time it takes to get a factor epsilon close to the average *)
 
(* t0 gives the time it takes to be exactly 1 triangle (in absolute value) away from the average *)
 
(* Use fit["BestFitParameters"] to get parameters *)
 
(* Use fit[t] to get fit value *)
 
fitFuncsT=Map[#[t]&,fitList];
 
tmixList=Map[tmix/.#["BestFitParameters"]&,fitList];
 

	
 

	
 
timeplot1=ListPlot[coarseData,Joined->True,PlotRange->{0*minCount,maxCount},DataRange->{0,measureSkip*maxTime},PlotStyle->Opacity[0.5]];
 
Show[timeplot1,Plot[fitFuncsT,{t,1,maxTime},PlotRange->All]]
 

	
 

	
 
(* Log version of exponential fits *)
 
fitAverages=Map[c/.#["BestFitParameters"]&,fitList];
 
shiftedFitFuncsT=MapIndexed[#1[t]-fitAverages[[#2[[1]]]]&,fitList];
 
shiftedCoarseData=MapIndexed[MovingAverage[#1[[2]],1000][[1;;-1;;skipPts]]-fitAverages[[#2[[1]]]]&,selectedData];
 

	
 

	
 
(* Plot log version *)
 
timeplot2=ListLogPlot[shiftedCoarseData[[1;;5]],Joined->True,PlotRange->{0*minCount+0.1,maxCount},DataRange->{0,measureSkip*maxTime},PlotStyle->Opacity[0.5]];
 
Show[timeplot2,LogPlot[Evaluate[shiftedFitFuncsT[[1;;5]]],{t,1,maxTime},PlotRange->All,PlotStyle->Dotted]]
 

	
 

	
 
(* ::Subsection:: *)
 
(*Plot success rate over "time"*)
 

	
 

	
 
numPlots=10;
 
selectedData=gdata[[1,-1]][[-numPlots;;-1]];
 
measureSkip=100;
 
maxTime=Max[Map[Length[#[[4]]]&,selectedData]];
 
maxTime=10000;
 
coarseData=Map[#[[4,1;;maxTime/measureSkip]]&,selectedData];
 
labels=Map["{n,tau} = "<>ToString[#[[1]]]&,selectedData];
 
ListPlot[coarseData,Joined->True,PlotRange->{0,100},DataRange->{0,maxTime},PlotLegends->labels]
 
(* Map[ListPlot[#,Joined->True,PlotRange\[Rule]{minCount,maxCount},DataRange\[Rule]{0,maxTime}]&,coarseData] *)
 

	
 

	
 
(* ::Subsection:: *)
 
(*Correlation of avgsuccess rate vs other things*)
 

	
 

	
 
compare1=Map[{Mean[#[[4]]],Mean[#[[2]]]}&,gdata,{3}];
 
(* { GCM1 rate, GCM2 rate, mixing time from ErdosGallai } *)
 

	
 

	
 
scatterPlots=Map[ListPlot[#,PlotRange->{{0,100},All},PlotStyle->PointSize[Large]]&,compare1,{2}];
 
TableForm[scatterPlots,TableHeadings->{taulabels,nlabels}]
 

	
 

	
 
(* ::Subsection:: *)
 
(*Compute 'mixing time'*)
 

	
 

	
 
(* Compute average of last part and check when the value drops below that for the first time *)
 
getMixingTime[values_]:=Module[{avg},
 
    (* average over the last 20 percent *)
 
    avg=Mean[values[[-Round[Length[values]/5];;-1]]];
 
    FirstPosition[values,_?(#<=avg&)][[1]]
 
]
 
(* Get fit of Exp[-t/tmix] *)
 
getMixingTime2[values_]:=Module[{avg,etmt,fitVals},
 
    (* average over the last 20 percent *)
 
    avg=Mean[values[[-Round[Length[values]/5];;-1]]];
 
    etmt=FirstPosition[values,_?(#<=avg&)][[1]];
 
    fitVals=FindFit[values,Exp[-(t-t0)/tmix]+tavg,{{tmix,etmt/4},{t0,2*etmt},{tavg,avg}},t];
 
    tmix/.fitVals
 
(* tmix*Log[1/epsilon] gives the time it takes to get a factor epsilon close to the average *)
 
(* t0 gives the time it takes to be exactly 1 triangle (in absolute value) away from the average *)
 
]
 
(* gdata[[ tau index, n index, run index , {ntau, #tris, ds} ]] *)
triangle_exponent_plots.m
Show inline comments
 
@@ -46,55 +46,55 @@ ListLogLogPlot[averagesErrorBars[[All,All,1]],Joined->True,PlotMarkers->Automati
 
ListLogLogPlot[mediansErrorBars[[All,All,1]],Joined->True,PlotMarkers->Automatic,AxesLabel->{"n","median triangles"},PlotLegends->taulabels]
 

	
 

	
 
(* ::Subsection:: *)
 
(*Fitting the log-log-plot*)
 

	
 

	
 
nRange=5;;-1;
 
nRange=All;
 

	
 
averagesLoglogdata=Log[averagesErrorBars[[All,nRange,1]]];
 
mediansLoglogdata=Log[mediansErrorBars[[All,nRange,1]]];
 
averagesFits=Map[Fit[#,{1,logn},logn]&,averagesLoglogdata];
 
averagesFitsExtra=Map[LinearModelFit[#,logn,logn]&,averagesLoglogdata];
 
mediansFits=Map[Fit[#,{1,logn},logn]&,mediansLoglogdata];
 
mediansFitsExtra=Map[LinearModelFit[#,logn,logn]&,mediansLoglogdata];
 

	
 

	
 
averagesFitsExtra[[1]]["ParameterConfidenceIntervalTable"]
 
averagesFitsExtra[[1]]["BestFitParameters"]
 
averagesFitsExtra[[1]]["ParameterErrors"]
 
averagesFitsExtra[[1]]["ParameterConfidenceIntervals"]
 

	
 

	
 
plot1a=Show[ListLogLogPlot[averagesErrorBars[[All,All,1]],Joined->False,PlotMarkers->Automatic,AxesLabel->{"n","\[LeftAngleBracket]triangles\[RightAngleBracket]"},PlotLegends->taulabels],Plot[averagesFits,{logn,1,2000}]]
 
plot1b=Show[ListLogLogPlot[mediansErrorBars[[All,All,1]],Joined->False,PlotMarkers->Automatic,AxesLabel->{"n","median triangles"},PlotLegends->taulabels],Plot[mediansFits,{logn,1,2000}]]
 

	
 

	
 
Export[NotebookDirectory[]<>"plots/avgtris_n.pdf",plot1]
 

	
 

	
 
(* ::Subsection:: *)
 
(*Plot of T(\[Tau])*)
 

	
 

	
 
tauValues=averagesGrouped[[All,1,1,1,2]];
 
averagesExponents=Transpose[{tauValues,averagesFits[[All,2,1]]}];
 
mediansExponents=Transpose[{tauValues,mediansFits[[All,2,1]]}];
 
Show[ListPlot[{averagesExponents,mediansExponents},Joined->True,PlotMarkers->Automatic,AxesLabel->{"tau","exponent"},PlotRange->{{2,3},{0,1.6}}],Plot[3/2(3-tau),{tau,2,3}]]
 

	
 

	
 
(* ::Subsection:: *)
 
(*T(\[Tau]) including error bars*)
 

	
 

	
 
(* For visual, shift the tau values slightly left or right to distinguish the two datasets *)
 
tauValues=averagesGrouped[[All,1,1,1,2]];
 
averagesExponentsErrorBars=Map[{{#[[1]],#[[2]]["BestFitParameters"][[2]]},ErrorBar[#[[2]]["ParameterConfidenceIntervals"][[2]]-#[[2]]["BestFitParameters"][[2]]]}&,
 
Transpose[{tauValues-0.005,averagesFitsExtra}]];
 
Transpose[{tauValues-0.001,averagesFitsExtra}]];
 
mediansExponentsErrorBars=Map[{{#[[1]],#[[2]]["BestFitParameters"][[2]]},ErrorBar[#[[2]]["ParameterConfidenceIntervals"][[2]]-#[[2]]["BestFitParameters"][[2]]]}&,
 
Transpose[{tauValues+0.005,mediansFitsExtra}]];
 
plot4=Show[ErrorListPlot[{averagesExponentsErrorBars,mediansExponentsErrorBars},Joined->True,PlotMarkers->Automatic,Frame->True,FrameLabel->{"tau","triangle exponent"},PlotRange->{{2,3},{0,1.6}},ImageSize->300],Plot[3/2(3-tau),{tau,2,3},PlotStyle->{Dashed}]]
 
Transpose[{tauValues+0.001,mediansFitsExtra}]];
 
plot2=Show[ErrorListPlot[{averagesExponentsErrorBars,mediansExponentsErrorBars},Joined->True,PlotMarkers->Automatic,Frame->True,FrameLabel->{"tau","triangle exponent"},PlotRange->{{2,3},{0,1.6}},ImageSize->300],Plot[3/2(3-tau),{tau,2,3},PlotStyle->{Dashed}]]
 

	
 

	
 
Export[NotebookDirectory[]<>"plots/triangle_exponent.pdf",plot2]
0 comments (0 inline, 0 general)