Files
@ 3e647eb7b5b3
Branch filter:
Location: AENC/switchchain/triangle_creation_frequency_plots.m - annotation
3e647eb7b5b3
3.4 KiB
application/vnd.wolfram.mathematica.package
Add improved construction rate dataset and plot
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 | 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 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 30d182b86860 | (* ::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]
(* ::Subsection:: *)
(*Test with 'Callout' labels*)
createCalloutPlot[data_]:=Module[{h,hl,bcdata,llp},
h=Histogram[data,{-20.5,20.5,1},{"Log","Probability"},PlotRange->All,ImageSize->280];
hl=HistogramList[data,{-20.5,20.5,1},"Probability"];
bcdata=Map[If[#>=0.01,Callout[#,NumberForm[#,{2,3}]],Clip[#,{10^-5,2}]]&,hl[[2]]];
llp=ListLogPlot[bcdata,PlotStyle->None,DataRange->{-20,20}];
Show[h,llp]
]
histograms3=Map[createCalloutPlot[Flatten[#]]&,differences,{2}];
(* TODO: Somehow the values of these histograms do not match the ones above!!! ????? *)
Show[histograms3[[2]],PlotLabel->"n=1000, \[Tau]=2.2"]
Show[histograms3[[5]],PlotLabel->"n=1000, \[Tau]=2.5"]
Show[histograms3[[8]],PlotLabel->"n=1000, \[Tau]=2.8"]
|