(* ::Package:: *) Needs["ErrorBarPlots`"] (* ::Section:: *) (*TODO*) (* ::Text:: *) (*- Use different starting point for switch chain that is closer to uniform:*) (* Do configuration model, starting with the vertex with highest degree and keeping track of a "forbidden list" meaning dont pair something that is not allowed*) (* (a) How close is this to uniform ? At least w.r.t. the measure of #triangles*) (* (b) How often does this procedure work/fail. Might still be faster to do switchings from Erdos-Gallai.*) (**) (*- Improve runtime*) (* (a) Don't remove/add edges from the std::vector. Simply replace them*) (* (b) Better direct triangle counting? (I doubt it)*) (* (b') Better triangle counting by only keeping track of CHANGES in #triangles*) (* (c) Do not choose the three permutations with 1/3 probability: choose the "staying" one with a very low probability. Should still be a valid switch chain?*) (**) (*- Experimental mixing time as function of n. At (n,tau)=(1000,2.5) it seems to be between 10.000 and 20.000 steps.*) (**) (*- Count #moves that result in +-k triangles (one move could create many triangles at once!)*) (* ::Subsection:: *) (*Done*) (* ::Text:: *) (*- Do a single very long run: nothing weird seems to happen with the triangle counts. Tried 10 million steps.*) (**) (*- Compute Sum over i"graphdata.m"]; ListPlot[gsraw[[2]],Joined->True,PlotRange->All,AxesLabel->{"Step","Triangles"}] gs=Map[Graph[#,GraphLayout->"CircularEmbedding"]&,gsraw[[1]]]; gs2=Map[Graph[#,GraphLayout->Automatic]&,gsraw[[1]]]; Grid[Partition[gs,10],Frame->All] (* ::Section:: *) (*Plot triangle counts*) (* ::Subsection:: *) (*Data import and data merge*) gsraw=Import[NotebookDirectory[]<>"data/min_deg_two/graphdata_merged.m"]; gsraw=SortBy[gsraw,#[[1,1]]&]; (* Sort by n *) gdata=GatherBy[gsraw,{#[[1,2]]&,#[[1,1]]&}]; (* gdata[[ tau index, n index, run index , {ntau, #tris, ds} ]] *) newData=Import[NotebookDirectory[]<>"graphdata_tau_multi4.m"]; mergedData=Import[NotebookDirectory[]<>"graphdata_merged.m"]; Export[NotebookDirectory[]<>"graphdata_merged_new.m",Join[mergedData,newData]] (* ::Subsection:: *) (*Plot empirical distribution of maximum degree*) maxDegrees=Map[{#[[1]],Max[#[[3]]]}&,gsraw]; maxDegrees=GatherBy[maxDegrees,{#[[1,2]]&,#[[1,1]]&}]; (* maxDegrees[[ tau index, n index, run index, ntau or dmax ]] *) Histogram[maxDegrees[[1,-1,All,2]],PlotRange->{{0,2000},{0,100}},AxesLabel->{"d_max","frequency"}] Histogram[maxDegrees[[2,-1,All,2]],PlotRange->{{0,2000},{0,100}},AxesLabel->{"d_max","frequency"}] Histogram[maxDegrees[[3,-1,All,2]],PlotRange->{{0,2000},{0,100}},AxesLabel->{"d_max","frequency"}] (* ::Subsection:: *) (*Plot #trianges vs some degree-sequence-property*) getProperty[ds1_]:=Module[{ds,n=Length[ds1],tmp=ConstantArray[0,{Length[ds1],Length[ds1]}]}, ds=N[ds1/Sqrt[N[Total[ds1]]]]; (* scale degrees by 1/Sqrt[total] *) (* The next table contains unneeded entries, but its faster to have a square table for the sum *) tmp=Table[1.-Exp[-ds[[i]]ds[[j]]],{i,1,n},{j,1,n}]; Sum[tmp[[i,j]]*tmp[[j,k]]*tmp[[i,k]],{i,3,n},{j,2,i-1},{k,1,j-1}] (* somehow i>j>k is about 60x faster than doing i{0,0},AxesLabel->{"degree-sequence-property","<#triangles>"},AspectRatio->1],Plot[x,{x,1,1000}]] (* ::Subsection:: *) (*Plot triangle count over "time" in Markov chain instances*) numPlots=20; selectedData=gsraw[[-numPlots;;-1]]; minCount=Min[Map[Min[#[[2]]]&,selectedData]]; maxCount=Max[Map[Max[#[[2]]]&,selectedData]]; maxTime=Max[Map[Length[#[[2]]]&,selectedData]]; skipPts=Max[1,Round[maxTime/100]]; (* Plotting every point is slow. Plot only once per `skipPts` timesteps *) coarseData=Map[#[[2,1;;-1;;skipPts]]&,selectedData]; labels=Map["{n,tau} = "<>ToString[#[[1]]]&,selectedData]; ListPlot[coarseData,Joined->True,PlotRange->{minCount,maxCount},DataRange->{0,maxTime},PlotLegends->labels] (* Map[ListPlot[#,Joined->True,PlotRange\[Rule]{minCount,maxCount},DataRange\[Rule]{0,maxTime}]&,coarseData] *) (* ::Subsection:: *) (*Plot average #triangles vs n*) averages=Map[{#[[1]],Mean[#[[2,1;;-1]]]}&,gsraw]; (* averages=SortBy[averages,#[[1,1]]&]; (* Sort by n *) *) averagesGrouped=GatherBy[averages,{#[[1,2]]&,#[[1,1]]&}]; (* Split by n,tau *) (* averagesGrouped[[ tau index, n index, run index , {ntau, avgtri} ]] *) nlabels=Map["n = "<>ToString[#]&,averagesGrouped[[1,All,1,1,1]]]; taulabels=Map["tau = "<>ToString[#]&,averagesGrouped[[All,1,1,1,2]]]; averagesErrorBars=Map[ {{#[[1,1,1]],Mean[#[[All,2]]]}, ErrorBar[StandardDeviation[#[[All,2]]]/Sqrt[Length[#]]] }&,averagesGrouped,{2}]; ErrorListPlot[averagesErrorBars,Joined->True,PlotMarkers->Automatic,AxesLabel->{"n","\[LeftAngleBracket]triangles\[RightAngleBracket]"},PlotLegends->taulabels] ListLogLogPlot[averagesErrorBars[[All,All,1]],Joined->True,PlotMarkers->Automatic,AxesLabel->{"n","\[LeftAngleBracket]triangles\[RightAngleBracket]"},PlotLegends->taulabels] averagesErrorBars=Map[ {{Log[#[[1,1,1]]],Log[Mean[#[[All,2]]]]}, ErrorBar[ (StandardDeviation[#[[All,2]]] )] }&,averagesGrouped,{2}]; (* ::Subsection:: *) (*Fitting the log-log-plot*) loglogdata=Log[averagesErrorBars[[All,All,1]]]; fits=Map[Fit[#,{1,logn},logn]&,loglogdata]; Show[ListLogLogPlot[averagesErrorBars[[All,All,1]],PlotMarkers->Automatic,AxesLabel->{"n","\[LeftAngleBracket]triangles\[RightAngleBracket]"},PlotLegends->taulabels],Plot[fits,{logn,1,2000}]] tauValues=averagesGrouped[[All,1,1,1,2]]; exponents=Transpose[{tauValues,fits[[All,2,1]]}]; Show[ListPlot[exponents,Joined->True,PlotMarkers->Automatic,AxesLabel->{"tau","triangle-law-exponent"}],Plot[3/2(3-tau),{tau,2,3}]] (* ::Subsection:: *) (*Plot #triangles distribution for specific (n,tau)*) plotRangeByTau[tau_]:=Piecewise[{{{0,30000},tau<2.3},{{0,4000},2.32.7}},Automatic] histograms=Map[Histogram[#[[All,2]],PlotRange->{plotRangeByTau[#[[1,1,2]]],Automatic}]&,averagesGrouped,{2}]; nlabels=Map["n = "<>ToString[#]&,averagesGrouped[[1,All,1,1,1]]]; taulabels=Map["tau = "<>ToString[#]&,averagesGrouped[[All,1,1,1,2]]]; (* TableForm[histograms,TableHeadings->{taulabels,nlabels}] *) TableForm[Transpose[histograms],TableHeadings->{nlabels,taulabels}]