Gauss-Bonnet and Poincare-Hopf for Graphs

UnitSphere[s_,a_]:=Module[{b},b=NeighborhoodGraph[s,a];
If[Length[VertexList[b]]<2,Graph[{}],VertexDelete[b,a]]];
Cliques[K_,k_]:=Module[{n,m=Length[EdgeList[K]],s,u,V=VertexList[K],U,Bi},s=Subsets[V,{k,k}];n=Length[V];Bi=Binomial;If[k==1,u=n,If[k==2,u=m,u=Sum[If[Length[EdgeList[Subgraph[K,s[[j]]]]]==Bi[k,2],1,0],{j,Length[s]}]]];u];
X[K_]:=Sum[(-1)^(k-1)Cliques[K,k],{k,1,Length[VertexList[K]]}];

Curvature[s_,v_]:=Module[{s1,k,r},s1=UnitSphere[s,v];vl1=VertexList[s1];n1=Length[vl1];
r=Table[(-1)^k/(k+1),{k,n1}];u=Table[Cliques[s1,k],{k,n1}];1+u.r];
Curvatures[s_]:=Module[{},vl=VertexList[s];Table[Curvature[s,vl[[k]]],{k,Length[vl]}]];

morsefunction[s_]:=Table[2 Random[]-1,{Length[VertexList[s]]}];
index[f_,s_,a_]:=Module[{sp,sv1,sminus,vl,svl},vl=VertexList[s];sp=UnitSphere[s,a];svl=VertexList[sp];sminus={};
Do[If[f[[Position[vl,svl[[k]]][[1,1]]]]-f[[Position[vl,a][[1,1]]]]<0,sminus=Append[sminus,svl[[k]]]],{k,Length[svl]}];
1-X[Subgraph[s,sminus]]];
indices[f_,s_]:=Module[{},vl=VertexList[s];n=Length[vl];Table[index[f,s,vl[[k]]],{k,Length[vl]}]];

F[s_]:=Module[{v,curv,chia,chib,dim,line,a,b,u,Ta,Tb,SS1,SS2,S1,S3a,S3b,S2,f},v={0.2,0.1};
f=Table[k,{k,Length[VertexList[s]]}];ind=indices[f,s];
chia=Sum[ind[[k]],{k,Length[ind]}];curv=Curvatures[s];chib=Sum[curv[[k]],{k,Length[curv]}];
line[{a_,b_}]:={Line[{a,b}]};P=GraphPlot[s,Method->"SpringElectricalEmbedding"][[1,1]];
u=Normal[GraphPlot[s,Method->"SpringElectricalEmbedding"][[1]]][[1,2]];Q=Table[u[[k,1]],{k,Length[u]}];
S1=Graphics[Table[{Red,Disk[P[[k]],0.04]},{k,Length[P]}]];
S3a=Graphics[Table[{RGBColor[0,0.5,0],FontSize->12,Text[ind[[k]],P[[k]]+v]},{k,Length[P]}]];
S3b=Graphics[Table[{RGBColor[0.5,0.5,0],FontSize->12,Text[curv[[k]],P[[k]]+v]},{k,Length[P]}]];
S2=Graphics[{RGBColor[0.4,0.4,1],Thickness[0.005],Table[line[Q[[k]]],{k,Length[Q]}]}];
Ta=Row[{Framed[chia],"=",HoldForm[χ=Sum[i[x],{x,1,Abs[V]}]]}];
Tb=Row[{Framed[chib],"=",HoldForm[χ=Sum[K[x],{x,1,Abs[V]}]]}];
SS1=Show[{S2,S1,S3a},Axes->False,AspectRatio->1,ImageSize->600,PlotLabel->Style[Ta,12,Black,Background->RGBColor[0.5,1,0.5]]];
SS2=Show[{S2,S1,S3b},Axes->False,AspectRatio->1,ImageSize->600,PlotLabel->Style[Tb,12,Black,Background->RGBColor[1,1,0.5]]];
GraphicsGrid[{{SS1,SS2}}]
];
PD=PolyhedronData;
arch=PD["Archimedean"];narch=Length[arch];Garch[k_]:=UndirectedGraph[Graph[PD[arch[[k]],"SkeletonRules"]]];
cata=PD["Archimedean","Dual"];ncata=Length[cata];Gcata[k_]:=UndirectedGraph[Graph[PD[cata[[k]],"SkeletonRules"]]];

Manipulate[Which[r==1,F[CycleGraph[k]],r==2,F[TuranGraph[k,2]],r==3,F[StarGraph[k+2]],r==4,F[PetersenGraph[k,2]],r==5,F[CompleteGraph[k]],r==6,F[KnightTourGraph[k,k]],r==7,F[GridGraph[{k,k}]],r==8,F[Garch[k]],r==9,F[Gcata[k]],r==10,F[ButterflyGraph[k-1]],r==11,F[WheelGraph[k+2]]],{k,3,6,1},{{r,1,"Choose the graph:"},{1->"Cycle",2->"Turan",3->"Star",4->"Petersen",5->"Complete",6->"KnightTour",7->"Grid",8->"Archimedean",9->"Catalan",10->"Butterfly",11->"Wheel"}}]

Choose a graph and adjust the parameter k. You see the graph two times. On the left 
side, the vertices are labeled with the indices. They add up to the Euler characteristic
of the graph. On the right hand side, you see the graph with curvatures.
Also this sum is the Euler characteristic.  The left picture illustrates a Gauss-Bonnet theorem for graphs. The right picture illustrates a Poincare-Hopf theorem for graphs.

Gauss-Bonnet for graphs is covered in  [1] and and [2]. The statistics about curvature and dimension  is covered in [3], where explicit formulas for the average dimension and Euler  characteristic of Erdoes-Renyi probability spaces can be found. Paper [4] proves a Poincare-Hopf theorem for graphs. 

The main ingredients are local quantities curvature K(x) and index i[x] = 1-X(S(x)), where X(G) denotes the Eulercharacteristic of a graph and S(x) is the part of the unit sphere where f is smaller than f(x).

The sum of all curvatures is the Euler characteristic: This is a Gauss-Bonnet-Chern
theorem [2], where it is explored also in a more geometric setting.

The sum of all indices is the Euler characterisic. This is a discrete version of a Poincare-Hopf Theorem [4]

References:

[1] Oliver Knill, "A discrete Gauss-Bonnet type theorem"  http://arxiv.org/abs/1009.2292

[2] Oliver Knill,  "A graph theoretical Gauss-Bonnet-Chern theorem"  http://arxiv.org/abs/1111.5395

[3] Oliver Knill, "On the Dimension and Euler characteristic of random graphs" http://arxiv.org/abs/1112.5749

[4] Oliver Knill, "A graph theoretical Poincare-Hopf Theorem"   http://arxiv.org/abs/1201.1162

Contributed by: Oliver Knill, Harvard University, knill@math.harvard.edu