It is not quite yet a poem, but here, as promised in the movie, some code to generate both the Betti vector and Wu betti vector of a random submanifold in a given manifold. It is 25 lines without any additional libraries, so not yet quite a poem, but it does a lot: it takes a 3-sphere G given as a join of two circles (note that this is a 3-manifold and not the 2-sphere in 3 dimensional space. The 3-sphere is a 3-manifold and its geometric realization can carry the SU(2) lie group structure. Then we take a random hypersurface H in G which is a 2-manifold. Then we compute the Betti vector of H and the Wu Betti vector of H. Also note that the code does much more than that because we have the Hodge matrices and so a basis of the cohomology groups, both for simplicial cohomology as well as for Wu cohomology. We have also made experiments with higher dimensional manifolds but the computations become quickly too heavy. Also remember that H as constructed is an open set which as a delta set is a manifold. We could for example get the graph defined by H and get a simplicial complex realization of it but the computations of the Betti vectors or Wu Betti vectors of these simplicial complexes would be much, much larger and produce impossibly large matrices.
Here is what we measure and so conjecture: let M be a d-manifold. lets define the dimension function on the delta set so that for standard cohomology is the zero’th standard cohomology which is the number of connected components. We also define the dimension function for the delta set of the Wu complex (the set of intersecting pairs of simplices) so that the last entry belongs to the interaction of d-dimensional facets. We have then two vectors of dimension d+1. First of all the Betti vector of M which is and then the Wu Betti vector .
Conjecture: .
We also should stress that this relation of course only is expected to hold for manifolds. For general complexes it is dead wrong in general. One can try it out with G = Whitney[RandomGraph[{8, 15}]]; {Betti[G], WuBetti[G]}
Below is the is the 25 line code: one can copy paste it into Mathematica and without any additional libraries: With the given setup, the Dirac matrix is a 100×100 matrix and the Wu Dirac matrix maybe 1000×1000 matrix. One can quickly get into ranges where linear algebra for computing the kernel of matrices becomes difficult.
DD=Dirac[H]; DD2=WuDirac[H]; Print[{Last[DD],Last[DD2]}]; MatrixPlot[First[DD2]]
to see the sizes of the markers and the matrix). As we work with open sets which are not necessarily simplicial complexes, the Dirac operator comes also with the markers where the dimensions change. All the information of the delta set is in the Dirac matrix. In the youtube talks, I represented the delta set as (G,D,dim), where D is the Dirac operator and dim the dimensions. From this information we can reconstruct the delta set. Also I want to repeate why I recently got more and more excited about the topos of delta sets (which contains the topos of simplicial sets as a special case as simplicial sets have more structure): first of all, unlike simplicial sets, delta sets are much more intuitive because they are more general, second it allows conveniently to work with level sets and so graphs of functions, products of delta sets are delta sets, quotients of delta sets are delta sets, open sets of simplicial complexes are natural delta sets. I worked last year on the cohomology of open sets and first thought that one has to reinvent the wheel to define cohomology of open sets (complements of subsimplicial complexes in a simplicial complex). It is all part of delta sets.
So, how to prove the above conjecture? It is probably just a chain homotopy but not obvious at all. How to relate the k dimensional parts in the simplicial complex to the 2d-k dimensional parts of the Wu complex? Already the simplest case is not clear. We have to identity the zero dimensional part of the simplicial complex with the 2d dimensional pairs (x,y) of intersecting facets. It looks a lot related to Poincare duality.
Generate[A_]:=If[A=={},{},Sort[Delete[Union[Sort[Flatten[Map[Subsets,A],1]]],1]]];
Whitney[s_]:=Generate[FindClique[s,Infinity,All]];L=Length; Ver[X_]:=Union[Flatten[X]];
RFunction[G_,P_]:=Module[{},R[x_]:=x->RandomChoice[Range[L[Ver[P]]]];Map[R,Ver[G]]];
AbstractSurface[G_,f_,A_]:=Select[G,(Sum[If[SubsetQ[#/.f,A[[l]]],1,0],{l,L[A]}]>0)&];
sig[x_]:=Signature[x]; nu[A_]:=If[A=={},0,L[NullSpace[A]]]; L2[x_]:=L[x[[1]]]+L[x[[2]]];
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[G_]:=Map[nu,Hodge[G]];
F2[G_]:=Module[{m},If[G=={},{},Table[Sum[If[L2[G[[j]]]==k,1,0],{j,L[G]}],{k,Max[Map[L2,G]]}]]];
WuComplex[G_]:=Sort[Select[Tuples[G,2],MemberQ[G,Intersection[#[[1]],#[[2]]]]&],L2[#1]<L2[#2]&];
WuDirac[G_]:=Module[{n=L[G],n2,G2=WuComplex[G],ll,ln,d1,d2,dd,b2,D2,f2},
n2=Length[G2]; f2=F2[G2]; b2=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[u=D1[G2[[m]]]; If[L[u]>0,Do[r=Position[G2,u[[k]]];
If[r!={},d1[[m,r[[1,1]]]]=(-1)^k],{k,L[u]}]],{m,n2}];
d2=Table[0,{n2},{n2}];Do[u=D2[G2[[m]]]; If[L[u]>0,Do[r=Position[G2,u[[k]]];
If[r!={},d2[[m,r[[1,1]]]]=(-1)^(L[G2[[m,1]]]+k)],{k,L[u]}]],{m,n2}];
dd=d1+d2; D2=dd+Transpose[dd]; {D2,b2}];
WuHodge[G_]:=Module[{Q,b,H},{Q,b}=WuDirac[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}]]; WuBetti[G_]:=Map[nu,WuHodge[G]];
G=Whitney[GraphJoin[CycleGraph[9],CycleGraph[4]]]; FF={{1,2}}; P=Generate[FF]; f=RFunction[G,P];
H=AbstractSurface[G,f,FF]; Print[Betti[H]]; Print[WuBetti[H]];
For the illustration we take the wheel graph:
G = Whitney[WheelGraph[5]]; {Betti[G], WuBetti[G]};
H = G; DD = Dirac[H]; DD2 = WuDirac[H]; Print[{Last[DD], Last[DD2]}];
S = GraphicsGrid[{{MatrixPlot[First[DD2]],
MatrixPlot[First[DD2] . First[DD2]]}}]