In[]:=
RandomGeodesic[gx_,n_Integer:1]:=With[{g=IndexGraph[gx,EdgeStyleLightGray,VertexStyleLightGray]},With[{spf=FindShortestPath[g,All,All],vl=VertexList[g]},HighlightGraph[g,Table[Style[PathGraph[spf[RandomChoice[vl],RandomChoice[vl]]],Thick,RandomColor[]],n]]]]
In[]:=
plot=Plot3D[Exp[-(x^2+y^2)],{x,-4,4},{y,-4,4},PlotRangeAll,BoxRatios{1,1,1/4}]
Out[]=
In[]:=
gplot=GraphicsMetricGraph[plot];
In[]:=
GraphPlot3D[RandomGeodesic[gplot,10]]
Out[]=
? Measure curvature at various points....
In[]:=
GraphCenter[gplot]
Out[]=
{{0,109},{0,111},{0,1749},{0,2101},{0,3616}}
In[]:=
HighlightGraph[gplot,%375,VertexSize100,VertexStyleRed]
Out[]=
In[]:=
GraphPlot3D[%]
Out[]=
In[]:=
HypergraphDimensionEstimateList[List@@@EdgeList[IndexGraph[gplot]]]
Out[]=
In[]:=
ListLinePlot[%]
Out[]=
In[]:=
hgx=List@@@EdgeList[IndexGraph[gplot]];
In[]:=
Take[hgx,3]
Out[]=
{{1,2},{1,3},{1,6030}}
In[]:=
HypergraphNeighborhoodVolumes[hgx,{200}]
Out[]=
200{1,6,17,36,65,99,143,192,252,316,389,473,567,667,773,884,1012,1141,1277,1435,1594,1770,1961,2148,2323,2489,2662,2830,3000,3184,3377,3576,3776,3972,4186,4397,4590,4762,4921,5066,5202,5324,5438,5549,5640,5705,5766,5824,5876,5922,5963,5991,6018,6038,6052,6067,6083,6086}
In[]:=
LogDifferences[First[Values[HypergraphNeighborhoodVolumes[hgx,{200}]]]]//N
Out[]=
{2.58496,2.56854,2.60811,2.64793,2.30764,2.38549,2.2066,2.30877,2.14799,2.18064,2.24702,2.26459,2.19181,2.13774,2.07904,2.23056,2.09902,2.08275,2.2742,2.15375,2.25135,2.30531,2.14012,1.91863,1.75982,1.7805,1.68279,1.66239,1.75585,1.79475,1.80345,1.76852,1.69512,1.81029,1.74566,1.56785,1.37946,1.26442,1.14701,1.07286,0.961995,0.900382,0.878939,0.723821,0.52136,0.494537,0.475396,0.431099,0.385986,0.348412,0.241251,0.236066,0.1775,0.126217,0.137384,0.148803,0.02835}
In[]:=
ListLinePlot[%]
Out[]=

Flatter case

Metrics