Files @ eba8261885e8
Branch filter:

Location: AENC/switchchain/triangle_creation_frequency_plots.m - annotation

eba8261885e8 7.0 KiB application/vnd.wolfram.mathematica.package Show Source Show as Raw Download as Raw
Tom Bannink
Change trimeevol plot for thesis
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
29857512e53b
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
29857512e53b
29857512e53b
29857512e53b
29857512e53b
29857512e53b
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
5cec3a409ef3
29857512e53b
29857512e53b
29857512e53b
29857512e53b
29857512e53b
29857512e53b
29857512e53b
29857512e53b
29857512e53b
29857512e53b
29857512e53b
29857512e53b
29857512e53b
5cec3a409ef3
5cec3a409ef3
29857512e53b
29857512e53b
29857512e53b
29857512e53b
29857512e53b
29857512e53b
29857512e53b
29857512e53b
29857512e53b
5cec3a409ef3
5cec3a409ef3
29857512e53b
30d182b86860
30d182b86860
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
30d182b86860
30d182b86860
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
30d182b86860
30d182b86860
30d182b86860
30d182b86860
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
7dbca3656ee1
30d182b86860
30d182b86860
7dbca3656ee1
30d182b86860
30d182b86860
7dbca3656ee1
(* ::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]