# Code

Update November 2020:< br /> A blog entry in the Wolfram community page. Mathematica Notebook .nb. In the last couple of years, I added the code directly to the papers so that it can be grabbed from the ArXiv, (where the LaTeX source code remains available). All of my programs are by default in the public domain (but of course, it should be obvious (as with the use of any other mathematical writing, idea or talk material), that the re-use (even in modified form) should be acknowledged).

- Snippets for the energy theorem, the Green Star and the Hydrogen formula
- The blog on discrete Atiyah-Singer contains isospectral deformation code
- Mathematica Code, Dec 23, 2011.
- More Mathematica Code, Feb 20, 2012.
- Cohomology and fixed point Code, June 6, 2012.
- Dirac operator Code, June 8, 2013 (is also in Source

Cliques[K_,k_]:=Module[{n,u,m,s,V=VertexList[K],W=EdgeList[K],U,r={}}, s=Subsets[V,{k,k}]; n=Length[V]; m=Length[W]; Y=Table[{W[[j,1]],W[[j,2]]},{j,Length[W]}]; If[k==1,r=V,If[k==2,r=Y, Do[u=Subgraph[K,s[[j]]]; If[Length[EdgeList[u]]==Binomial[k,2], r=Append[r,VertexList[u]]],{j,Length[s]}]]];r]; Dirac[s_]:=Module[{a,b,q,l,n,v,m,R,t,d},q=VertexList[s];n=Length[q]; d=Table[{{0}},{p,n-1}]; l=Table[{},{p,n}]; v=Table[0,{p,n}]; m=n; Do[If[m==n,l[[p]]=Cliques[s,p];v[[p]]=Length[l[[p]]]; If[v[[p]]==0,m=p-2]],{p,n}]; t=Sum[v[[p]],{p,n}]; b=Prepend[Table[Sum[v[[p]],{p,1,k}],{k,Min[n,m+1]}],0]; R=Table[0,{t},{t}]; If[m>0, d[[1]] = Table[0,{j,v[[2]]},{i,v[[1]]}]; Do[d[[1,j,l[[2,j,1]]]]=-1,{j,v[[2]]}]; Do[d[[1,j,l[[2,j,2]]]]=1,{j,v[[2]]}]]; Do[ If[m>=p,d[[p]]=Table[0,{j,v[[p+1]]},{i,v[[p]]}]; Do[a=l[[p+1,i]];Do[d[[p,i,Position[l[[p]], Delete[a,j]][[1,1]]]]=(-1)^j,{j,p+1}],{i,v[[p+1]]}]],{p,2,n-1}]; Do[If[m>=p,Do[R[[b[[p+1]]+j,b[[p]]+i]]=d[[p,j,i]], {i,v[[p]]},{j,v[[p+1]]}]],{p,n-1}]; R+Transpose[R]]; s={1->2,2->3,3->1,3->4,4->2,3->5,5->6,6->4,4->7}; s=UndirectedGraph[Graph[s]]; DD=Dirac[s]

June 10: Some code to the ArXiv paper. | |

This is code base used for many of the computations in papers 2 and 3. It allows to compute curvature, dimension and Euler characteristic for a general graph. It is available as a Wolfram Demonstration project: "Dimension and Euler Characteristics of graphs". I have here also a local version (CDF file January 8, 2012) Like any Demonstration projects the file is open source. You can download the source, try it out and look under the hood or modify. | |

This contains also code base for the computations in paper 4. It contains code to compute the index at any point. The demonstration project illustrates with some small graphs how the sum of the indices is the Euler characteristic. Like Gauss-Bonnet for graphs, Poincare-Hopf for graphs is very general. Both curvature and index have simple definitions, much simpler than the continuum versions. Wolfram Demo version, local (CDF file January 9, 2012). | |

hexregions.m ( July 2, 2009) This is code base which generated most of the pictures for the first paper. It was written in Mathematica 7 and was heavily based on Euclidean implementation. I did not bother to rewrite graph theoretically, but it still runs today with Mathematica 8. |

Dimension and Euler Characteristics of Graphs from the Wolfram Demonstrations Project by Oliver Knill

Gauss-Bonnet and Poincaré-Hopf for Graphs from the Wolfram Demonstrations Project by Oliver Knill