Here are some slides about the paper.
By the way, an appendix of the paper contains all the code for experimenting with the structures. To copy paste the code, one has to wait for the ArXiv version, where the LaTeX source is always included.
Here is the unimodularity theorem again in a nutshell:
Given a finite abstract simplicial complex G, define its connection graph G’ which has as vertices the simplices in G and connects two if they intersect. The Fredholm characteristic of G is  where A is the adjacency matrix of G. The Fermi characteristic of G is  , where the product goes over all simplices in G. The theorem assures that  . This implies in particular that the matrix 1+A is unimodular: the inverse is an integer matrix.
|
December 27, the Fredholm determinants in topology paper is on the ArXiv. You can copy paste the Mathematica code from the source file. I almost by principle do not store important code in a proprietary notebook format as these specifications change. You can read and understand the following code also long in the future. Mathematica is great pseudo code as it is close to natural language.
(* Code from https://arxiv.org/abs/1612.08229 *)
(* see http://www.math.harvard.edu/~knill/graphgeometry *)
Fredholm[A_]:=A+IdentityMatrix[Length[A]];
FredholmDet[s_]:=Det[Fredholm[AdjacencyMatrix[s]]];
Experiment1=Table[FredholmDet[WheelGraph[k]],{k,4,20}]
CliqueNumber[s_]:=Length[First[FindClique[s]]];
ListCliques[s_,k_]:=Module[{n,t,m,u,r,V,W,U,l={},L},L=Length;
VL=VertexList;EL=EdgeList;V=VL[s];W=EL[s]; m=L[W]; n=L[V];
r=Subsets[V,{k,k}];U=Table[{W[[j,1]],W[[j,2]]},{j,L[W]}];
If[k==1,l=V,If[k==2,l=U,Do[t=Subgraph[s,r[[j]]];
If[L[EL[t]]==k(k-1)/2,l=Append[l,VL[t]]],{j,L[r]}]]];l];
Whitney[s_]:=Module[{F,a,u,v,d,V,LC,L=Length},V=VertexList[s];
d=If[L[V]==0,-1,CliqueNumber[s]];LC=ListCliques;
If[d>=0,a[x_]:=Table[{x[[k]]},{k,L[x]}];
F[t_,l_]:=If[l==1,a[LC[t,1]],If[l==0,{},LC[t,l]]];
u=Delete[Union[Table[F[s,l],{l,0,d}]],1]; v={};
Do[Do[v=Append[v,u[[m,l]]],{l,L[u[[m]]]}],{m,L[u]}],v={}];v];
ConnectionGraph[s_] := Module[{c=Whitney[s],n,A},n=Length[c];
A=Table[1,{n},{n}];Do[If[DisjointQ[c[[k]],c[[l]]]||
c[[k]]==c[[l]],A[[k,l]]=0],{k,n},{l,n}];AdjacencyGraph[A]];
Fvector[s_] := Delete[BinCounts[Length /@ Whitney[s]], 1];
FermiCharacteristic[s_]:=Module[{f=Fvector[s]},
(-1)^Sum[f[[2k]],{k,Floor[Length[f]/2]}]];
FredholmCharacteristic[s_]:=FredholmDet[ConnectionGraph[s]];
Experiment2 = Do[s=RandomGraph[{10,30}];
Print[{FermiCharacteristic[s],FredholmCharacteristic[s]}],
{100}];
ConnectionGraph[s_,V_]:=Module[{c=Whitney[s],n,A},n=Length[c];
A=Table[1,{n+1},{n+1}];Do[If[DisjointQ[c[[k]],c[[l]]] ||
c[[k]]==c[[l]],A[[k,l]]=0],{k,n},{l,n}]; A[[n+1,n+1]]=0;
Do[If[DisjointQ[V,c[[k]]],A[[k,n+1]]=0; A[[n+1,k]]=0],{k,n}];
AdjacencyGraph[A]];
EulerChi[s_]:=Module[{c=Whitney[s]},
Sum[(-1)^(Length[c[[k]]]-1),{k,Length[c]}]];
Experiment3 = Do[ s=RandomGraph[{30,50}]; v=VertexList[s];
V=RandomChoice[v,Random[Integer,Length[v]]]; h=Subgraph[s,V];
ss=ConnectionGraph[s]; sss=ConnectionGraph[s,V];
u={FredholmDet[ss],FredholmDet[sss],1-EulerChi[h]};
Print[u," ",u[[1]] u[[3]]==u[[2]]],{100} ];
ErdoesRenyi[n_,p_]:=RandomGraph[{n,Floor[p n(n-1)/2]}];
G[n_,p_]:=FredholmDet[ConnectionGraph[ErdoesRenyi[n,p]]];
n=12;p=0.6;k=0.;m=0;
Experiment4 = Do[m++;If[G[n,p]==1,k++];Print[k/m],{Infinity}];
PrimeGraph[M_]:=Module[{V={},e,s},
Do[If[MoebiusMu[k]!=0,V=Append[V,k]], {k,2,M}];e={};
Do[If[(Divisible[V[[k]],V[[l]]] || Divisible[V[[l]],V[[k]]]),
e=Append[e,V[[k]]->V[[l]]]],{k,Length[V]},{l,k+1,Length[V]}];
UndirectedGraph[Graph[V,e]]];
PrimeConnectionGraph[M_]:=Module[{V={},e,s},
Do[If[MoebiusMu[k]!=0,V=Append[V,k]], {k,2,M}];e={};
Do[If[GCD[V[[k]],V[[l]]]>1 || GCD[V[[l]],V[[k]]]>1,
e=Append[e,V[[k]]->V[[l]]]],{k,Length[V]},{l,k+1,Length[V]}];
UndirectedGraph[Graph[V,e]]];
Test5[M_]:=Module[{V,g,h,j}, h=PrimeConnectionGraph[M];
g=PrimeGraph[M]; V=VertexList[g];
j=Table[-MoebiusMu[V[[k]]],{k,Length[V]}];
Print[{Total[j] ,EulerChi[g],
Product[j[[k]],{k,Length[j]}],FredholmDet[h]}]];
Experiment5 = Do[Test5[k],{k,10,200}];
