(* Connection Laplacian defined by a complex wave, Oliver Knill, 1/8/2020 *) Generate[A_]:=Delete[Union[Sort[Flatten[Map[Subsets,A],1]]],1]; RandomSets[n_,m_]:=Module[{A={},X=Range[n],k},Do[k:=1+Random[Integer,n-1]; A=Append[A,Union[RandomChoice[X,k]]],{m}];Sort[Generate[A]]]; G=RandomSets[5,9]; n=Length[G]; S=Table[-(-1)^Length[G[[k]]]*If[k ==l,1,0],{k,n},{l,n}]; (* Super matrix *) star[x_]:=Module[{u={}},Do[v=G[[k]];If[SubsetQ[v,x],u=Append[u,v]],{k,n}];u]; core[x_]:=Module[{u={}},Do[v=G[[k]];If[SubsetQ[x,v],u=Append[u,v]],{k,n}];u]; Wminus = Table[Intersection[core[G[[k]]],core[G[[l]]]],{k,n},{l,n}]; Wplus = Table[Intersection[star[G[[k]]],star[G[[l]]]],{k,n},{l,n}]; e=Table[Exp[2Pi I Random[]],{k,n}]; energy[A_]:=If[A=={},0,Sum[e[[Position[G,A[[k]]][[1,1]]]],{k,Length[A]}]]; Lminus = Table[energy[Wminus[[k,l]]], {k,n},{l,n}]; L = Lminus; Lplus = Table[energy[Wplus[[k,l]]], {k,n},{l,n}]; g = S.Lplus.S; Print[{ Chop[Total[Flatten[g]] - Total[e]], (* Energy Thm *) Chop[Tr[S.g] -Total[e]], (* McKean-Singer Thm*) Chop[{Det[g],Det[L],N[Product[e[[k]],{k,n}]]}], (* Unimodularity Thm*) N[Total[Flatten[Conjugate[g].L -IdentityMatrix[n]]]]}];(* Green-Star Id *)