Projekt:Computeralgebra-Berechnungen/Symmetrische Hilbert-Kunz Theorie/WechselsummeMaxM
Syntax: WechselsummeMaxM(AbbMat,F2Twists, L, Q, MaxM);
AbbMat ist eine Matrix, F2Twists Liste von ganzen Zahlen, L Liste von Polynomen, Q und MaxM natürliche Zahlen.
Zur Berechnung der korrigierten symmetrischen Codimension als
Genauer sei
eine freie Auflösung des Ideals mit
und
Dann liefert
die Q-te KSC.
-- TqMaxMComplete.coc -- alle Funktionen zur Berechnung der einfach korrigierten symmetrischen Codimension -- Berechne k-VR-Basis von Poly.ring^N/M -- also M von der Form Module(List of Vectors) Define NormalBasis(M,Coord) G:=Gens(LT(M)); N:=Len(G[1]); G:=[Vector(Q) |Q In G]; NBasis:=[]; L:=[Comp(List(G[J]),Coord) | J In 1..Len(G)]; IList:=QuotientBasis(Ideal(L)); NBasis:=Concat(NBasis, [Q*E_(Coord,N) |Q In IList]); Return NBasis; EndDefine; Define NormalBasisM(M) G:=Gens(M); Nbr:=Len(G[1]); Return ConcatLists([NormalBasis(M,I) | I In 1..Nbr]); EndDefine; Define Choose(N,K); If ((N>=K) And (K>=0)) Then Return Bin(N,K); Else Return 0; EndIf; EndDefine; Define DimR(M) Return Choose(M+2,2); EndDefine; Define DimH0Sq(ListOfTwists, Q, AdditionalTwist); N:=Len(ListOfTwists); SymTwists:=[]; IndexSet:=SymIndexRecursive(N,Q); Foreach Indx In IndexSet Do Append(SymTwists, Sum([Indx[I]*ListOfTwists[I]|I In 1..N])); EndForeach; RList:=[]; Foreach Twist In SymTwists Do Append(RList, DimR(Twist+AdditionalTwist)); EndForeach; Return Sum(RList); EndDefine; -- 2 Arten, alle Monome vom Grad N in K Variablen zu parametrisieren: -- SymIndexRecursive(K,N): -- SymIndexRecursive(3,4) gibt Tripel mit Gesamtsumme 4 aus: -- [4,0,0] (x^4), [3,1,0] (x^3 y), ..., [0,0,4] (z^4) -- ExtendedSymIndex(K,N): -- ExtendedSymIndex(3,4) gibt monoton steigende 4-Tupel der Zahlen 1,2,3 aus: -- [1,1,1,1] (xxxx),[1,1,1,2] (xxxy),...,[3,3,3,3] (zzzz) Define SymIndexRecursive(K,N) If (K=1) Then Return [[N]] Else IndexSet:=[]; FirstIndex:=[N]; For I:=2 To K Do Append(FirstIndex, 0) EndFor; Append(IndexSet, FirstIndex); For I:=1 To N Do CurrentIndex:=[]; RecList:=SymIndexRecursive(K-1, I); Foreach Indx In RecList Do -- Print Indx," "; Indx:=Concat([N-I],Indx); Append(CurrentIndex, Indx); EndForeach; IndexSet:=Concat(IndexSet, CurrentIndex); EndFor; Return IndexSet EndIf; EndDefine; Define ExtendedSymIndex(K,N) Exponents:=SymIndexRecursive(K,N); RList:=[]; While (Exponents<>[]) Do Expo:=Head(Exponents); Exponents:=Tail(Exponents); NewIndex:=[]; For I:=1 To K Do For J:=1 To Expo[I] Do Append(NewIndex, I) EndFor; EndFor; Append(RList, NewIndex); EndWhile; Return RList; EndDefine; Define Anordnungen(IndexTuple); Perms:=Permutations(IndexTuple); Anord:=[]; While (Perms<>[]) Do P:=Head(Perms); Perms:=Tail(Perms); If (P IsIn Anord)=False Then Append(Anord, P) EndIf; EndWhile; Return Anord; EndDefine; Define SymAbbMatTF(AbbMat, N); IndexSetDomain:=ExtendedSymIndex(Len(AbbMat[1]), N); IndexSetRange:=ExtendedSymIndex(Len(AbbMat), N); --Return [IndexSetRange, IndexSetDomain]; SMatrix:=[]; Foreach A In IndexSetRange Do SRowA:=[]; AnordA:=Anordnungen(A); --Return [A, AnordA]; Foreach Alpha In IndexSetDomain Do AnordAlpha:=Anordnungen(Alpha); SumList:=[]; Foreach APrime In AnordA Do Foreach AlphaPrime In AnordAlpha Do ProdList:=[]; For I:=1 To N Do Append(ProdList, AbbMat[APrime[I]][AlphaPrime[I]]) EndFor; Append(SumList, Product(ProdList)); EndForeach; EndForeach; SEntryAAlpha:=Sum(SumList)/(Len(AnordA)); --PrintLn A, Alpha, SumList, SEntryAAlpha; Append(SRowA, SEntryAAlpha); EndForeach; Append(SMatrix, SRowA); EndForeach; Return Mat(SMatrix); EndDefine; Define SymTwists(ListOfTwists, Q); N:=Len(ListOfTwists); TheSymTwists:=[]; IndexSet:=SymIndexRecursive(N,Q); Foreach Indx In IndexSet Do Append(TheSymTwists, Sum([Indx[I]*ListOfTwists[I]|I In 1..N])); EndForeach; Return TheSymTwists; EndDefine; Define PsiMat(F1Twists, Q, MaxM) N1:=Len(F1Twists); SymTwists1:=SymTwists(F1Twists, Q); RankG:=Sum([DimR(MaxM-K)|K In SymTwists1]); RankSqF1:=Len(SymTwists1); ListOfMatrices:=[]; For I:=1 To RankSqF1 Do M:=MaxM+SymTwists1[I]; DenseM:=DensePoly(M); MonomialsM:=Monomials(DenseM); LenM:=Len(MonomialsM); NewMatrix:=NewMat(RankSqF1, LenM,0); NewMatrix[I]:=MonomialsM; Append(ListOfMatrices, NewMatrix); EndFor; PsiMatrix:=BlockMatrix([ListOfMatrices]); Return PsiMatrix; EndDefine; Define ExtendedSMat(AbbMat, F1Twists, Q, MaxM); PhiBlock:=SymAbbMatTF(AbbMat, Q); PsiBlock:=PsiMat(F1Twists,Q,MaxM); RMatrix:=BlockMatrix([[PhiBlock, PsiBlock]]); Return RMatrix; EndDefine; Define TqCokerMaxM(AbbMat,F1Twists, Q, MaxM) ESMatrix:=ExtendedSMat(AbbMat, F1Twists, Q, MaxM); ImageGenerators:=ColumnVectors(ESMatrix); ImageES:=Module(ImageGenerators); CokerBasis:=NormalBasisM(ImageES); Return Len(CokerBasis); EndDefine; Define H0TqViaCoker(AbbMat,F2Twists, L, Q, MaxM); F1Twists:=[-Deg(F)| F In L]; Term1:=TqCokerMaxM(AbbMat,F1Twists,Q,MaxM+1); SymTwists1:=SymTwists(F1Twists,Q); SymTwists2:=SymTwists(F2Twists,Q); Term2:=Sum([DimH0Sq(F1Twists, Q, M)|M In 0..MaxM]); Term3:=Sum([DimH0Sq(F2Twists, Q, M)|M In 0..MaxM]); Return Term1-Term2+Term3; EndDefine; Define WechselsummeMaxM(AbbMat,F2Twists, L, Q, MaxM); F1Twists:=[-Deg(F)| F In L]; Term1:=H0TqViaCoker(AbbMat,F2Twists, L, Q, MaxM); Term2:=Sum([DimH0Sq(F2Twists, Q, M)|M In 0..MaxM]); Term3:=Sum([DimH0Sq(F1Twists, Q, M)|M In 0..MaxM]); Term4:=Sum([DimH0Sq(F1Twists, Q-1, M)|M In 0..MaxM]); Return -Term1+Term2-Term3+Term4; --h^1(Syz)-h^1(Tq)! EndDefine;