spurform:=function(A); res:=MatrixRing(Rationals(),2*n) ! 0; for i in [1..2*n] do for j in [1..2*n] do res[i][j]:=Rationals()!Trace(K!(B[i]*A*HermitianTranspose(B[j]))[1][1]); end for; end for; res:=(1/2)*res; return res; end function; auswerten:=function(A,x); x:=KMatrixSpace(K,1,n)!x; z:=K!0; N:=K!0; I:=ideal; z:=K!((x*A*HermitianTranspose(x))[1][1]); for i in [1..n-1] do I:=I+x[1][i]*p1; end for; I:=I+x[1][n]*(p1/p2); N:=Norm(I); return z/N; end function; kuerzen:=function(A,m,S); res:=[]; for i in [1..#S] do x:=Vector(S[i][1]); xk:=KMatrixSpace(K,1,n)!0; for j in [1..2*n] do xk:=xk+x[j]*B[j]; end for; if auswerten(A,xk) eq m then Append(~res,xk); end if; end for; return res; end function; vektorkuerzen:=function(x); res:=KMatrixSpace(K,1,n)!0; for j in [1..2*n] do res:=res+x[j]*B[j]; end for; return res; end function; idealnorm:=function(x); N:=0; I:=ideal; for i in [1..n-1] do I:=I+x[1][i]*(p1); end for; I:=I+x[1][n]*(p1/p2); N:=Norm(I); return N; end function; hermitianmin:=function(A); L:=LatticeWithGram(spurform(A)); minL:=Minimum(L); S:=ShortVectors(L,minL/mmax,minL*mmax); m:=Min([auswerten(A,vektorkuerzen(s[1])) : s in S]); return m; end function; function perfrank(M); VV:=[]; for m in M do s:=Matrix(m[1]); v:=HermitianTranspose(s)*Matrix(s); Append(~VV, ElementToSequence(v)); end for; return Rank(Matrix(VV)) ; end function; function prank(M); L:=LatticeWithGram(spurform(M)); m:=hermitianmin(M); S:=ShortVectors(L,m/mmax,m*mmax); Sk:=kuerzen(M,m,S); return perfrank(Sk); end function; function pcorank(M) return n^2-prank(M); end function; RemoveMultiples:=function(M); V:=VectorSpace(K,n); out:=[]; Append(~out,M[1]); for m in M do; ismultiple:=false; for v in out do; if Vector(m) in sub then; ismultiple:=true; end if; end for; if not ismultiple then; Append(~out,m); end if; end for; return out; end function; minvecs:=function(A); L:=LatticeWithGram(spurform(A)); m:=hermitianmin(A); S:=ShortVectors(L,m/mmax,m*mmax); Sk:=kuerzen(A,m,S); Sk:=RemoveMultiples(Sk); return Sk; end function; isisom:=function(M,N); Me:=spurform(M); Ne:=spurform(N); mul1:=Lcm([Denominator(x) : x in Eltseq(Me)]); mul2:=Lcm([Denominator(x) : x in Eltseq(Ne)]); Me:=ChangeRing(mul1*mul2*Me,Integers()); Ne:=ChangeRing(mul1*mul2*Ne,Integers()); LM:=LatticeWithGram(Me); LN:=LatticeWithGram(Ne); Me2:=spurform(tau*M); Ne2:=spurform(tau*N); mul1:=Lcm([Denominator(x) : x in Eltseq(Me2)]); mul2:=Lcm([Denominator(x) : x in Eltseq(Ne2)]); Me2:=ChangeRing(mul1*Me2,Integers()); Ne2:=ChangeRing(mul2*Ne2,Integers()); a,b:=IsIsometric(LM,[Me2],LN,[Ne2]); if a then return a,b; else return false,"No isometry"; end if; end function; function projzeileNorm(v); p:=HermitianTranspose(v)*Matrix(v); liste:=[]; for i in [1..n] do Append(~liste,F!(p[i][i])); for j in [i+1..n] do Append(~liste, F!(( p[i][j]+Conjugate(p[i][j]) )/2)); Append(~liste, sqrtd*(F!((p[i][j]-Conjugate(p[i][j]))/(2*w))) ); end for; end for; return liste; end function; function MatrixToLine(A); liste:=[]; p:=A; for i in [1..n] do Append(~liste,F!(p[i][i])); for j in [i+1..n] do Append(~liste, F!(( p[i][j]+Conjugate(p[i][j]) )/2)); Append(~liste, sqrtd*(F!((p[i][j]-Conjugate(p[i][j]))/(2*w))) ); end for; end for; return liste; end function; function ListToSmallMatrixNorm(list); L:=list; change:=false; if n eq 2 then if not (L[1] in Rationals() and L[2] in Rationals() and L[4] in Rationals()) then change:=true; end if; end if; if n eq 3 then if not (L[1] in Rationals() and L[2] in Rationals() and L[4] in Rationals() and L[6] in Rationals() and L[7] in Rationals() and L[9] in Rationals()) then change:=true; end if; end if; if change then L:=sqrtd*L; end if; res:=MatrixRing(K,n)!0; for i in [1..n^2] do if L[i] in Rationals() then res:=res+L[i]*BasHermNorm[i]; else res:=res+(K!(L[i]/sqrtd))*BasHermNorm[i]; end if; end for; return res; end function; findperp2 := function(L) //Finde senkrechte herm. Form zu Projektionen auf Vektoren in Liste L, Output Liste aller senkrechten Cond:=[projzeileNorm(l) : l in L]; Cond:=Transpose(Matrix(Cond)); if Dimension(Kernel(Cond)) eq 0 then error "In findperp2: kernel of projection matrix is zero-dimensional."; end if; dirlist:=Basis(Kernel(Cond)); dir:=[ MatrixRing(K,n)!ListToSmallMatrixNorm(d) : d in dirlist]; return dir; end function; findperp1 := function(L) //Finde senkrechte herm. Form zu Projektionen auf Vektoren in Liste L, falls Senkrechtraum 1-dimensional Cond:=[projzeileNorm(l) : l in L]; Cond:=Transpose(Matrix(Cond)); if Dimension(Kernel(Cond)) ne 1 then error "In findperp1: dimension of kernel not equal to 1."; end if; dirlist:=Kernel(Cond).1; dir:=MatrixRing(K,n)!ListToSmallMatrixNorm(dirlist); return MatrixRing(K,n)!dir; end function; findperp := function(L) //Finde senkrechte herm. Form zu Projektionen auf Vektoren in Liste L, Output ein senkr. Element Cond:=[projzeileNorm(l) : l in L]; Cond:=Transpose(Matrix(Cond)); if Dimension(Kernel(Cond)) eq 0 then error "In findperp: kernel of projection matrix is zero-dimensional."; end if; dirlist:=Kernel(Cond).1; dir:=MatrixRing(K,n)!ListToSmallMatrixNorm(dirlist); return MatrixRing(K,n)!dir; end function; findperpmatrix:=function(L,A) //Find perpendicular Hermitian matrix to those in the list //s.t. the result has trace 1 with A Cond:=[MatrixToLine(x) : x in L]; Cond:=Transpose(Matrix(Cond)); if Dimension(Kernel(Cond)) eq 0 then error "In findperpmatrix: kernel of cond matrix is zero-dimensional."; end if; dirlist:=Basis(Kernel(Cond)); dir:=[MatrixRing(K,n)!ListToSmallMatrixNorm(d) : d in dirlist]; ddir:=[x : x in dir | Trace(x*A) ne 0]; if #ddir eq 0 then error "In findperpmatrix: no suitable vector found."; end if; return ddir[1]; end function; RealToString := function(r) if Sign(r) eq -1 then str := "-"; else str := ""; end if; r:=Abs(r); p := Integers()! Floor(r) ; str := str cat IntegerToString(p) cat "."; for i := 1 to 15 do r:=10*(r-p); p := Integers()! Floor(r) ; str := str cat IntegerToString(p); end for; return str; end function; aut := function(A); Ae:=spurform(A); mul:=Lcm([Denominator(x) : x in Eltseq(Ae)]); Ae:=ChangeRing(mul*Ae,Integers()); Ae2:=spurform(tau*A); mul:=Lcm([Denominator(x) : x in Eltseq(Ae2)]); Ae2:=ChangeRing(mul*Ae2,Integers()); L:=LatticeWithGram(Ae); G:=AutomorphismGroup(L,[Ae2]); return G; end function; matbas:=function(GG); //Internal method //Convert (2n)*(2n) matrice over Z into n*n matrices over O_K //Input&Output: List n:=NumberOfRows(GG[1]) div 2; MM:=[]; for g in GG do M:=MatrixRing(K,n) ! 0; for i in [1..n-1] do for j in [1..n-1] do M[i][j]:= g[2*i-1][2*j-1] + g[2*i-1][2*j] * tau; end for; M[i][n]:= ZB[1]*g[2*i-1][2*n-1] + ZB[2]*g[2*i-1][2*n] ; end for; for j in [1..n-1] do M[n][j]:= g[2*n-1][2*j-1]/ZB[1]+tau*g[2*n-1][2*j]/ZB[1]; end for; M[n][n]:=g[2*n-1][2*n-1]+ZB[2]/ZB[1]*g[2*n-1][2*n]; Append(~MM,M); end for; return MM; end function; RealPart:=function(x) return (1/2)*(x+Conjugate(x)); end function; ImaginaryPart:=function(x) return (1/(2*w))*(x-Conjugate(x)); end function; matbas2:=function(L) //Internal method //Convert n*n matrices into (2n)*(2n) matrices over Z //[For matrix groups] res:=[]; //Define Basis matrices for p1 and p2 BM1:=MatrixRing(K,2)![[1,0],[RealPart(tau),ImaginaryPart(tau)]]; BM2:=MatrixRing(K,2)![[RealPart(ZB[1]),ImaginaryPart(ZB[1])] , [RealPart(ZB[2]) , ImaginaryPart(ZB[2])]]; for x in L do M:=KMatrixSpace(K,0,2*n)![]; //Compute images of basis vectors under x: ims:=[b*x : b in B]; for i in [1..2*n] do //Compute their coefficients in the Z-basis: v:=ims[i][1]; coeffs:=KMatrixSpace(K,1,0)![]; for k in [1..n-1] do coeffs:=HorizontalJoin(coeffs,Solution(BM1,KMatrixSpace(K,1,2)![RealPart(v[k]),ImaginaryPart(v[k])])); end for; coeffs:=HorizontalJoin(coeffs,Solution(BM2,KMatrixSpace(K,1,2)![RealPart(v[n]),ImaginaryPart(v[n])])); M:=VerticalJoin(M,coeffs); end for; Append(~res,MatrixRing(Integers(),2*n)!M); end for; return res; end function; matbas3:=function(L) //Internal method //Convert n*n matrices into (2n)*(2n) matrices over Z //[For arbitrary matrices] res:=[]; //Define Basis matrices for p1 and p2 BM1:=MatrixRing(K,2)![[1,0],[RealPart(tau),ImaginaryPart(tau)]]; //BM2:=MatrixRing(K,2)![[RealPart(ZB[1]),ImaginaryPart(ZB[1])] , // [RealPart(ZB[2]) , ImaginaryPart(ZB[2])]]; //Use the standard vector space basis instead of the Z-basis for p2 BM2:=BM1; for x in L do M:=KMatrixSpace(K,0,2*n)![]; //Compute images of basis vectors under x: ims:=[b*x : b in B]; for i in [1..2*n] do //Compute their coefficients in the Z-basis: v:=ims[i][1]; coeffs:=KMatrixSpace(K,1,0)![]; for k in [1..n-1] do coeffs:=HorizontalJoin(coeffs,Solution(BM1,KMatrixSpace(K,1,2)![RealPart(v[k]),ImaginaryPart(v[k])])); end for; coeffs:=HorizontalJoin(coeffs,Solution(BM2,KMatrixSpace(K,1,2)![RealPart(v[n]),ImaginaryPart(v[n])])); M:=VerticalJoin(M,coeffs); end for; //Here: MatrixRing(Rationals(),...) [for arbitrary matrices over K] Append(~res,MatrixRing(Rationals(),2*n)!M); end for; return res; end function; ConvertGroupToNumberField:=function(G) //Convert Z-Group into O_K-Group Generators:=SetToIndexedSet(Generators(G)); ZGENS:=[Generators[i] : i in [1..#Generators]]; OKGENS:=matbas(ZGENS); OG:=sub; return OG; end function; ConvertGroupToIntegers:=function(G) //Convert O_K-Group into Z-Group Generators:=SetToIndexedSet(Generators(G)); OKGENS:=[Generators[i] : i in [1..#Generators]]; ZGENS:=matbas2(OKGENS); ZG:=sub; return ZG; end function; IsInGL:=function(A) //tests whether A is in GL(L) bool:=true; for i in [1..n-1] do for j in [1..n-1] do if not (A[i,j] in Integers(K)) then bool:=false; end if; end for; if not (A[i,n] in p2) then bool:=false; end if; end for; for j in [1..n-1] do if not (A[n,j]) in (ideal/p2) then bool:=false; end if; end for; if not A[n,n] in Integers(K) then bool:=false; end if; if not 1/Determinant(A) in Integers(K) then bool:=false; end if; return bool; end function; CanonicalFormOfMinimalClass:=function(F) //returns the canonical form T_C for the minimal class of F T:=MatrixRing(K,n)!0; M:=minvecs(F); for x in M do T:=T+HermitianTranspose(x)*x; end for; return T; end function; StabilizerOfMinimalClass:=function(F) //returns the Automorphism Group of the minimal class of F return ConvertGroupToNumberField(aut(CanonicalFormOfMinimalClass(F)^(-1))); end function; AreEquivalentMinimalClasses:=function(A,B) //tests whether the two classes represented by A and B are equivalent mod GL return isisom((CanonicalFormOfMinimalClass(A))^(-1),(CanonicalFormOfMinimalClass(B))^(-1)); end function; // A procedure to produce all elements of given norm in an ideal P over the integers of a number field ElementsOfNorm:=function(norm,P) OK:=Integers(K); Gram:=MatrixRing(Integers(),2)![[2,Trace(tau)],[Trace(tau),2*Norm(tau)]]; L:=LatticeWithGram(Gram); S:=ShortVectors(L,2*norm,2*norm); output:=[s[1][1]+s[1][2]*tau: s in S]; output:=[x: x in output | x in P]; return output; end function; AllMinVecs:=function(F) //Computes "all" minimal vectors of a form S:=minvecs(F); output:={s: s in S}; for v in S do v10:=true; if v[1][1] ne 0 then X:=[w/v[1][1]: w in ElementsOfNorm(Norm(v[1][1]),p1)]; v10:=false; end if; if v10 then X:=[w/v[1][2]: w in ElementsOfNorm(Norm(v[1][2]),p2)]; else X:=[x:x in X| x*v[1][2] in p2]; end if; output:=output join {x*v: x in X}; end for; output:=output join {-x : x in output}; return [v: v in output]; end function; AllMinVecsList:=function(LL) //Computes "all" minimal vectors from a list of vectors S:=LL; output:={s: s in S}; for v in S do v10:=true; if v[1][1] ne 0 then X:=[w/v[1][1]: w in ElementsOfNorm(Norm(v[1][1]),p1)]; v10:=false; end if; if v10 then X:=[w/v[1][2]: w in ElementsOfNorm(Norm(v[1][2]),p2)]; else X:=[x:x in X| x*v[1][2] in p2]; end if; output:=output join {x*v: x in X}; end for; output:=output join {-x : x in output}; return [v: v in output]; end function; ReynoldsProjection:=function(G,A) //return the value of A under the Reynolds operator of G res:=MatrixRing(K,n)!0; for g in G do res:=res+g*A*HermitianTranspose(g); end for; return (1/(#G))*res; end function;