Projekt:Computeralgebra-Berechnungen/Symmetrische Hilbert-Kunz Theorie/WechselsummeMaxM

Aus Wikiversity

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;