(* ::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]