WOLFRAM NOTEBOOK

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[]=
5
10
15
20
25
-0.5
0.5
1.0
1.5
2.0
2.5
3.0

Summary:

[[ Note : 1 on x axis should be 0 ]]

Tests

Torus

Buckyball

Sierpinski

Wolfram Cloud

You are using a browser not supported by the Wolfram Cloud

Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.


I understand and wish to continue anyway »

You are using a browser not supported by the Wolfram Cloud. Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.