Dynamical Dirac Code

Dynamical Dirac Code

Maybe it is a good idea to add current “discovery code” also with the Dirac part. It can be helpful to post code also to be able to see in the future how one was thinking at the time. In the talk of Freedman, there was a slide with a picture of Freedman’s “Gold rope”. Like Whitney, Milnor or de Rham, Freedman was also a mountain climber. He ended his talk with the remark that “mathematics is like rope”. There are many strains which hold things together. The individual strains might be fragile, but the entire rope is safe. I myself actually have a bit more nostalgic view about mathematics: every strain of the rope has to be true. At the end of the talk, there was an audience question about AI. Of course, as an employee of Microsoft he had to blow into the trumped of AI. He can roar because he has got his 15 minutes of fame in mathematics with the fields medal. Apres mois, le deluge! It is exactly this type of nihilism which makes me personally rebel against AI. It makes us stupid. It produces kitsch. It devaluates creative thought. Its use without attribution should be called plagiarism.

(* Oliver Knill, September 19, 2025. See https://www.youtube.com/watch?v=A9DlOfzshbw                  *)
CleanComplex[G_]:=Union[Sort[Map[Sort,G]]]; L=Length; w[x_]:=-(-1)^L[x];
Generate[A_]:=If[A=={},A,CleanComplex[Delete[Union[Sort[Flatten[Map[Subsets,A],1]]],1]]];
Whitney[s_]:=Generate[FindClique[s,Infinity,All]]; Str[X_]:=Sum[X[[k,k]]*w[G[[k]]],{k,L[G]}];
s[x_]:=Signature[x]; s[x_,y_]:=If[SubsetQ[x,y]&&(L[x]==L[y]+1),s[Prepend[y,Complement[x,y][[1]]]]*s[x],0];
CC[G_,x_]:=Select[G,SubsetQ[x,#] &]; UU[G_,x_]:=Select[G,SubsetQ[#,x] &];  (* core and star *)
F[G_,k_]:=Map[Sort,Select[G,L[#]==k&]]; Euler[G_]:=Total[Map[w,G]];   Prod[X_]:=Exp[Total[Log[X]]];
S[G_,T_]:=Module[{V=Flatten[F[G,1]]},Table[V[[j]]->T[[j]],{j,L[V]}]]; Fermi[G_]:=Prod[Map[w,G]];
FindAut[G_]:=Module[{V=Flatten[F[G,1]],H=F[G,2],T},T=Permute[Range[L[V]],RandomPermutation[L[V]]];
   While[Not[H==Sort[Map[Sort,(H/.S[G,T])]]],T=Permute[Range[L[V]],RandomPermutation[L[V]]]]; T];
d[G_,ST_]:=Table[x=G[[i]];y=G[[j]]/.ST;s[x,y],{i,L[G]},{j,L[G]}]; Dirac[G_,ST_]:=d[G,ST]+Transpose[d[G,ST]];

t=CompleteGraph[{2,3,4,1}]; G=Whitney[t]; n=L[G]; T=FindAut[G];  ST=S[G,T];
D1 = Dirac[G, ST]; D2 = Dirac[G, S[G, Range[Length[F[G, 1]]]]]; D1.D1==D2.D2