Correlation Functions
Correlation Functions
In[]:=
GraphCorrelationFunction[g_,2]:=Module[{gg=IndexGraph[UndirectedGraph[g]],gnv,vl,gdist},gnv=GraphNeighborhoodVolumes[g,All,Automatic];vl=VertexList[gg];gdist=GraphDistanceMatrix[gg];KeySort[Mean/@(Map[Last]/@GroupBy[{gdist[[#1,#2]],gnv[#1]gnv[#2]}&@@@Tuples[{vl,vl}],First])]]
In[]:=
GraphCorrelationFunction[g_,1]:=Module[{gg=IndexGraph[UndirectedGraph[g]],gnv,vl,gdist},Mean[GraphNeighborhoodVolumes[g,All,Automatic]^2]]
In[]:=
MeanVR[g_]:=Mean[Values[GraphNeighborhoodVolumes[UndirectedGraph[g],All,Automatic]]]
In[]:=
With[{w=MeanVR[gtest]},#-w^2&/@GraphCorrelationFunction[gtest,2]]//N
Out[]=
In[]:=
ListLogPlot[Abs[Transpose[Values[%273]]],JoinedTrue]
Out[]=
In[]:=
With[{gtest=UndirectedGraph[Rule@@@WolframModel[{{x,y},{x,z}}{{x,z},{x,w},{y,w},{z,w}},{{1,2},{1,3}},11,"FinalState"]]},With[{w=MeanVR[gtest]},#-w^2&/@GraphCorrelationFunction[gtest,2]]//N]
Out[]=
In[]:=
ListPlot[Take[Transpose[Values[%277]],7],JoinedTrue]
Out[]=
In[]:=
Take[Transpose[Values[%277]],7]
Out[]=
In[]:=
ListLinePlot[Take[%,4]]
Out[]=
In[]:=
With[{gtest=UndirectedGraph[Rule@@@WolframModel[{{x,y},{x,z}}{{x,z},{x,w},{y,w},{z,w}},{{1,2},{1,3}},12,"FinalState"]]},With[{w=MeanVR[gtest]},#-w^2&/@GraphCorrelationFunction[gtest,2]]//N]
Out[]=
In[]:=
Take[Transpose[Values[%]],5]
Out[]=
In[]:=
ListLinePlot[%286[[2]]]
Out[]=
Summary:
Summary:
[[ Note : 1 on x axis should be 0 ]]
Tests
Tests
Torus
Torus
Buckyball
Buckyball
Sierpinski
Sierpinski