Files @ 2ba81931a724
Branch filter:

Location: AENC/switchchain/triangle_creation_frequency_plots.m

2ba81931a724 7.0 KiB application/vnd.wolfram.mathematica.package Show Annotation Show as Raw Download as Raw
Tom Bannink
Add canonical timeevol file
(* ::Package:: *)

Needs["ErrorBarPlots`"]


(* ::Section:: *)
(*Data import*)


gsraw=Import[NotebookDirectory[]<>"data/graphdata_timeevol.m"];
(* gsraw=SortBy[gsraw,{#[[1,1]]&,#[[1,2]]&}]; (* Sort by n and then by tau. The {} forces a *stable* sort because otherwise Mathematica sorts also on triangle count and other things. *) *)


gdata=GatherBy[gsraw,{#[[1,2]]&,#[[1,1]]&}];
(* Data format: *)
(* gdata[[ tau index, n index, run index , datatype index ]] *)
(* datatype index:
1: {n,tau}
2: #triangles time sequence
3: degree sequence
*)
nlabels=Map["n = "<>ToString[#]&,gdata[[1,All,1,1,1]]];
taulabels=Map["tau = "<>ToString[#]&,gdata[[All,1,1,1,2]]];


(* Get the runs that have the same degree sequence *)
gdata2=GatherBy[gsraw,{#[[1,2]]&,#[[1,1]]&,#[[3]]&}];
(* gdata[[ tau index, n index, ds run index, MC run index , datatype index ]] *)


(* ::Section:: *)
(*Triangle creation frequencies*)


(* ::Subsection:: *)
(*Plot triangle count over "time" in Markov chain instances*)


numPlots=20;
selectedData=gdata[[1,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/500]]; (* 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];
ListPlot[coarseData,Joined->True,PlotRange->{0*minCount,maxCount},DataRange->{0,measureSkip*maxTime},PlotLegends->labels]
(* Map[ListPlot[#,Joined->True,PlotRange\[Rule]{minCount,maxCount},DataRange\[Rule]{0,maxTime}]&,coarseData] *)


differences=Map[Differences[#[[2,25000;;-1]]]&,gdata2,{4}];
differences=Map[Flatten,differences,{3}];


(* For each (n,tau) take 2 degree sequences *)
histograms1=Map[Histogram[#[[{2,1}]],{-25.5,25.5,1},{"Log","Probability"},ImageSize->280]&,differences,{2}];


(* For each (n,tau) take the average over all degree sequences *)
histograms2=Map[Histogram[Flatten[#],{-3.5,3.5,1},"Probability",PlotRange->{0,1},LabelingFunction->(Placed[NumberForm[#,{2,3}],Above]&),ImageSize->280]&,differences,{2}];


TableForm[histograms2,TableHeadings->{taulabels,nlabels}]


{h1,h2,h3}={
Show[histograms1[[2]],PlotLabel->"n=1000, \[Tau]=2.2"],
Show[histograms1[[5]],PlotLabel->"n=1000, \[Tau]=2.5"],
Show[histograms1[[8]],PlotLabel->"n=1000, \[Tau]=2.8"]};
{h1zoomed,h2zoomed,h3zoomed}={
Show[histograms2[[2]],PlotLabel->"n=1000, \[Tau]=2.2"],
Show[histograms2[[5]],PlotLabel->"n=1000, \[Tau]=2.5"],
Show[histograms2[[8]],PlotLabel->"n=1000, \[Tau]=2.8"]};
hcol=GraphicsGrid[Transpose[{{h1,h2,h3},{h1zoomed,h2zoomed,h3zoomed}}]]


Export[NotebookDirectory[]<>"plots/triangle_creation_frequencies_log.pdf",hcol]


(* ::Section:: *)
(*Canonical dataset*)


(* Taken from stackoverflow *)
ClearAll[chartColors];
chartColors::usage="plotColors[plotType,plotTheme] gives a list of the colors used in a plot when several curves are drawn. Here plotType is, for example, Plot or ListLogPlot while plotTheme may be \"Scientific\", \"Classic\" etc.";
chartColors[chartType_,plotTheme_]:=("ChartDefaultStyle"/.(Method/.Charting`ResolvePlotTheme[plotTheme,chartType]))/.Directive[x_,__]:>x
cl1=chartColors[Histogram,$PlotTheme]


gsraw=Import[NotebookDirectory[]<>"data/graphdata_canonical_creationfreqs.m"];
(* gsraw=SortBy[gsraw,{#[[1,1]]&,#[[1,2]]&}]; (* Sort by n and then by tau. The {} forces a *stable* sort because otherwise Mathematica sorts also on triangle count and other things. *) *)


gdata=gsraw;
(* Data format: *)
(* gdata[[ tau index , datatype index ]] *)
(* datatype index:
1: {n,tau}
2: {{delta1, freq1}, {delta2, freq2}, ... }
3: {successful moves, move attemps}
*)


ticks={{1,1}}~Join~Map[{10^-#,Superscript[10,-#]}&,Range[1,9]];
histogramData=Map[WeightedData[#[[All,1]],#[[All,2]]]&,gdata[[All,2]]];
largeHistogram=Histogram[histogramData,{-100-0.5,100+0.5,1},{"Log","Probability"},
PlotRange->{Automatic,Automatic},
ChartLegends->Placed[{"\[Tau] = 2.1","\[Tau] = 2.5","\[Tau] = 2.9"},Scaled[{0.8,0.75}]],
ChartStyle->cl1,
FrameTicks->{{ticks,None},{Automatic,None}},
PlotLabel->"n = 10000",
FrameLabel->{"net triangles created by a switch","Probability"},
Frame->True,ImageSize->265,AspectRatio->1]


Export[NotebookDirectory[]<>"plots/triangle_creation_frequencies_large.pdf",largeHistogram]


createCalloutPlotNew[freqs_,bottomTicks_,epilog_,color_]:=Module[{total,plotrange,ticks,h,probs,cpos,callouts,llp,range=501},
total=Total[freqs[[All,2]]];
plotrange={{-7,7},{freqs[[Floor[Length[freqs]/2]-3,2]]/total,0.3+Max[freqs[[All,2]]]/total}};
ticks={{1,1}}~Join~Map[{10^-#,Superscript[10,-#]}&,Range[1,4]];
h=Histogram[WeightedData[freqs[[All,1]],freqs[[All,2]]],{-range-0.5,range+0.5,1},{"Log","Probability"},
PlotRange->plotrange,
PlotRangeClipping->True,
ChartStyle->color,
ImagePadding->{{1,30},{If[bottomTicks==True,15,0.5],0.5}},
Epilog->epilog,
FrameTicks->{{None,ticks},{bottomTicks,None}},
Frame->True,ImageSize->145];

probs=Select[freqs,Abs[#[[1]]]<=2&];
cpos[i_]:=\!\(\*
TagBox[GridBox[{
{"\[Piecewise]", GridBox[{
{"Before", 
RowBox[{"i", "<", "0"}]},
{"After", 
RowBox[{"i", ">", "0"}]},
{"Automatic", "True"}
},
AllowedDimensions->{2, Automatic},
Editable->True,
GridBoxAlignment->{"Columns" -> {{Left}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, "RowsIndexed" -> {}, "Items" -> {}, "ItemsIndexed" -> {}},
GridBoxItemSize->{"Columns" -> {{Automatic}}, "ColumnsIndexed" -> {}, "Rows" -> {{1.}}, "RowsIndexed" -> {}, "Items" -> {}, "ItemsIndexed" -> {}},
GridBoxSpacings->{"Columns" -> {Offset[0.27999999999999997`], {Offset[0.84]}, Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> {Offset[0.2], {Offset[0.4]}, Offset[0.2]}, "RowsIndexed" -> {}, "Items" -> {}, "ItemsIndexed" -> {}},
Selectable->True]}
},
GridBoxAlignment->{"Columns" -> {{Left}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, "RowsIndexed" -> {}, "Items" -> {}, "ItemsIndexed" -> {}},
GridBoxItemSize->{"Columns" -> {{Automatic}}, "ColumnsIndexed" -> {}, "Rows" -> {{1.}}, "RowsIndexed" -> {}, "Items" -> {}, "ItemsIndexed" -> {}},
GridBoxSpacings->{"Columns" -> {Offset[0.27999999999999997`], {Offset[0.35]}, Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> {Offset[0.2], {Offset[0.4]}, Offset[0.2]}, "RowsIndexed" -> {}, "Items" -> {}, "ItemsIndexed" -> {}}],
"Piecewise",
DeleteWithContents->True,
Editable->False,
SelectWithContents->True,
Selectable->False]\);
callouts=Map[Callout[{#[[1]],#[[2]]/total},NumberForm[N[#[[2]]/total],{2,3}],cpos[#[[1]]]]&,probs];
llp=ListLogPlot[callouts,PlotStyle->None,PlotRange->plotrange];
Show[h,llp]
]


histograms3={
createCalloutPlotNew[gdata[[1,2]],None,Text["\[Tau] = 2.1",Scaled[{0.85,0.9}]],cl1[[1]]],
createCalloutPlotNew[gdata[[2,2]],None,Text["\[Tau] = 2.5",Scaled[{0.85,0.9}]],cl1[[2]]],
createCalloutPlotNew[gdata[[3,2]],True,Text["\[Tau] = 2.9",Scaled[{0.85,0.9}]],cl1[[3]]]
};
plotcol=Column[histograms3,Spacings->0]


combiplot=Row[{largeHistogram,plotcol}]


Export[NotebookDirectory[]<>"plots/triangle_creation_frequencies_combiplot.pdf",combiplot]