Menu
▾
▴
[Mupad-combinat-commits] SF.net SVN: mupad-combinat:[7597] trunk/MuPAD-Combinat/lib/EXAMPLES
|
From: <nt...@us...> - 2010-10-02 14:47:12
|
Revision: 7597
http://mupad-combinat.svn.sourceforge.net/mupad-combinat/?rev=7597&view=rev
Author: nthiery
Date: 2010-10-02 14:47:05 +0000 (Sat, 02 Oct 2010)
Log Message:
-----------
Commited old changes (improvements?) to HeckeGroup code
Modified Paths:
--------------
trunk/MuPAD-Combinat/lib/EXAMPLES/HeckeGroupAlgebra.mu
trunk/MuPAD-Combinat/lib/EXAMPLES/TEST/HeckeGroupAlgebra.tst
Modified: trunk/MuPAD-Combinat/lib/EXAMPLES/HeckeGroupAlgebra.mu
===================================================================
--- trunk/MuPAD-Combinat/lib/EXAMPLES/HeckeGroupAlgebra.mu 2010-10-02 14:45:01 UTC (rev 7596)
+++ trunk/MuPAD-Combinat/lib/EXAMPLES/HeckeGroupAlgebra.mu 2010-10-02 14:47:05 UTC (rev 7597)
@@ -26,7 +26,9 @@
domain HGAT::V(W: Cat::CoxeterGroup,
R=Dom::ExpressionField(): Cat::Ring)
- inherits Dom::FreeModule(W, R, RankerBasis = combinat::rankers::fromList(W::list()));
+ inherits Dom::FreeModule(W, R,
+ RankerBasis = [combinat::setOptionRemember(W::rank),
+ combinat::setOptionRemember(W::unrank)]);
category Cat::FiniteDimensionalModuleWithBasis(R);
end_domain:
@@ -36,7 +38,9 @@
R=Dom::ExpressionField(): Cat::Ring)
category Cat::FiniteDimensionalAlgebraWithBasis(R);
- interfaceAdd := hold(affineHeckeAlgebraEmbedding);
+ interfaceAdd := {hold(affineHeckeAlgebraEmbedding), text2expr("W"), hold(V),
+ hold(s), hold(pi), hold(opi), hold(fromW), hold(algebraGenerators)
+ };
W := W;
@@ -48,7 +52,6 @@
algebraGenerators := dom::s::list() . dom::pi::list();
// spiBasis := ;
-
// override by better when possible!
fromW :=
@@ -62,17 +65,26 @@
begin
HGAT::AffineHeckeAlgebraEmbedding(dom, args())
end_proc;
-
- opi:= classes::valuesOfTable(i = dom::pi[i] * dom::s[i]
- $ i in W::coxeterGroupGenerators::keys);
+ opii :=
+ proc(i: Type::Union(W::coxeterGroupGenerators::keys,{0})) : dom
+ begin
+ // unlike pi[i] *s[i], this formula requires no computation of products,
+ // and it is independent on the product orientation
+ 1+dom::s[i] - dom::pi[i];
+ end_proc;
+
+ opi:= classes::valuesOfTableWithHiddenKeys
+ (table(i = dom::opii(i) $ i in W::coxeterGroupGenerators::keys),
+ table(0 = dom::opii(0)));
+
hamiltonian :=
/**
* Returns the hamiltonian, as an element of the
* algebra of the symmetric group
**/
proc(x) : dom
- local i, j, s;
+ local i, j;
begin
if args(0) = 0 then
// The roots of the hermite polynomial, expressed via radical expressions
@@ -90,7 +102,38 @@
end_category:
protect(Cat):
+/**
+ X := HGAT::X(exponentSet, f)
+
+ returns a gadget X such that X^bla yields f(bla)
+ **/
+domain HGAT::X
+ inherits Dom::BaseDomain;
+ category Cat::Object;
+ new :=
+ proc(exponentSet, exp: Type::Morphism())
+ begin
+ new(dom, exponentSet, exp);
+ end_proc;
+
+ get_exponentSet :=
+ proc(X: dom)
+ begin
+ extop(X,1);
+ end_proc;
+
+ _power :=
+ proc(X: dom, e)
+ begin
+ Precondition(testtype(e, X::exponentSet));
+ extop(X,2)(e);
+ end_proc;
+
+ expr := X -> hold(X);
+
+end_domain:
+
domain HGAT::AffineHeckeAlgebraEmbedding
(HGA: Cat::HeckeGroupAlgebra,
Eigenvalues = [hold(q1),hold(q2)], // The two eigenvalues of the T's
@@ -98,41 +141,92 @@
direction = Down: [Up, Down]
)
local Pi, oPi, Q1, Q2;
+ inherits Dom::BaseDomain;
+ category Cat::FacadeDomain(HGA);
Ti :=
- proc(i: HGA::W::coxeterGroupGenerators::keys) : HGA
+ proc(i: Type::Union(HGA::W::coxeterGroupGenerators::keys,{0})) : HGA
option remember;
begin
(Q1+Q2) * Pi[i] - Q1 * HGA::s[i];
end_proc;
- T := classes::valuesOfTable(i = dom::Tq(i)
- $ i in HGA::W::coxeterGroupGenerators::keys);
+ T := classes::valuesOfTableWithHiddenKeys // This calls for a zip on classes::valuesOfTableWithHiddenKeys
+ (table(i = dom::Ti(i) $ i in HGA::W::coxeterGroupGenerators::keys),
+ table(0 = dom::Ti(0)));
// Essentially the inverse of Ti (Ti*oTi =Q1*Q2)
oTi :=
proc(i: HGA::W::coxeterGroupGenerators::keys) : HGA
option remember;
begin
- (Q1+Q2) * (Pi[i]-1) - Q1 * HGA::s[i];
+ (Q1+Q2) * oPi[i] - Q2 * HGA::s[i];
end_proc;
- T := classes::valuesOfTable(i = dom::Ti(i)
- $ i in HGA::W::coxeterGroupGenerators::keys);
- oT := classes::valuesOfTable(i = dom::oTi(i)
- $ i in HGA::W::coxeterGroupGenerators::keys);
+ oT := classes::valuesOfTableWithHiddenKeys // This calls for a zip on classes::valuesOfTableWithHiddenKeys
+ (table(i = dom::oTi(i) $ i in HGA::W::coxeterGroupGenerators::keys),
+ table(0 = dom::oTi(0)));
+ rootSystem := combinat::rootSystem(HGA::W::cartanType);
+ indexSet := dom::rootSystem::indexSet;
+ rootLattice := (combinat::rootSystem(HGA::W::cartanType))::rootLattice;
+ ambientLattice := (combinat::rootSystem(HGA::W::cartanType))::ambientLattice;
+ affineRootSystem := combinat::rootSystem(dom::rootSystem::affineCartanType);
+ affineWeightLattice := dom::affineRootSystem::weightLattice;
+ // embedding of the classical root lattice at level 0 of the affine weight lattice
+ Q0ToP := dom::rootLattice::moduleMorphism(dom::affineWeightLattice::simpleRoot);
+
+ // returns the eigenvalue of X^\lambda on w0, computed from the alcove walk definition
+
+
+ Xlambda :=
+ proc(lambda: dom::rootLattice) : HGA
+ local walk, plusminus;
+ begin
+ walk := (dom::Q0ToP(lambda))::alcoveWalkOfTranslation();
+ plusminus := _plus(op(map(walk, op, 2)));
+ assert(plusminus mod 2 = 0);
+ // Note: this really is a morphism from the alcove walk algebra/monoid!
+ HGA::mult(dom::T[stp[1]]^stp[2] $ stp in walk) / (-Q1*Q2)^(plusminus/2)
+ end_proc;
+
+ Xi :=
+ proc(i: dom::indexSet) : HGA
+ option remember;
+ begin
+ dom::Xlambda(dom::rootLattice::simpleRoots[i]);
+ end_proc;
+ XlambdaViaSimpleRoots :=
+ dom::rootLattice::moduleMorphism(dom::Xi,
+ Zero = HGA::one, Plus=HGA::mult, Multcoeffs = _power);
+ // We would like an exponent notation instead of indexed one
+ X := HGAT::X(dom::rootLattice, dom::XlambdaViaSimpleRoots);
+
+ // The almost intertwining operators of Arun Ram's "Calibrated representations
+ // of affine Hecke algebras" p. 7 arxiv:math/0401323v2
+ taui :=
+ if dom::fromWeight <> FAIL then
+ proc(i: dom::indexSet): HGA
+ begin
+ dom::T[i] - (Q1+Q2) * 1/(1-dom::X^-dom::rootLattice::simpleRoots[i]);
+ end_proc;
+ end_if;
+
+ tau :=
+ if dom::taui <> FAIL then
+ classes::valuesOfTable(i = dom::taui(i)
+ $ i in HGA::W::coxeterGroupGenerators::keys);
+ end_if;
+
// Everything below is mostly type A!
- ambientLattice := (combinat::rootSystem(HGA::W::cartanType))::ambientLattice;
-
Omega := HGA::mult(HGA::s[i] $ i in HGA::W::coxeterGroupGenerators::keys);
Yi :=
proc(i: dom::ambientLattice::basisIndices) : HGA
begin
- HGA::mult(dom::oTi(j) $ j in revert([$1..i-1]), // specific to type A!
+ HGA::mult(-dom::oTi(j) $ j in revert([$1..i-1]), // specific to type A!
dom::Omega,
dom::Ti (j) $ j in revert([$i..HGA::W::coxeterGroupGenerators::count()])):
end_proc;
@@ -142,27 +236,65 @@
fromWeight :=
if 1/dom::Y[1] <> FAIL then
- proc(w: dom::ambientLattice) : HGA
+ proc(w: dom::rootSystem::ambientLattice) : HGA
+ local i;
begin
- HGA::mult(dom::Y[i]^w[i] $ i in dom::ambientLattice::basisIndices);
+ HGA::mult(dom::Y[i]^w[i] $ i in dom::rootSystem::ambientLattice::basisIndices);
end_proc;
end_if;
- // The almost intertwining operators of Arun Ram's "Calibrated representations
- // of affine Hecke algebras" p. 7 arxiv:math/0401323v2
- taui :=
- if dom::fromWeight <> FAIL then
- proc(i: HGA::W::coxeterGroupGenerators::keys): HGA
+ eigenvalueOfX :=
+ proc(lambda: dom::rootLattice) : Dom::ExpressionField()
+ local walk, plusminus;
begin
- dom::T[i] - (Q1+Q2) * 1/(1-dom::fromWeight(-dom::ambientLattice::simpleRoots[i]));
+ walk := (dom::Q0ToP(lambda))::alcoveWalkOfTranslation();
+ // The number of positive crossing minus negative crossing in the walk
+ plusminus := _plus(op(map(walk, op, 2)));
+ assert(plusminus mod 2 = 0);
+ // Note: this really is a morphism from the alcove walk algebra/monoid!
+ (-Q2/Q1)^(plusminus/2)
end_proc;
- end_if;
- tau :=
- if dom::taui <> FAIL then
- classes::valuesOfTable(i = dom::taui(i)
- $ i in HGA::W::coxeterGroupGenerators::keys);
- end_if;
+
+ calibratedGraph :=
+ proc()
+ option escape;
+ local W, alpha, s, nodes, backwardEdges, w, i;
+ begin
+ W := Dom::WeylGroup(dom::rootLattice);
+ alpha := dom::rootLattice::simpleRoots;
+ s := W::coxeterGroupGenerators;
+ nodes :=
+ classes::valuesOfTable(w = [dom::eigenvalueOfX(w::action(alpha[i])) $ i in alpha::keys]
+ $ w in W::list());
+ backwardEdges := {};
+ edges :=
+ [
+ if w::hasDescent(i) then
+ if nodes[w][i] <> 0 then
+ [nodes[w], nodes[w*s[i]]]
+ else
+ null();
+ end_if;
+ else
+ if nodes[w*s[i]][i] <> -q2/q1 and nodes[w*s[i]][i] <> -q1/q2 then
+ backwardEdges := backwardEdges union {[nodes[w], nodes[w*s[i]]]};
+ [nodes[w], nodes[w*s[i]]]
+ else
+ null();
+ end_if;
+ end_if
+ $ i in s::keys
+ $ w in W::list()
+ ];
+ nodes := [op({op(nodes::list())})];
+ if nops(nodes) <> W::count() then
+ warning("non calibrated!")
+ end_if;
+ [Graph(nodes, edges, Directed),
+ EdgeOptions = ((edge) -> if contains(backwardEdges, edge) then Backward else null() end_if)];
+ end_proc;
+
begin
if direction = Down then
Pi := HGA::pi;
@@ -240,7 +372,9 @@
*
* Remove from sigma the reculs that are descents of pi
**/
+ /*
straighten :=
+ // Rewrite using cosets ...
proc(l: dom::typePairOfPermutationsOfN) : dom
local pi, sigma, si, i, j;
begin
@@ -267,7 +401,7 @@
end_for;
[pi, permutations::inverse(sigma)];
end_proc;
-
+ */
end_domain:
@@ -277,13 +411,23 @@
V := HW::matrices::V;
- s := classes::valuesOfTable(i = dom::V::moduleMorphism(dom::V::term @ HW::W::onRightGenerator(i))
- $ i in HW::W::coxeterGroupGenerators::keys);
+ s := classes::valuesOfTableWithHiddenKeys
+ (table(i = dom::V::moduleMorphism(dom::V::term @ HW::W::onRightGenerator(i))
+ $ i in HW::W::coxeterGroupGenerators::keys),
+ if HW::W::s0 <> FAIL then
+ table(0 = dom::V::moduleMorphism(dom::V::term @ HW::W::onRight(HW::W::s0)))
+ else
+ table()
+ end_if
+ );
sLeft := classes::valuesOfTable(i = dom::V::moduleMorphism(dom::V::term @ HW::W::onLeftGenerator(i))
$ i in HW::W::coxeterGroupGenerators::keys);
- pi := classes::valuesOfTable(i = dom::V::moduleMorphism(dom::V::term @ HW::W::heckeGenerator(i))
- $ i in HW::W::coxeterGroupGenerators::keys);
+ pi := classes::valuesOfTableWithHiddenKeys
+ (table(i = dom::V::moduleMorphism(dom::V::term @ HW::W::heckeGenerator(i))
+ $ i in HW::W::coxeterGroupGenerators::keys),
+ table(0 = dom::V::moduleMorphism(dom::V::term @ HW::W::pi0))
+ );
end_domain:
domain HGAT::matrices(HW)
@@ -297,6 +441,7 @@
convertFromMatrices := dom::getEntryFrom(Matrices, "convert");
convert :=
proc(x) : Type::Union(dom, DOM_FAIL)
+ local result;
begin
if args(0) = 1 and (result := dom::convertImplicit(x)) <> FAIL then
return(result);
@@ -417,6 +562,7 @@
piFromW := w -> dom::term([W::one, w]);
one:= dom::term([W::one, W::one]);
+ // TODO: add s[0] and pi[0]!
s := classes::map(W::coxeterGroupGenerators, dom::fromW);
pi := classes::map(W::coxeterGroupGenerators, dom::piFromW);
@@ -438,12 +584,13 @@
(Type::ListProduct(dom::coeffRing,
Type::ListOf(dom::algebraGenerators::keys)))
begin
- [
- [op(term,1),
- map((op(term,[2,1]))::reducedWord(), i -> [1,i]).
- map((op(term,[2,2]))::reducedWord(), i -> [2,i])]
- $ term in x::toList()
- ]
+ map(x::toList(),
+ proc(term)
+ begin
+ [op(term,1),
+ map((op(term,[2,1]))::reducedWord(), i -> [1,i]).
+ map((op(term,[2,2]))::reducedWord(), i -> [2,i])]
+ end_proc):
end_proc;
toMatrices :=
@@ -472,6 +619,7 @@
unrank := combinat::rankers::fromList(W::list())[2];
inverseOnSupport :=
proc(rowcol: HW::matrices::basisIndices) : Type::Union(DOM_FAIL, dom::basisIndices)
+ local result;
begin
result := [unrank(rowcol[1])^-1, unrank(rowcol[2])];
if dom::basisIndices::isReduced(result) then
@@ -500,7 +648,7 @@
interfaceAdd := {hold(matrices), hold(byClosure),
hold(byEquations), hold(sigmapi)
};
-
+ bases := { dom::sigmapi };
W := W;
operators := HGAT::operators(dom);
matrices := HGAT::matrices(dom);
Modified: trunk/MuPAD-Combinat/lib/EXAMPLES/TEST/HeckeGroupAlgebra.tst
===================================================================
--- trunk/MuPAD-Combinat/lib/EXAMPLES/TEST/HeckeGroupAlgebra.tst 2010-10-02 14:45:01 UTC (rev 7596)
+++ trunk/MuPAD-Combinat/lib/EXAMPLES/TEST/HeckeGroupAlgebra.tst 2010-10-02 14:47:05 UTC (rev 7597)
@@ -16,113 +16,165 @@
R := Dom::ExpressionField()://id, iszero@normal):
HW := examples::HeckeGroupAlgebra(W, R):
// Check that the natural representation is indexed appropriately
+if n=3 then
prog::test((HW::matrices::V::term(W([3, 2, 1])))::sparseVector(),
matrix([[0], [0], [0], [0], [0], [1]])):
prog::test((HW::matrices::V::term(W([1, 2, 3])))::sparseVector(),
matrix([[1], [0], [0], [0], [0], [0]])):
+end_if:
prog::test((HW::matrices::V::genericElement(a))::sparseVector(),
- matrix([[a(W([1, 2, 3]))], [a(W([1, 3, 2]))], [a(W([2, 1, 3]))], [a(W([2, 3, 1]))], [a(W([3, 1, 2]))], [a(W([3, 2, 1]))]])):
+ matrix([[a(W(p))] $ p in combinat::permutations(n)])):
+checkHeckeRelations :=
+proc(t: Cat::CombinatorialClass, cartanType: combinat::cartanType, q1=-1, q2=1)
+begin
+ M := combinat::coxeterMatrix(cartanType);
+ for i in M::rowIndices do
+ for j in M::rowIndices do
+ if j=i then
+ if q1 <> BraidOnly then
+ prog::test(iszero(normal((t[i]-q1)*(t[i]-q2))))
+ end_if;
+ else
+ m := (M[i,j]-1)/2;
+ prog::test(iszero(normal( t[i] * (t[j]*t[i])^m - (t[j]*t[i])^m * t[j] )));
+ end_if;
+ end_for;
+ end_for;
+end_proc:
+
for H in [HW::matrices/*, HW::byClosure, HW::byEquations*/] do
embedding := H::affineHeckeAlgebraEmbedding([q1,q2]);
s := H::s: pi := H::pi: opi := H::opi: sLeft := H::sLeft:
T := embedding::T: oT := embedding::oT: tau := embedding::tau;
Y := embedding::Y:
V := H::V:
- ambientLattice := embedding::ambientLattice;
+ rootLattice := embedding::rootLattice;
Omega := embedding::Omega:
- // some relatively generic weight
- lambda := ambientLattice::rho;
- for i from 1 to n-1 do
+ affineCartanType := rootLattice::rootSystem::affineCartanType;
+ prog::testfunc("s, pi, opi");
+ checkHeckeRelations(s, affineCartanType, -1, 1);
+ checkHeckeRelations(sLeft, W::cartanType, -1, 1);
+ checkHeckeRelations(pi, affineCartanType, 0, 1); // FAILS for A_1^1!!!
+ checkHeckeRelations(opi, affineCartanType, 0, 1);
+ for i from 0 to n-1 do
prog::test(iszero(s[i] * pi[i] - pi[i]));
- prog::test(iszero(pi[1] + opi[1] - s[1] -1));
+ prog::test(iszero(pi[i] + opi[i] - s[i] -1));
+ end_for;
- prog::test(iszero(normal(oT[i] - (T[i] -q1-q2))));
- prog::test(iszero(normal(T[i] * oT[i] + q1*q2 )));
- prog::test(iszero(mapcoeffs(Y[1], subs,q1=-1,q2=1) - R(1))):
- prog::test(iszero(mapcoeffs(Y[1], subs,q1=1,q2=-1) - R(1))):
- prog::test(iszero(normal(Y[i] * Y[i+1] - Y[i+1] * Y[i])));
+ //////////////////////////////////////////////////////////////////////////
+ prog::testfunc("T and oT");
+ checkHeckeRelations(T, affineCartanType, q1, q2):
+ checkHeckeRelations(oT, affineCartanType, q1, q2):
+ for i from 0 to n-1 do
+ prog::test(iszero(normal(T[i] + oT[i] - (q1+q2))));
+ prog::test(iszero(normal(T[i] * oT[i] - (q1*q2))));
+ end_for;
+
+ //////////////////////////////////////////////////////////////////////////
+ if Y <> FAIL and Omega <> FAIL then
+ prog::testfunc("Y and Omega");
+ for i from 1 to n do
+ prog::test(iszero(mapcoeffs(Y[i], subs, q1=-1, q2= 1) - R(1))):
+ prog::test(iszero(mapcoeffs(Y[i], subs, q1= 1, q2=-1) - R(1))):
+ if i < n then
+ prog::test(iszero(normal(Y[i] * Y[i+1] - Y[i+1] * Y[i])));
+ end_if;
// Commutation between Y and T
if H = HW::matrices then
prog::test(iszero(normal(Y[1] * T[1] - T[1] * Y[2] -(q1+q2)*(Y[1]-Y[2])/(1-Y[2]/Y[1])))):
end_if;
- if i < n-1 then
- prog::test(iszero(normal(T[i+1] * Omega - Omega * T[i]))):
- end_if;
+ prog::test(iszero(normal(T[i mod n] * Omega - Omega * T[i-1]))):
end_for;
- if tau <> FAIL then
- for i from 1 to n-1 do
- prog::test(iszero(normal(embedding::fromWeight(lambda) * tau[i] -
- tau[i] *embedding::fromWeight(ambientLattice::simpleReflections[i](lambda)))));
- Xalphai := embedding::fromWeight(ambientLattice::simpleRoots[i]):
+ end_if;
+ // Check with definition of the Y's by Arun's def
+ // t[2] := s[0]*s[1]*s[0]*s[2]
+
+ prog::testfunc("X and tau");
+ X := embedding::X;
+ alpha := rootLattice::simpleRoots;
+ sQ := rootLattice::simpleReflections;
+ for i from 1 to n-1 do
+ for lambda in rootLattice::simpleRoots do
+ prog::test(iszero(mapcoeffs(X^lambda, subs, q1=-1, q2=1)-1));
+ // at q1=-q2, T[i] is a multiple of s[i], so the X should degenerate to identity
+ prog::test(iszero(mapcoeffs(X^lambda, subs, q1=-q2)-1));
+ for lambda2 in rootLattice::simpleRoots do
+ prog::test(iszero(normal(X^lambda * X^lambda2 - X^lambda2 * X^lambda)));
+ prog::test(iszero(normal(X^(lambda+lambda2) - X^lambda2 * X^lambda)));
+ end_for;
+ prog::test(iszero(normal(X^lambda * tau[i] -
+ tau[i] *X^(sQ[i](lambda)))));
+ end_for;
+ checkHeckeRelations(tau, W::cartanType, BraidOnly);
// quadratic relation from Arun's paper
- tau[i]^2 - ( q1+ q2 * Xalphai) * ( q1+q2* 1/Xalphai) / (1-Xalphai) / (1-1/Xalphai):
+ tau[i]^2 - ( q1+ q2 * X^alpha[i]) * ( q1+q2*X^-alpha[i]) / (1-X^alpha[i]) / (1-X^-alpha[i]):
// The tau_i's preserve antisymmetries
- for j from 1 to n-1 do
- prog::test(iszero(normal((sLeft[j]-1) * tau[i] * (sLeft[j]+1))));
- end_for;
+ for j from 1 to n-1 do
+ prog::test(iszero(normal((sLeft[j]-1) * tau[i] * (sLeft[j]+1))));
end_for;
-
- ratio :=
- proc(v, w)
- local r;
- begin
- if lterm(v) <> lterm(w) then
- return(FAIL):
- end_if;
- r := lcoeff(v)/lcoeff(w):
- if not iszero(normal(r*w - v)) then
- return(FAIL)
- end_if;
- r
- end:
- eigenvector :=
- proc(w: W)
- option remember;
- local i, wi;
- begin
- if w = W::one then return(V::term(W::maximalElement())) end_if;
- i := w::firstDescent():
- wi := w*W::coxeterGroupGenerators[i];
+ end_for;
+
+ prog::testfunc("hamiltonian");
+ ratio :=
+ proc(v, w)
+ local r;
+ begin
+ if lterm(v) <> lterm(w) then
+ return(FAIL):
+ end_if;
+ r := lcoeff(v)/lcoeff(w):
+ if not iszero(normal(r*w - v)) then
+ return(FAIL)
+ end_if;
+ r
+ end:
+ eigenvector :=
+ proc(w: W)
+ option remember;
+ local i, wi;
+ begin
+ if w = W::one then return(V::term(W::maximalElement())) end_if;
+ i := w::firstDescent():
+ wi := w*W::coxeterGroupGenerators[i];
// If just factor is done, zero coeffs are not discarded
// See comment in FreeModulePoly::mapcoeffs
- return(mapcoeffs(normal(eigenvector(wi) * tau[i]), factor))
- end:
- eigenvectors := classes::indexed(W, eigenvector):
- eigenvalues := [ (-q1)^k*q2^(n-1-k) $ k=0..n-1 ]:
- antisymmetries :=
- proc(v)
- begin
- select([$1..n-1], i->iszero(normal(v::mapsupport((W::coxeterGroupGenerators[i])::onLeft())+v)))
- end_proc;
- for w in W do
- prog::test(w([normal(ratio(eigenvectors[w]*Y[i], eigenvectors[w])) $ i=1..n]), [ (-q1)^k*q2^(n-1-k) $ k=0..n-1 ]):
+ return(mapcoeffs(normal(eigenvector(wi) * tau[i]), factor))
+ end:
+ eigenvectors := classes::indexed(W, eigenvector):
+ eigenvalues := [ (-q1)^k*q2^(n-1-k) $ k=0..n-1 ]:
+ antisymmetries :=
+ proc(v)
+ begin
+ select([$1..n-1], i->iszero(normal(v::mapsupport((W::coxeterGroupGenerators[i])::onLeft())+v)))
+ end_proc;
+ for w in W do
+ prog::test(w([normal(ratio(eigenvectors[w]*Y[i], eigenvectors[w])) $ i=1..n]), [ (-q1)^k*q2^(n-1-k) $ k=0..n-1 ]):
// since we start from w_0, the dynkin diagram is inverted (i->n-i)
- prog::test(antisymmetries(eigenvectors[w]), sort(map(w::recoils(),i->n-i))):
- end_for:
- w0 := W::maximalElement():
+ prog::test(antisymmetries(eigenvectors[w]), sort(map(w::recoils(),i->n-i))):
+ end_for:
+ w0 := W::maximalElement():
- idempotent :=
- proc(w: W) : H
- begin
- normal(_mult((Y[i]-eigenvalues[w(j)])/(eigenvalues[w(i)]-eigenvalues[w(j)]) $ j in {$1..n} minus {i} $ i=1..n)):
- end_proc:
- idempotents := classes::indexed(W, idempotent):
+ idempotent :=
+ proc(w: W) : H
+ begin
+ normal(_mult((Y[i]-eigenvalues[w(j)])/(eigenvalues[w(i)]-eigenvalues[w(j)]) $ j in {$1..n} minus {i} $ i=1..n)):
+ end_proc:
+ idempotents := classes::indexed(W, idempotent):
// Check that the idempotents form a maximal decomposition of the identity
// and that we get the same eigenvectors
- prog::test(iszero(H::plus(idempotents[w] $ w in W::list()) - 1));
- for w1 in W do
- for w2 in W do
- p1 := idempotents[w1]:
- p2 := idempotents[w2]:
- if w1 <> w2 then
- prog::test(iszero(p1*p2));
- else
- prog::test(iszero(p1*p1-p1));
- end_if;
- end_for;
- prog::test(iszero(eigenvectors[w1]*p1-eigenvectors[w1]))
- end_for:
- end_if;
+ prog::test(iszero(H::plus(idempotents[w] $ w in W::list()) - 1));
+ for w1 in W do
+ for w2 in W do
+ p1 := idempotents[w1]:
+ p2 := idempotents[w2]:
+ if w1 <> w2 then
+ prog::test(iszero(p1*p2));
+ else
+ prog::test(iszero(p1*p1-p1));
+ end_if;
+ end_for;
+ prog::test(iszero(eigenvectors[w1]*p1-eigenvectors[w1]))
+ end_for:
h1 := s[1] + s[2]:
h2 := s[1]*s[2] + s[2]*s[1]:
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
