Calculus without limits

# Fusion Inequality for Quadratic Cohomology

While linear cohomology deals with functions on simplices, quadratic cohomology deals with functions on pairs of simplices that intersect. Linear cohomology is to Euler characteristic $\chi(G)=\sum_{x} w(x)$ what quadratic cohomology is to Wu characteristic $w(G) = \sum_{x,y, x \cap y \in G} w(x) w(y)$. If the simplicial complex is split into a closed set K (a sub-simplicial complex) and an open set U, one can distinguish 5 different cases of interactions. In principle there would be 8 different cases $(x,y) = X x Y, x \cap y \in Z$ with $X,Y,Z \in \{K,U\}$, but there is some asymmetry in that if one of the x,y is in K, then the intersection must be in K, excluding (KUU, UKU and KKU). The other five cases UUU,KKK,UKK,KUK,UUK lead each to a cohomology group. We abbreviate them with U,K,UK,KU,UU. These are topological invariants of the split (K,U) in G. Interesting is the case when the open set is a discrete algebraic set or more generally, a manifold given by a partition. For example, if G is a discrete d-manifold and $f:V(G) \to \{1,2,3\}$ is an arbitrary map, where $V(G)=\bigcup_{x \in G} x$, then $U = \{ x \in G, f(x) = \{1,2,3\} \}$ is either empty of a (d-k)-manifold! Now, we have 5 quadratic cohomology groups to study besides the one for G. If G is a 3-manifold like a 3-sphere, we look at links, finite unions of knots in G. In the video, I talk about a first result about these groups. It is the quadratic fusion inequality:

Theorem: $b(G) \leq b(U) + b(K) + b(U,K) + b(K,U) + b(U,U)$.

The result immediately follows from spectral monotonicity. Update: read more on the Paper [PDF] Maybe also some links and some historical pointers:


(* Linear Cohomology  *)
Generate[A_]:=If[A=={},{},Sort[Delete[Union[Sort[Flatten[Map[Subsets,A],1]]],1]]];
L=Length;  Whitney[s_]:=Generate[FindClique[s,Infinity,All]];  L2[x_]:=L[x[[1]]]+L[x[[2]]];
sig[x_]:=Signature[x]; nu[A_]:=If[A=={},0,L[A]-MatrixRank[A]];
F[G_]:=Module[{l=Map[L,G]},If[G=={},{},Table[Sum[If[l[[j]]==k,1,0],{j,L[l]}],{k,Max[l]}]]];
sig[x_,y_]:=If[SubsetQ[x,y]&&(L[x]==L[y]+1),sig[Prepend[y,Complement[x,y][[1]]]]*sig[x],0];
Dirac[G_]:=Module[{f=F[G],b,d,n=L[G]},b=Prepend[Table[Sum[f[[l]],{l,k}],{k,L[f]}],0];
d=Table[sig[G[[i]],G[[j]]],{i,n},{j,n}]; {d+Transpose[d],b}];
Hodge[G_]:=Module[{Q,b,H},{Q,b}=Dirac[G];H=Q.Q;Table[Table[H[[b[[k]]+i,b[[k]]+j]],
{i,b[[k+1]]-b[[k]]},{j,b[[k+1]]-b[[k]]}],{k,L[b]-1}]];
Betti[s_]:=Module[{G},If[GraphQ[s],G=Whitney[s],G=s];Map[nu,Hodge[G]]];
Fvector[A_]:=Delete[BinCounts[Map[Length,A]],1];
Euler[A_]:=Sum[(-1)^(Length[A[[k]]]-1),{k,Length[A]}];

F2[G_]:=Module[{},If[G=={},{},Table[Sum[If[L2[G[[j]]]==k,1,0],{j,L[G]}],{k,Max[Map[L2,G]]}]]];
ev[L_]:=Sort[Eigenvalues[1.0*L]];
WuComplex[A_,B_,opts___]:=Module[{Q={},x,y,u},
Do[x=A[[k]];y=B[[l]];u=Intersection[x,y];
If[((opts=="Open" && Not[x==y] && L[u]>0 && Not[MemberQ[A,u]]) ||
(Not[opts=="Open"] &&                        MemberQ[A,u])),
Q=Append[Q,{x,y}]],{k,L[A]},{l,L[B]}];Sort[Q,L2[#1]<L2[#2] &]];
Dirac[G_,H_,opts___]:=Module[{n=L[G],Q,m=L[H],b,d1,d2,h,v,w,l,DD}, Q=WuComplex[G,H,opts];
n2=L[Q];   f2=F2[Q];   b=Prepend[Table[Sum[f2[[l]],{l,k}],{k,L[f2]}],0];
D1[{x_,y_}]:=Table[{Sort[Delete[x,k]],y},{k,L[x]}];
D2[{x_,y_}]:=Table[{x,Sort[Delete[y,k]]},{k,L[y]}];
d1=Table[0,{n2},{n2}]; Do[v=D1[Q[[m]]]; If[L[v]>0,Do[r=Position[Q,v[[k]]];
If[r!={},d1[[m,r[[1,1]]]]=(-1)^k],{k,L[v]}]],{m,n2}];
d2=Table[0,{n2},{n2}]; Do[v=D2[Q[[m]]]; If[L[v]>0, Do[r=Position[Q,v[[k]]];
If[r!={},d2[[m,r[[1,1]]]]=(-1)^(L[Q[[m,1]]]+k)],{k,L[v]}]],{m,n2}];
d=d1+d2; DD=d+Transpose[d]; {DD,b}];
Beltrami[G_,H_,opts___]:=Module[{Q,P,b},{Q,b}=Dirac[G,H,opts];P=Q.Q];
Hodge[G_,H_,opts___]:=Module[{Q,P,b},{Q,b}=Dirac[G,H,opts];P=Q.Q;
Table[Table[P[[b[[k]]+i,b[[k]]+j]], {i,b[[k+1]]-b[[k]]},{j,b[[k+1]]-b[[k]]}],{k,2,L[b]-1}]];
Betti[G_,H_,opts___]:=Map[nu,Hodge[G,H,opts]];
Wu[A_,B_,opts___]:=Sum[x=A[[k]];y=B[[l]];u=Intersection[x,y];
If[(opts=="Open" && Not[x==y] && L[u]>0 && Not[MemberQ[A,u]]) ||
(Not[opts=="Open"]    &&                    MemberQ[A,u]),
(-1)^L2[{x,y}],0],{k,L[A]},{l,L[B]}];
Fvector[A_,B_,opts___]:=Module[{a=F2[WuComplex[A,B,opts]]},Table[a[[k]],{k,2,L[a]}]];

s = CompleteGraph[{1,2,1}];  G = Whitney[s]; K = Generate[{{1,4}}]; U=Complement[G,K];
Print["Linear Cohomology"];
Print[ Grid[{
{"Case", "Betti","F-vector","Euler"}, {"U", bU,fU,  Euler[U]},
{"K", bK,fK,  Euler[K]}, {"G", bG,fG,  Euler[G]},
{"Compare",bU+bK-bG,fU+fK-fG, Euler[U]+Euler[K]-Euler[G]}}]];
Betti[K,U,"Closed"],Betti[U,K,"Closed"], Betti[U,U,"Open"],Betti[G,G,"Closed"]}];
Fvector[K,U,"Closed"],Fvector[U,K,"Closed"], Fvector[U,U,"Open"],  Fvector[G,G,"Closed"]}];
Print[ Grid[{ {"Case","Betti","F-vector","Wu"},{"U",bU,fU,Wu[U,U,"Closed"]},
{"K",bK,fK,Wu[K,K,"Closed"]},{"UK",bKU,fKU,Wu[K,U,"Closed"]},{"KU",bKU,fKU,Wu[K,U,"Closed"]},
{"UU",bUU,fUU,Wu[U,U,"Open"]},{"G", bG, fG, Wu[G,G,"Closed"]},
{"Compare",bU+bK+bKU+bKU+bUU-bG,fU+fK+fKU+fKU+fUU-fG,
Wu[U,U,"Closed"]+Wu[K,K,"Closed"]+2Wu[K,U,"Closed"]+Wu[U,U,"Open"]-Wu[G,G,"Closed"]}}]];


Here is the output of this code (done with Mathematica 14.0)

Mathematica 14.0.0 Kernel for Linux x86 (64-bit)

Linear Cohomology
Case  Betti       F-vector    Euler
U  {0, 0, 0}   {2, 4, 2}   0
K  {1, 0, 0}   {2, 1, 0}   1
G  {1, 0, 0}   {4, 5, 2}   1
Compare  {0, 0, 0}   {0, 0, 0}   0

Compare {0, 1, 3, 2, 0}   {0, 0, 0, 0, 0}      0