Calculus without limits # Interaction Cohomology (II)

This is an other blog entry about interaction cohomology [PDF], (now on the ArXiv), a draft which just got finished over spring break. The paper had been started more than 2 years ago and got delayed when the unimodularity of the connection Laplacian took over. There was an announcement [PDF] which is now included as an appendix. [Not to appear over excited, but even after 2 years, I still believe the cohomology is remarkable and of potential importance. One has to wait a bit still to see whether it is known or what are the implications. This might take a few more years. Still, it is important to have the discovery documented and dated. This blog is a continuation from This entry from March 2016. ]

The simplices in a finite abstract simplicial complex G carry a curvature $\omega(x) = (-1)^{{\rm dim}(x)}$. The total curvature $\sum_x \omega(x)$ defines the Euler characteristic $\chi(G)$. The Euler characteristic is more than just a number. It is a valuation, a quantity which can be applied on the Boolean lattice of sub simplicial complexes and satisfies the quantity $\chi(A \cup B) + \chi(A \cap B) = \chi(A) + \chi(B)$. It is the only such quantity which is assigns the value $1$ to the complex $1=K_1$ and is the only invariant under the Barycentric refinement operation. Any valuation has Gauss-Bonnet, or Poincaré-Hopf formulas, but only Euler characteristic has that scaling invariant. Furthermore, it can be expressed as a cohomological Euler characteristic $\sum_p (-1)^p {\rm dim}(H^p(G))$, where $H^p(G)$ is the $p$’th simplicial cohomology group.

The category of simplicial complexes feature an addition in the form of the disjoint union. The zero element is the empty complex. The Cartesian product leaves the category of simplicial complexes but defines a ring. The Euler characteristic defines a ring homomorphism to the integers. As Euler characteristic is unique, there appears no need to look further. Furthermore, $\chi$ comes with all the nice theorems from the continuum: it has a dynamical extension in the form of a Lefshetz number $\chi(T,G)$ which leads to the Lefshetz fixed point theorem. Euler characteristic also plays well with spectral properties The connection Laplacian $L$ has an inverse $g$ which produces interaction energies $g(x,y)$ summing up to the Euler characteristic.

Euler characteristic is a linear valuation. By going to quadratic and higher order valuations, one can get more quantities which are natural. The Wu characteristic is the quantity $\omega(G) = \sum_{x,y} \omega(x) \omega(y)$. It sums over all pairs of interacting simplices. There is a corresponding cohomology $H^p_2(G) can be defined very similarly. A draft about this interaction cohomology has just been posted. The paper also contains the following Mathematica code which allows to compute the cohomology$H^p(G,H)$. While simplicial cohomology needed six lines, we need now 12. One could probably shorten it more but only under the expense of making it less readable. It should be very clear how the cohomology is built: first produce a list of all intersecting simplices, then produce an exterior derivative d, build$D=d+d^*$, then look at the nullity of the blocks of$L=D^2\$. These are the Betti numbers. In the paper, there are more examples. Here is the Mathematica code which was included in the preprint. The code can also be grabbed from the LaTeX (as the source code of papers and not only the processed PDF is always available on the ArXiv).

(* Interaction Cohomology, 3/18/2018                                *)
(* http://www.math.harvard.edu/~knill/graphgeometry/papers/wu2.pdf  *)
Coho2[G_,H_]:=Module[{},n=Length[G];m=Length[H];len[x_]:=Total[Map[Length,x]];U={};
Do[If[Length[Intersection[G[[i]],H[[j]]]]>0,U=Append[U,{G[[i]],H[[j]]}]],{i,n},{j,m}];
U=Sort[U,len[#1] < len[#2] & ];u=Length[U];l=Map[len,U]; w=Union[l];
b=Prepend[Table[Max[Flatten[Position[l,w[[k]]]]],{k,Length[w]}],0]; h=Length[b]-1;
deriv1[{x_,y_}]:=Table[{Sort[Delete[x,k]],y},{k,Length[x]}];
deriv2[{x_,y_}]:=Table[{x,Sort[Delete[y,k]]},{k,Length[y]}];
d1=Table[0,{u},{u}]; Do[v=deriv1[U[[m]]]; If[Length[v]>0,
Do[r=Position[U,v[[k]]]; If[r!={},d1[[m,r[[1,1]]]]=(-1)^k],{k,Length[v]}]],{m,u}];
d2=Table[0,{u},{u}]; Do[v=deriv2[U[[m]]]; If[Length[v]>0,
Do[r=Position[U,v[[k]]]; If[r!={},d2[[m,r[[1,1]]]]=(-1)^(Length[U[[m,1]]]+k)],
{k,Length[v]}]],{m,u}]; d=d1+d2; Dirac=d+Transpose[d]; L=Dirac.Dirac; Map[NullSpace,
Table[Table[L[[b[[k]]+i,b[[k]]+j]],{i,b[[k+1]]-b[[k]]},{j,b[[k+1]]-b[[k]]}],{k,h}]]];
Betti2[G_,H_]:=Map[Length,Coho2[G,H]];Coho2[G_]:=Coho2[G,G]; Betti2[G_]:=Betti2[G,G];
Generate[A_]:=Sort[Delete[Union[Sort[Flatten[Map[Subsets,A],1]]],1]];

moebius=Generate[{{1,2,5},{1,4,5},{1,4,7},{2,3,6},{2,5,6},{3,6,7},{4,3,7}}];
Print["Moebius Strip: ",Betti2[moebius]];
cylinder=Generate[{{1,2,5},{1,4,8},{1,5,8},{2,3,6},{2,5,6},{3,4,7},{3,6,7},{4,7,8}}];
Print["Cylinder: ",Betti2[cylinder]];


[Update, March 19: Here is also the code for the cubic cohomology. These lines had not been included in the ArXiv preprint but it it is straightforward how to go from here even higher. The size of the matrices just gets larger and larger.

(* Cubic Interaction Cohomology, 3/19/2018                          *)
(* See   https://arxiv.org/abs/1803.06788                           *)
Coho3[G_,H_,K_]:=Module[{},n=Length[G];m=Length[H];p=Length[K];len[x_]:=Total[Map[Length,x]];
W={};Do[If[Length[Intersection[G[[i]],H[[j]],K[[k]]]]>0,
W=Append[W,{Sort[G[[i]]],Sort[H[[j]]],Sort[K[[k]]]}]], {i,n},{j,m},{k,p}];n=Length[W];
W=Sort[W,len[#1] < len[#2] &]; ll=Map[length,W]; ln=Union[ll]; l=Map[len,W]; w=Union[l];
b=Prepend[Table[Max[Flatten[Position[l,w[[k]]]]],{k,Length[w]}],0]; h=Length[b]-1;
der1[{x_,y_,z_}]:=Table[{Sort[Delete[x,k]],y,z},{k,Length[x]}];
der2[{x_,y_,z_}]:=Table[{x,Sort[Delete[y,k]],z},{k,Length[y]}];
der3[{x_,y_,z_}]:=Table[{x,y,Sort[Delete[z,k]]},{k,Length[z]}];
d1=Table[0,{n},{n}]; Do[u=der1[W[[m]]]; If[Length[u]>0,Do[r=Position[W,u[[k]]];
If[r!={},d1[[m,r[[1,1]]]]=(-1)^k],{k,Length[u]}]],{m,n}];
d2=Table[0,{n},{n}]; Do[ u=der2[W[[m]]]; If[Length[u]>0,Do[r=Position[W,u[[k]]];
If[r!={},d2[[m,r[[1,1]]]]=(-1)^(Length[W[[m,1]]]+k)], {k,Length[u]}]],{m,n}];
d3=Table[0,{n},{n}]; Do[ u=der3[W[[m]]]; If[Length[u]>0,Do[r=Position[W,u[[k]]];
If[r!={},d3[[m,r[[1,1]]]]=(-1)^(Sum[Length[W[[m,j]]],{j,2}]+k)], {k,Length[u]}]],{m,n}];
d=d1+d2+d3; Dirac=d+Transpose[d]; L=Dirac.Dirac; Map[NullSpace,
Table[Table[L[[b[[k]]+i,b[[k]]+j]],{i,b[[k+1]]-b[[k]]},{j,b[[k+1]]-b[[k]]}],{k,h}]]];
Betti3[G_,H_,K_]:=Map[Length,Coho3[G,H,K]];Coho3[G_]:=Coho3[G,G,G]; Betti3[G_]:=Betti3[G,G,G];
Generate[A_]:=Sort[Delete[Union[Sort[Flatten[Map[Subsets,A],1]]],1]];

G=Generate[{{1,2}}];    Betti3[G]
G=Generate[{{1,2,3}}];  Betti3[G]
G=Generate[{{1,2},{2,3},{3,4},{4,1}}]; Betti3[G]


]