In[]:=
HypergraphDimensionEstimateListX[hg_]:=N[Log[#]/Log[1+Range[Length[#]]]]&[Rest[MeanAround/@Transpose[Values[HypergraphNeighborhoodVolumes[hg,All,Automatic]]]]]
In[]:=
ListLinePlot[Select[Length[#]>3&][HypergraphDimensionEstimateList/@Drop[WolframModel[{{x,y},{x,z}}{{x,z},{x,w},{y,w},{z,w}},{{1,2},{1,3}},16,"StatesList"],4]],FrameTrue]
Log[
In[]:=
ListLinePlot[Select[Length[#]>3&][HypergraphDimensionEstimateListX/@Drop[WolframModel[{{x,y},{x,z}}{{x,z},{x,w},{y,w},{z,w}},{{1,2},{1,3}},12,"StatesList"],4]],FrameTrue]
Out[]=
In[]:=
griddimX[d_,s_]:=N[Log[#]/Log[1+Range[Length[#]]]]&[Rest[N[First[Values[GraphNeighborhoodVolumes[GridGraph[Table[s,d]],GraphCenter[GridGraph[Table[s,d]]]]]]]]]
In[]:=
griddimR[d_,s_]:=Rest[N[First[Values[GraphNeighborhoodVolumes[GridGraph[Table[s,d]],GraphCenter[GridGraph[Table[s,d]]]]]]]]
In[]:=
griddimR[2,51]
Out[]=
{5.,13.,25.,41.,61.,85.,113.,145.,181.,221.,265.,313.,365.,421.,481.,545.,613.,685.,761.,841.,925.,1013.,1105.,1201.,1301.,1401.,1497.,1589.,1677.,1761.,1841.,1917.,1989.,2057.,2121.,2181.,2237.,2289.,2337.,2381.,2421.,2457.,2489.,2517.,2541.,2561.,2577.,2589.,2597.,2601.}
In[]:=
Table[yy[r],{r,20}]
Out[]=
{5,13,25,41,61,85,113,145,181,221,265,313,365,421,481,545,613,685,761,841}
In[]:=
Log[%]
Out[]=
{1.60944,2.56495,3.21888,3.71357,4.11087,4.44265,4.72739,4.97673,5.1985,5.39816,5.57973,5.7462,5.8999,6.04263,6.17587,6.30079,6.41836,6.52942,6.63463,6.73459,6.82979,6.92067,7.0076,7.09091,7.17089,7.24494,7.31122,7.37086,7.42476,7.47364,7.51806,7.55852,7.59539,7.629,7.65964,7.68754,7.71289,7.73587,7.75662,7.77528,7.79194,7.8067,7.81964,7.83082,7.84031,7.84815,7.85438,7.85903,7.86211,7.86365}
In[]:=
Log[1+Range[Length[%]]]//N
Out[]=
{0.693147,1.09861,1.38629,1.60944,1.79176,1.94591,2.07944,2.19722,2.30259,2.3979,2.48491,2.56495,2.63906,2.70805,2.77259,2.83321,2.89037,2.94444,2.99573,3.04452,3.09104,3.13549,3.17805,3.21888,3.2581,3.29584,3.3322,3.3673,3.4012,3.43399,3.46574,3.49651,3.52636,3.55535,3.58352,3.61092,3.63759,3.66356,3.68888,3.71357,3.73767,3.7612,3.78419,3.80666,3.82864,3.85015,3.8712,3.89182,3.91202,3.93183}
In[]:=
%119/%120
Out[]=
{2.32193,2.33472,2.32193,2.30737,2.29432,2.28307,2.27339,2.26501,2.25768,2.25121,2.24545,2.24028,2.23561,2.23136,2.22747,2.2239,2.2206,2.21754,2.2147,2.21204,2.20954,2.2072,2.205,2.20291,2.20094,2.19821,2.19411,2.18896,2.18298,2.17637,2.16925,2.16173,2.15389,2.14578,2.13746,2.12897,2.12033,2.11157,2.1027,2.09375,2.0847,2.07559,2.0664,2.05714,2.04781,2.0384,2.02893,2.01937,2.00973,2.}
In[]:=
griddimX[2,51]
Out[]=
{2.32193,2.33472,2.32193,2.30737,2.29432,2.28307,2.27339,2.26501,2.25768,2.25121,2.24545,2.24028,2.23561,2.23136,2.22747,2.2239,2.2206,2.21754,2.2147,2.21204,2.20954,2.2072,2.205,2.20291,2.20094,2.19821,2.19411,2.18896,2.18298,2.17637,2.16925,2.16173,2.15389,2.14578,2.13746,2.12897,2.12033,2.11157,2.1027,2.09375,2.0847,2.07559,2.0664,2.05714,2.04781,2.0384,2.02893,2.01937,2.00973,2.}
In[]:=
ListLinePlot[%]
Out[]=
In[]:=
2+2r+1
2
r
Out[]=
1+2r+2
2
r
In[]:=
yy[r_]:=1+2r+2
2
r
In[]:=
yy[r+1]/yy[r]
Out[]=
1+2(1+r)+2
2
(1+r)
1+2r+2
2
r
In[]:=
Simplify[%]
Out[]=
5+6r+2
2
r
1+2r+2
2
r
In[]:=
TableLogLog[(r+1)/r],{r,20}
5+6r+2
2
r
1+2r+2
2
r
Out[]=
In[]:=
N[%]
Out[]=
{1.37851,1.61278,1.71959,1.78048,1.81974,1.84713,1.86732,1.88281,1.89507,1.90501,1.91324,1.92015,1.92605,1.93113,1.93557,1.93946,1.94291,1.94599,1.94876,1.95126}
In[]:=
ListLinePlot[%]
Out[]=
In[]:=
LogDifferences[Table[yy[r],{r,20}]]//N
Out[]=
{1.37851,1.61278,1.71959,1.78048,1.81974,1.84713,1.86732,1.88281,1.89507,1.90501,1.91324,1.92015,1.92605,1.93113,1.93557,1.93946,1.94291,1.94599,1.94876}
In[]:=
yy[r]
Out[]=
1+2r+2
2
r
In[]:=
LogDifferences[Table[r^2,{r,20}]]//N
Out[]=
{2.,2.,2.,2.,2.,2.,2.,2.,2.,2.,2.,2.,2.,2.,2.,2.,2.,2.,2.}
In[]:=
LogDifferences[griddimR[2,51]]
Out[]=
{1.37851,1.61278,1.71959,1.78048,1.81974,1.84713,1.86732,1.88281,1.89507,1.90501,1.91324,1.92015,1.92605,1.93113,1.93557,1.93946,1.94291,1.94599,1.94876,1.95126,1.95352,1.95558,1.95747,1.95921,1.88811,1.75613,1.63997,1.53604,1.44168,1.3549,1.27415,1.1982,1.12607,1.05697,0.990236,0.925297,0.861675,0.798946,0.736735,0.6747,0.612528,0.549922,0.4866,0.422287,0.35671,0.289597,0.220666,0.149628,0.0761806}
In[]:=
ListLinePlot[%]
Out[]=