Computer calculations for "Some singular curves in Mukai's model of
\(\overline{M}_7\)", Section 6
Code 6.7: Constructing a basis of \( V(5\omega_1) \)
Here are the files loaded in this session.
Macaulay2, version 1.20
with packages: ConwayPolynomials, Elimination, IntegralClosure, InverseSystems, Isomorphism, LLLBases, MinimalPrimes, OnlineLookup, PrimaryDecomposition, ReesAlgebra, Saturation, TangentCone
-- warning: symbol "isIsomorphic" in Isomorphism.Dictionary is shadowed by a symbol in LieTypes.Dictionary
-- use the synonym Isomorphism$isIsomorphic
i1 : -- Based on InvariantsOfVotimesVdual.4.m2 and 5
-- First, save and output Wt0TensorBasis. Then also compute F5w1 in Sym5 Std otimes Sym5 Std
-- The code below is for the case domega_1. If V != V* would need to implement a few more things
-- Enter n, lambda, d below, and further down, highest weight vectors v1 and v2
-- Set up the calculation
needsPackage("LieTypes");
i2 : load "LieAlgebraRepresentations.v2.3.m2";
i3 : load "SpinRepresentations.v1.7.m2";
i4 : n=5;
i5 : lambda1={5,0,0,0,0};
i6 : d=5;
i7 : B = so2nBasis(n);
i8 : Bstar = so2nDualBasis(n);
i9 : BstarPerm = flatten apply(#Bstar, i -> flatten select(#B, j -> Bstar_i == 1/(4*(n-1))*B_j));
i10 : so2nRaisingOperators = so2nPositiveRoots(n);
i11 : PhiminusIndices = select(#B, i -> i >=n and not member(B_i,so2nRaisingOperators));
i12 : NegativeRoots = so2nNegativeRootsDbasis(n);
i13 : B = apply(B, M -> sparseRep M);
i14 : Bstar = apply(Bstar, M -> sparseRep M);
i15 : stdRingSubscripts = join(apply(n, i -> -(i+1)),apply(n, i -> i+1));
i16 : K=QQ;
i17 : R1=K[apply(stdRingSubscripts, i -> x_i), MonomialOrder=>Lex];
i18 : R2=K[apply(stdRingSubscripts, i -> y_i), MonomialOrder=>Lex];
i19 : DegDMons1 = flatten entries basis(d,R1);
i20 : DegDMons2 = flatten entries basis(d,R2);
i21 : Bd = apply(DegDMons1, m -> flatten exponents m);
i22 : ZtoE = new HashTable from apply(#Bd, i -> {i,Bd_i});
i23 : EtoZ = new HashTable from apply(#Bd, i -> {Bd_i,i});
i24 : SymdStdBasis = apply(B, X -> XactionOnSymd(X,d,ZtoE,EtoZ));
i25 : ZtoM1 = new HashTable from apply(#DegDMons1, i -> {i,DegDMons1_i});
i26 : R1.cache#MtoZ = new HashTable from apply(#DegDMons1, i -> {DegDMons1_i,i});
i27 : ZtoM2 = new HashTable from apply(#DegDMons2, i -> {i,DegDMons2_i});
i28 : R2.cache#MtoZ = new HashTable from apply(#DegDMons2, i -> {DegDMons2_i,i});
i29 : sparseMatrixToImageLists = (M,L) -> (
apply(#L, i -> sum delete(null,apply(M, x -> if x#0#1==i then (x#1)*(L_(x#0#0)))))
);
i30 : B11 = apply(SymdStdBasis, M -> sparseMatrixToImageLists(M,DegDMons1));
i31 : B12 = apply(SymdStdBasis, M -> sparseMatrixToImageLists(M,DegDMons2));
i32 : LoweringOperators1 = apply(PhiminusIndices, i -> B11_i);
i33 : -- If doing V tensor W, would also need LoweringOperators2
B21 = apply(BstarPerm, i -> B11_i);
i34 : B22 = apply(BstarPerm, i -> B12_i);
i35 : -- V_(5w1) is a summand of Sym^5 V_(w1)
-- Study this representation. Can I get a basis made of words?
testAgainstUTBasis = (f0,B) -> (
if #B==0 then return {f0};
c:=0;
g:=0;
f:=f0;
for j from 0 to #B-1 do (
g = B_j;
c=coefficient(leadMonomial(g),f)/leadCoefficient(g);
f = f - c*g
);
if f==0 then return B else return append(B,f)
);
i36 : writeInUTBasis = (f0,B) -> (
c:=0;
g:=0;
f:=f0;
answer:={};
for j from 0 to #B-1 do (
g = B_j;
c=coefficient(leadMonomial(g),f)/leadCoefficient(g);
answer = append(answer,c);
f = f - c*g
);
if not(f==0) then error "This did not work" << endl;
return answer
);
i37 : actOnMonomial = (Y,m) -> (
R:=ring(m);
Y#((R.cache#MtoZ)#m)
);
i38 : actOnPolynomial = (Y,f) -> (
cl:=coefficients(f);
ml:=flatten entries(cl_0);
cl=flatten entries(cl_1);
sum apply(#ml, i -> (cl_i)*actOnMonomial(Y,ml_i))
);
i39 : so2n = simpleLieAlgebra("D",n);
i40 : WD = weightDiagram(irreducibleLieAlgebraModule(lambda1,so2n));
i41 : Bdense = so2nBasis(n);
i42 : Stdweights = apply(2*n, j -> apply(n, i -> Bdense_i_(j,j)));
i43 : SymdweightsL = apply(Bd, e -> sum apply(2*n, i -> (e_i)*(Stdweights_i)));
i44 : SymdweightsD = apply(SymdweightsL, v -> LtoD v);
i45 : V1mu = (mu) -> (delete(null, apply(#DegDMons1, i -> if SymdweightsD_i==mu then DegDMons1_i)));
i46 : V2mu = (mu) -> (delete(null, apply(#DegDMons2, i -> if SymdweightsD_i==mu then DegDMons2_i)));
i47 : DomWts = select(keys(WD), k -> all(k, i -> i>=0));
i48 : -- Let v be the highest weight vector for Symd Std
v1 = R1_0^d;
i49 : v2 = R2_0^d;
i50 : Fxy = map(R2,R1,gens R2);
o50 : RingMap R2 <--- R1
i51 : -- Generate V(lambda) by applying negative roots to v
wt = (f) -> (
e:=flatten exponents leadMonomial f;
LtoD(sum apply(2*n, i -> (e_i)*(Stdweights_i)))
);
i52 : assert(wt(v1)==lambda1)
i53 : assert(wt(v2)==lambda1)
i54 : applyWord = (w,v,LoweringOperators) -> (
if w=={} then return v;
x:=reverse(w);
u:=v;
for i from 0 to #x-1 do (
u = actOnPolynomial(LoweringOperators_(x_i),u)
);
return u
);
i55 : -- What are the labels?
basisLabels = so2nBasisLabels(n);
i56 : apply(PhiminusIndices, i -> basisLabels_i)
o56 = {X_(1,0), X_(2,0), X_(2,1), X_(3,0), X_(3,1), X_(3,2), X_(4,0), X_(4,1), X_(4,2), X_(4,3), Z_(1,0), Z_(2,0), Z_(3,0), Z_(4,0), Z_(2,1), Z_(3,1), Z_(4,1), Z_(3,2), Z_(4,2), Z_(4,3)}
o56 : List
i57 : Words=new MutableHashTable from {};
i58 : WordsAndVectorsByWeight1 = new MutableHashTable from apply(keys(WD), k -> k=>{});
i59 : UTBasesByWeight1 = new MutableHashTable from apply(keys(WD), k -> k=>{});
i60 : Words#0 = {{}};
i61 : WordsAndVectorsByWeight1#lambda1 = {{{},v1}}
5
o61 = {{{}, x }}
-1
o61 : List
i62 : UTBasesByWeight1#lambda1 = {v1}
5
o62 = {x }
-1
o62 : List
i63 : -- Do words of length 1 separately before starting the loop
WordsOfLengthl = {};
i64 : for i from 0 to #LoweringOperators1-1 do (
Yv = applyWord({i},v1,LoweringOperators1);
if Yv==0 then continue;
wtYv = wt(Yv);
A = UTBasesByWeight1#wtYv;
B = testAgainstUTBasis(Yv,A);
if #B == #A then continue;
WordsAndVectorsByWeight1#wtYv = append(WordsAndVectorsByWeight1#wtYv,{{i},Yv});
UTBasesByWeight1#wtYv = B;
WordsOfLengthl = append(WordsOfLengthl,{i});
);
i65 : WordsOfLengthl
o65 = {{0}, {1}, {3}, {6}, {10}, {11}, {12}, {13}}
o65 : List
i66 : Words#1 = WordsOfLengthl;
i67 : -- Now loop to find the rest
l=1;
i68 : while sum apply(keys(Words), i -> #(Words#i)) < sum(values(WD)) do (
l = l+1;
WordsOfLengthl = {};
for i from 0 to #(Words#(l-1))-1 do (
for j from 0 to first((Words#(l-1))_i) do (
Yv = applyWord(prepend(j,(Words#(l-1))_i),v1,LoweringOperators1);
if Yv==0 then continue;
wtYv = wt(Yv);
A = UTBasesByWeight1#wtYv;
B = testAgainstUTBasis(Yv,A);
if #B == #A then continue;
WordsAndVectorsByWeight1#wtYv = append(WordsAndVectorsByWeight1#wtYv,{prepend(j,(Words#(l-1))_i),Yv});
UTBasesByWeight1#wtYv = B;
WordsOfLengthl = append(WordsOfLengthl,prepend(j,(Words#(l-1))_i));
));
print concatenate("Length ",toString(l)," complete. ",toString(#WordsOfLengthl)," new words found") << endl;
Words#l = WordsOfLengthl;
);
Length 2 complete. 36 new words found
Length 3 complete. 120 new words found
Length 4 complete. 330 new words found
Length 5 complete. 792 new words found
Length 6 complete. 330 new words found
Length 7 complete. 120 new words found
Length 8 complete. 36 new words found
Length 9 complete. 8 new words found
Length 10 complete. 1 new words found
i69 : -- Do some checks
sort(keys(WD)) == sort(keys(WordsAndVectorsByWeight1))
o69 = true
i70 : sort(keys(WD)) == sort(keys(UTBasesByWeight1))
o70 = true
i71 : all(keys(WD), k -> WD#k == #(WordsAndVectorsByWeight1#k))
o71 = true
i72 : all(keys(WD), k -> WD#k == #(UTBasesByWeight1#k))
o72 = true
i73 : -- To do: check that these are all eigenvalues for the Casimir operator with the
-- correct eigenvalue
MyBasisWords = flatten apply(keys(WD), k -> apply(WordsAndVectorsByWeight1#k,p -> p_0));
i74 : MyBasis1 = flatten apply(keys(WD), k -> apply(WordsAndVectorsByWeight1#k,p -> p_1));
i75 : MB1toZ = new HashTable from apply(#MyBasis1, i -> {MyBasis1_i,i});
i76 : -- How complicated is MyBasis?
max apply(MyBasis1, f -> #(terms f))
o76 = 7
i77 : -*
To write Xa f in this basis
write Xa f in the UT basis, and then go back to the original polynomials
*-
UTInverseMatrix = (k) -> (
MB:=apply(WordsAndVectorsByWeight1#k, x -> x_1);
U:=UTBasesByWeight1#k;
M:= transpose matrix apply(MB, f -> writeInUTBasis(f,U));
M^(-1)
);
i78 : UTInverseMatricesByWeight = new HashTable from apply(keys(WD), k -> k=>UTInverseMatrix(k));
i79 : writeInMyBasis1 = (f) -> (
k:=wt(f);
U:=UTBasesByWeight1#k;
u:=transpose matrix {writeInUTBasis(f,U)};
v:=flatten entries((UTInverseMatricesByWeight#k)*u);
MB:=apply(WordsAndVectorsByWeight1#k, x -> x_1);
return delete(null,apply(#v, i -> if v_i!=0 then {MB1toZ#(MB_i),v_i}))
);
i80 : WordsAndVectorsByWeight2 = new MutableHashTable from apply(pairs(WordsAndVectorsByWeight1), p -> {p_0,apply(p_1, q -> {q_0,Fxy(q_1)})});
i81 : UTBasesByWeight2 = new MutableHashTable from apply(pairs(UTBasesByWeight1), p -> {p_0,apply(p_1, f -> Fxy(f))});
i82 : MyBasis2 = apply(MyBasis1, f -> Fxy(f));
i83 : MB2toZ = new HashTable from apply(#MyBasis2, i -> {MyBasis2_i,i});
i84 : writeInMyBasis2 = (f) -> (
k:=wt(f);
U:=UTBasesByWeight2#k;
u:=transpose matrix {writeInUTBasis(f,U)};
v:=flatten entries((UTInverseMatricesByWeight#k)*u);
MB:=apply(WordsAndVectorsByWeight2#k, x -> x_1);
return delete(null,apply(#v, i -> if v_i!=0 then {MB2toZ#(MB_i),v_i}))
);
i85 :
-- Now prepare to work with the tensor product
Wt0TensorBasis = {};
i86 : time for k in keys(WD) do (
fs = apply(WordsAndVectorsByWeight1#(k), p -> p_1);
gs = apply(WordsAndVectorsByWeight2#(-k), p -> p_1);
fsgs = flatten apply(fs, f -> apply(gs, g -> {MB1toZ#f,MB2toZ#g}));
Wt0TensorBasis = append(Wt0TensorBasis, fsgs);
);
-- used 0.000479801 seconds
i87 : Wt0TensorBasis = flatten Wt0TensorBasis;
i88 : #Wt0TensorBasis
o88 = 4722
i89 : fn = openOut "Wt0TensorBasis.m2";
i90 : fn << toString(Wt0TensorBasis) << endl;
i91 : close fn;
Here is the output file
Wt0TensorBasis.m2.txt from this session.
