Update of /cvsroot/mupad-combinat/MuPAD-Combinat/lib/EXPERIMENTAL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7613
Added Files:
ribbonsTableaux.mu
Log Message:
expermimental functions on ribbons Tableaux
--- NEW FILE: ribbonsTableaux.mu ---
/*****************************************************************************
$Id: ribbonsTableaux.mu,v 1.30 2004/11/03 10:31:10 fdescouens Exp $
File: lib/COMBINAT/ribbons.mu
Authors: Francois Descouens < francois.descouens@... >
Created: 15/11/2003
License: LGPL
*****************************************************************************/
//////////////////////////////////////////////////////////////////////////////////////////////
// TESTING PART OF THE LIBRARY Ccombinat::ribbonsTableaux
//////////////////////////////////////////////////////////////////////////////////////////////
domain experimental::ribbonsTableaux
inherits Dom::BaseDomain;
axiom Ax::systemRep;
info := "Library 'experimental::ribbonsTableaux': experimental part of combinat::ribbonsTableaux library";
interfaceAdd :={hold(qSchurProductFromQuotient),
hold(hFunction), hold(hFunctionListFromPartition), hold(hFunctionListFromLength),
hold(tableauDiagonalClass), hold(listDiagonalClass), hold(diagonalClass),
hold(spinPolynomDiagonalClass), hold(allSpinPolynomDiagonalClass),
hold(cospinFromInversions),
hold(studyDiagonalClasses),
hold(isNewYamanouchiWord), hold(yamanouchiReading),
hold(riggedConfiguration),
hold(semiStandardSkewTableauxList), hold(hallPolynomial), hold(multiHallPolynomial),
hold(qBinomial), hold(hallPolynomialS), hold(wFunction),
hold(isLexicoSup), hold(isLexicoInf)
};
//Options system for selecting different type of q-analogue
///////////////////////////////////////////////////////////
parseOptions_OptionTypes :=
table(
core = combinat::partitions,
stat = DOM_STRING,
base = DOM_STRING,
alph = DOM_INT,
yam = DOM_BOOL
);
parseOptions :=
proc()
begin
dom::parseOptionsRibbonsTableaux
(table(core = [],
stat = "spin",
base = "s",
alph = 0,
yam = FALSE
),
args()
):
end_proc;
parseOptionsRibbonsTableaux :=
proc(defaultOptions: Type::OptionsTable)
: Type::SequenceOf(Type::AnyType,1,5)
local options;
begin
options := prog::getOptions(defaultOptions,
dom::parseOptions_OptionTypes,
1,Error);
//print("options",options,domtype(options));
options[core] , options[stat] , options[base] , options[alph] , options[yam];
end_proc;
///////////////////////////////////////////////////////////////////////////////////////////
// Definition of differents q-analogues of products of schur functions
///////////////////////////////////////////////////////////////////////////////////////////
//function which give us q-analogue of schur functions product with spin or cospin and on different basis
//////////////////////////////////////////////////////////////////////////////////////////////////////////
qSchurProductFromQuotient :=
proc( quotient: Type::ListOf(combinat::partitions) )
local alphabet,tmp, options, part, S, res, k, list, listTab, sup, i, length, poly;
begin
//recovering options
options := dom::parseOptions(args(2..args(0)));
// the shape of ribbons tableaux for product indexed with quotient
if options[4] <> 0 then alphabet:=[x.i$i=1..options[4]]; end_if;
part := combinat::ribbonsTableaux::fromCoreAndQuotient(options[1],quotient);
length := nops(quotient); print(length);
//list of admissible evaluation for ribbons tableaux
sup := (_plus(part[i] $i=1..nops(part))-_plus(options[1][i] $i=1..nops(options[1])) ) /length;
if options[1] <> []
then
list := combinat::partitions::list(sup, MaxPart=part[1]-options[1][1]);
else
list := combinat::partitions::list(sup, MaxPart=part[1]);
end_if;
S := examples::SymmetricFunctions();
res := 0;
if options[5]=TRUE then
if options[2]="spin" then
for k from 1 to nops(list) do
listTab := combinat::ribbonsTableaux::list(part, list[k],length);
poly := 0;
for i from 1 to nops(listTab) do
if
dom::isNewYamanouchiWord(
dom::yamanouchiReading(listTab[i])) = TRUE
then
poly := poly + hold(q)^(
combinat::ribbonsTableaux::spinTableau(listTab[i]));
end_if;
end_for;
res := res + poly*(S::s(list[k]));
end_for;
print(res);
elif options[2]="cospin" then
print("en construction");
end_if;
else
if options[2]="spin" then
for k from 1 to nops(list) do
//in order to know where is the algorithm
print(list[k]);
tmp := combinat::ribbonsTableaux::spinPolynom(part,list[k], length );
if tmp <> FAIL then res := res + tmp*(S::m(list[k])); end_if;
end_for;
elif options[2]="cospin" then
for k from 1 to nops(list) do
//in order to know where is the algorithm
//print(list[k]);
tmp := combinat::ribbonsTableaux::cospinPolynom(part,list[k], length );
if tmp <> FAIL then res := res + tmp*(S::m(list[k])); end_if;
end_for;
end_if;
//print(res);
//changing bases for result
if options[3]="s" then
if options[4] = 0 then
return(S::s(res));
else
expand(S::s(res)(alphabet));
end_if;
elif options[3]="m" then
if options[4] = 0 then
return(S::m(res));
else
expand(S::m(res)(alphabet));
end_if;
elif options[3]="e" then
if options[4] = 0 then
return(S::e(res));
else
expand(S::e(res)(alphabet));
end_if;
elif options[3]="h" then
if options[4] = 0 then
return(S::h(res));
else
expand(S::h(res)(alphabet));
end_if;
elif options[3]="p" then
if options[4] = 0 then
return(S::p(res));
else
expand(S::p(res)(alphabet));
end_if;
end_if;
end_if;
end_proc;
///////////////////////////////////////////////////////////////////////////////////////////////////////
// Some particular q analogue : H functions ( based on different q-analague of schur function product)
///////////////////////////////////////////////////////////////////////////////////////////////////////
// H function for a given partition and a given level
/////////////////////////////////////////////////////
hFunction :=
proc (part:combinat::partitions, level:Type::NonNegInt)
local cor, temp, quotient, options, i;
begin
print("partition",part,"niveau", level);
options := dom::parseOptions(args(3..args(0)));
temp := [level*part[i] $i=1..nops(part)];
quotient := combinat::ribbonsTableaux::rQuotient(temp, level);
dom::qSchurProductFromQuotient
(quotient, core = options[1], stat=options[2], base=options[3],
alph=options[4], yam=options[5] );
end_proc;
// Listing H function for a given partition and all level before stabilization
///////////////////////////////////////////////////////////////////////////////
hFunctionListFromPartition :=
proc (part:combinat::partitions)
local k, res, i, options;
begin
options := dom::parseOptions(args(2..args(0)));
res := null();
for k from 2 to nops(part) do
res := res,part,k,dom::hFunction
(part, k, core = options[1], stat=options[2], base=options[3],
alph=options[4], yam=options[5]);
end_for;
return(res);
end_proc;
// Listing H function for partition of a given length
//////////////////////////////////////////////////////
hFunctionListFromLength :=
proc (weigth : Type::NonNegInt)
local part, k, res, options;
begin
options := dom::parseOptions(args(2..args(0)));
res := null;
part := combinat::partitions::list(weigth);
for k from 1 to nops(part) do
if res=null then
res := dom::hFunctionListFromPartition(
part[k],core = options[1], stat=options[2],
base=options[3], alph=options[4], yam=options[5]);
else
res := res,dom::hFunctionListFromPartition(
part[k], core = options[1], stat=options[2],
base=options[3], alph=options[4], yam=options[5]);
end_if;
end_for;
return([res]);
end_proc;
////////////////////////////////////////////////////////////////////////////////////////////////////////
// Functions in order to search the head ribbons tableaux of schur function coefficients
////////////////////////////////////////////////////////////////////////////////////////////////////////
headSearchSpin:=
proc( part: combinat::partitions, length:Type::NonNegInt)
local h,hm,partemp,k;
begin
h:=dom::hFunctionSpin( part, length);
hm:=dom::hFunctionSpinM( part, length);
partemp:=[length*part[k] $k=1..nops(part)];
return(hm);
end_proc;
/////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
// Function which give the diagonal class of a given tableau
////////////////////////////////////////////////////////////
tableauDiagonalClass:=
proc (tableau: combinat::ribbonsTableaux)
local length, part, k, l, result, res;
begin
length := combinat::ribbonsTableaux::length(tableau);
part := revert([nops(tableau[i]) $ i=1..nops(tableau)]);
tableau := combinat::ribbonsTableaux::toFullRepresentation(tableau)[1];
result := null();
//search upper fundamental diagonals
for k from nops(part) downto 1 do
res := null();
if (k mod length = 0) then
l:=1;
while ( k-l+1 >= 1 and l <= nops(tableau[k-l+1]) ) do
res := res, tableau[k-l+1][l];
l := l+1;
end_while;
result:=result, [res];
end_if;
end_for;
//search downer fundamental diagonals
for k from 2 to part[1] do
res := null();
if (k mod length = 1) then
l := 1;
while ( l<= nops(part) and k+l-1 <= part[l] and k+l-1 <= nops(tableau[nops(part)-l+1])) do
res := res,tableau[nops(part)-l+1][k+l-1];
l := l+1;
end_while;
result := result,[res];
end_if;
end_for;
return([result]);
end_proc;
/////////////////////////////////////////////////////////////////////////////////////////////////
/// List of all diagonal classes for ribbons tableaux of given shape and evaluation
/////////////////////////////////////////////////////////////////////////////////////////////////
listDiagonalClass :=
proc( part: combinat::partitions, evaluation: combinat::compositions, length: Type::NonNegInt)
local liste,dg,z;
begin
z := operators::persistentRemember(combinat::ribbonsTableaux::list,"ribbonsTableaux_list");
liste := z(part, evaluation, length);
dg := map(liste, experimental::ribbonsTableaux::tableauDiagonalClass);
return(listlib::removeDuplicates(dg));
end_proc;
////////////////////////////////////////////////////////////////////////////////////////////////
/// given Diagonal classes listing
////////////////////////////////////////////////////////////////////////////////////////////////
diagonalClass:=
proc ( class, part:combinat::partitions, evaluation: combinat::compositions, length:Type::NonNegInt )
local liste,z;
begin
z:=operators::persistentRemember(combinat::ribbonsTableaux::list,"ribbonsTableaux_list");
liste:=z( part, evaluation, length);
select(liste, experimental::ribbonsTableaux::tableauDiagonalClass = class );
end_proc;
/////////////////////////////////////////////////////////////////////////////////////////////////
/// spin Polynom of a given diagonal class or listing of polynom for all classes
/////////////////////////////////////////////////////////////////////////////////////////////////
spinPolynomDiagonalClass:=
proc (class, part: combinat::partitions, evaluation:combinat::compositions, length: Type::NonNegInt)
local i,classe,spin,poly;
begin
poly:=0;
classe:= experimental::ribbonsTableaux::diagonalClass(class, part, evaluation, length);
spin:= map (classe, combinat::ribbonsTableaux::spinTableau);
return( factor(_plus( (hold(q))^(spin[i]) $i=1..nops(spin))));
end_proc;
allSpinPolynomDiagonalClass:=
proc (part: combinat::partitions, evaluation:combinat::compositions, length: Type::NonNegInt)
local listClass;
begin
listClass:=experimental::ribbonsTableaux::listDiagonalClass(part, evaluation, length);
map(listClass, a->experimental::ribbonsTableaux::spinPolynomDiagonalClass(a,part, evaluation, length));
end_proc;
///////////////////////////////////////////////////////////////////////////////////////////
// Computing inversion number in Stanton-White semi-standard tableaux
// the implanted version of inversion is that define by B.Leclerc
///////////////////////////////////////////////////////////////////////////////////////////
//It seems to be wrong: the right statistic is the Schilling-Shimozono one
cospinFromInversions :=
proc( tableau:Type::ListOf(DOM_LIST) )
local res,sw,i,j,k,l,a,m,inv;
begin
// Initialization, computing Stanton-White semi-standard tableaux
sw:= combinat::ribbonsTableaux::stantonWhite(tableau)[2];
res:=[ [[0 $k=1..nops(sw[i][j])] $j=1..nops(sw[i])] $i=1..nops(sw)];
for i from 1 to nops(sw) do
//scanning all the tableaux into Stanton-White list
for j from 1 to nops(sw[i]) do
for k from 1 to nops(sw[i][j]) do
//scanning each cell of the current tableau i
for a from 1 to nops(sw) do
if (a <> i) and j <= nops(sw[a]) and k <= nops(sw[a][j]) then
// i.e a cell of contains y and a cell of contains x can be compared if x < y
// and cell x is the biggest < y upon cell y in the diagonal of y
l := 0;
while j + l + 1 <= nops(sw[a]) and k + l + 1 <= nops(sw[a][j+l+1]) and sw[a][j+l+1][k+l+1] < sw[i][j][k]
do l := l + 1; end_while;
// we find a candidate into tableau number a: it is the cell (j+l,k+l) into tableau a
// we can do comparison between this two cells: two cases for testing a < i and i < a
if a < i and sw[a][j+l][k+l] < sw[i][j][k] then
if k+l+1 <= nops(sw[a][j+l]) and sw[a][j+l][k+l+1] < sw[i][j][k]
then
res[i][j][k] := res[i][j][k] + 1;
end_if;
elif a > i and sw[a][j+l][k+l] < sw[i][j][k] then
if (j+l+1 <= nops(sw[a]) and nops(sw[a][j+l+1]) >= k+l and sw[a][j+l+1][k+l] > sw[i][j][k])
or (j+l+1 > nops(sw[a])) or ( j+l+1 <= nops(sw[a]) and nops(sw[a][j+l+1])< k+l )
then
res[i][j][k] := res[i][j][k] + 1;
end_if;
end_if;
end_if;
end_for;
end_for;
end_for;
end_for;
//Computing the number of inversion
inv := 0;
for i from 1 to nops(res) do
for j from 1 to nops(res[i]) do
for k from 1 to nops(res[i][j]) do
inv := inv + res[i][j][k];
end_for;
end_for;
end_for;
return(res,inv);
end_proc;
////////////////////////////////////////////////////////////////////////////////////////////////////////////
/// Very experimental part
////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Some experimental function in order to study diagonal classes for a given shape and a given evaluation
/////////////////////////////////////////////////////////////////////////////////////////////////////////
studyDiagonalClasses :=
proc( part:combinat::partitions, evaluation:combinat::compositions, length:Type::NonNegInt )
local ndg, k, dg, z, liste, class, classi, sclass, poly, sw;
begin
//Listage des tableaux de la forme et de l'évaluation donnée
z := operators::persistentRemember(combinat::ribbonsTableaux::list,"ribbonsTableaux_list");
liste := z(part, evaluation, length);
// les écrire dans un fichier avec leur print pretty en plus
print(Unquoted, "Nbre de ".expr2text(length)."-tableaux de forme ".expr2text(part)." d'eval ".expr2text(evaluation)." --> ".expr2text(nops(liste)));
//Nombre des classes diagonales
dg := listlib::removeDuplicates( map(liste, experimental::ribbonsTableaux::tableauDiagonalClass) );
print(Unquoted,"".expr2text(nops(dg))." classes diagonales");
//Etude des classes diagonales une par une
for k from 1 to nops(dg) do
//listage de la classe
class := select(liste, experimental::ribbonsTableaux::tableauDiagonalClass = dg[k] );
ndg := nops(class);
//Stanton-White sur chacun des elements de la classe
sw := map(class, a->combinat::ribbonsTableaux::stantonWhite(a)[2]);
//selection des blocs de 1
temp := null();
sclass := null();
spinsclass := null();
for i from 1 to nops(sw) do
if has([temp], i) = FALSE then classi := class[i];
// pour tous les tableaux de 1 à blabla
for j from i to nops(sw) do
// pour tous les tableaux de i+1 à blabla
if j > i and has([temp],j) = FALSE then
//classi := sw[i];
boolean := TRUE;
// Si ces tableaux ne sont pas deja dans un classe
// selection de sa sous-classe de 1
for a from nops(sw[i]) downto 1 do
for b from 1 to nops(sw[i][a]) do // balayage des colonnes de stanton-White
if select(sw[i][a][b], has, 1) = select(sw[j][a][b], has, 1) then
boolean := boolean and TRUE ;
else boolean := boolean and FALSE;
end_if;
end_for;
end_for;
if boolean = TRUE then
classi := classi, class[j];
temp := temp,j;
end_if;
// rajout des éléments de sa sous-classe dans la liste des indices interdits
end_if;
end_for;
//IL FAUT MAINTENANT CALCULER LE POLYNOME DE SPIN SUR CHACUNE DES SOUS-CLASSES
//FAIRE APPARAITRE STANTON-WHITE A BLOC DE 1 FIXE POUR FAIRE LA BIJECTION
sclass := sclass, [classi];
tmp1 := map( [classi], combinat::ribbonsTableaux::spinTableau);
spinsclass := spinsclass, factor(_plus( (hold(q))^(tmp1[i]) $i=1..nops(tmp1)));
end_if;
end_for;
sclass := [sclass];
spinsclass := [spinsclass];
//Calcul du spin de chacun des tableaux et donc polynome de spin
spin := map (class, combinat::ribbonsTableaux::spinTableau);
poly := factor(_plus( (hold(q))^(spin[i]) $i=1..nops(spin)));
//Affichage de l'etude
print(Unquoted, "Classe diago No ".expr2text(k)." avec ".expr2text(ndg)." elements et de poly ".expr2text(poly)."\n" );
print(Unquoted,NoNL, "Cardinal a bloc de 1 fixe ".expr2text(map(sclass, nops))." poly de spin "."\n");
print(Unquoted,NoNL, "".expr2text(spinsclass)."\n" );
for t from 1 to nops(sclass) do
print(Unquoted,"Stanton-White du sous-bloc de 1 No ".expr2text(t)."\n");
tp := sort ( [sclass[t][u] $u=1..nops(sclass[t])],
(x,y)-> combinat::ribbonsTableaux::spinTableau(x) > combinat::ribbonsTableaux::spinTableau(y));
//print((map(
// map( combinat::ribbonsTableaux::stantonWhite(sclass[t][u])[2], revert),
// combinat::tableaux::printCompact),
// combinat::ribbonsTableaux::spinTableau(sclass[t][u])) $u=1..nops(sclass[t]));
print((combinat::ribbonsTableaux::stantonWhite(tp[u])[2],
combinat::ribbonsTableaux::spinTableau(tp[u])) $u=1..nops(sclass[t]));
//print( combinat::ribbonsTableaux::printPretty(tp[1]));
end_for;
end_for;
end_proc;
/////////////////////////////////////////////////////////////////////////////////////
/// Extended Yamanouchi words as defined by Lam-Stanley
////////////////////////////////////////////////////////////////////////////////////
// Weight fonction of a word
weightYam := proc(w: combinat::words, l: Type::NonNegInt)
begin
return(nops(select(w, has, l)));
end_proc;
isNewYamanouchiWord := proc( w: combinat::words)
local i,l,wtemp;
begin
w := revert(w);
for i from 1 to nops(w) do
wtemp := [w[j]$j=1..i];
for l from 1 to nops(w) do
if dom::weightYam(wtemp,l)<
dom::weightYam(wtemp,l+1)
then return(FALSE);
end_if;
end_for;
end_for;
return(TRUE);
end_proc;
yamanouchiReading := proc( tab: Type::Union(Type::ListOf(DOM_LIST),combinat::ribbonsTableaux ))
local sw,i,j,k,diag,diagtemp,part;
begin
diag:=null();
sw := combinat::ribbonsTableaux::stantonWhite(tab)[2];
// for each tableau Stanton-White image
for k from nops(sw) downto 1 do
//for each diagonal in decreasing order we extract the diagonal
for i from nops(sw[k]) downto 1 do
diagtemp:=null();
for j from 1 to nops(sw[k][1]) do
if nops(sw[k]) >= i+j-1 and nops(sw[k][i+j-1]) >= i+j-1 then
diagtemp := diagtemp, sw[k][i+j-1][j];
end_if;
end_for;
diag := diag, op(revert(sort([diagtemp])));
end_for;
for i from 2 to nops(sw[k][1]) do
diagtemp:=null();
for j from 1 to nops(sw[k]) do
if nops(sw[k][j]) >= i+j-1 then
diagtemp := diagtemp, sw[k][j][i+j-1];
end_if;
end_for;
diag := diag, op(revert(sort([diagtemp])))
end_for;
end_for;
return([diag]);
end_proc;
//lecture de Yamanouchi de haut en bas et de gauche a droite ( mais en
//fait en ligne de haut en bas
otherReading :=
proc (tab: combinat::ribbonsTableaux)
local i,j,res;
begin
res := null();
for i from 1 to nops(tab) do
for j from 1 to nops(tab[i]) do
if tab[i][j] <> 0 then
res := res, tab[i][j];
end_if;
end_for;
end_for;
[res];
end_proc;
otherReading2 :=
proc (tab: combinat::ribbonsTableaux)
local i,j,res;
begin
res := null();
for i from 1 to nops(tab[nops(tab)]) do
for j from 1 to nops(tab) do
if ( i <= nops(tab[j])) then
if tab[j][i] <> 0 then
res := res, tab[j][i];
end_if;
end_if;
end_for;
end_for;
[res];
end_proc;
//Implantation of the bijection between the rigged configurations and
//the ribbons tableaux
//only for shape with k-quotient as k-uplet of young tableaux of line shape
//rigged configurations will be implanted as below: a list of tableaux filled only on their frontier
//and the last one is just a partition.
riggedConfiguration :=
proc(tableau: Type::Union(Type::ListOf(DOM_LIST), combinat::ribbonsTableaux), out = 0)
local a,i,j,k,sw,shape,J,Js,eval;
begin
eval := combinat::ribbonsTableaux::evaluation(tableau);
sw := combinat::ribbonsTableaux::stantonWhite(tableau)[2];
shape := [[]$nops(eval)];
J := [[]$nops(eval)-1];
//balayage dans l'ordre décroissant des tableaux de Stanton-White
for i from nops(sw) downto 1 do
for j from 1 to nops(op(op(sw)[i])) do
for a from op(sw[i])[j] to nops(eval) do
if nops(shape[a]) >= j then
if a <> nops(eval) then J[a][j] := [op(J[a][j]),0]; end_if;
shape[a][j] := shape[a][j] + 1;
else
shape[a] := [op(shape[a]),1];
if a<> nops(eval) then J[a] := [op(J[a]),[0]]; end_if;
end_if;
end_for;
Js := null();
for a from 1 to nops(eval)-1 do
Js := Js, map(zip(shape[a],shape[a+1],_subtract),x->-x);
end_for;
for a from op(sw[i])[j] to nops(eval)-1 do
//new singular box at the current line
J[a][j][nops(J[a][j])] := Js[a][j];
J[a][j] := sort(J[a][j]);
//remove singular box at the line under the current line
//if it is not the first one
if j <> 1 and J[a][j-1][nops(J[a][j])] <> Js[a][j-1] then
J[a][j-1][nops(J[a][j-1])] :=
J[a][j-1][nops(J[a][j-1])]-1;
end_if;
end_for;
//print("shape apres une case");
//print(shape,J);
end_for;
end_for;
J := map(J,revert);
// reprinting tableaux of J with only numbers on their frontier
for i from 1 to nops(eval)-1 do
J[i] := combinat::tableaux::conjugate(J[i]);
for k from 1 to nops(J[i]) do
for j from 1 to nops(J[i][k])-1 do
J[i][k][j] := "";
end_for;
end_for;
J[i] := combinat::tableaux::conjugate(J[i]);
end_for;
if out = 1 then
return( [op(J),shape[nops(shape)]], shape);
end_if;
[map(op(J),combinat::tableaux::printPretty),
combinat::partitions::printPretty(shape[nops(shape)])];
end_proc;
//Function which test a conjecture for a bijection between diagonal classes and subset of RC of
//rigged configurations which have the same multipartition shapes
conj1 :=
proc ( shape: combinat::partitions, eval: combinat::compositions, length: Type::NonNegInt)
local tmp, i, j, d, card, rc, sh, shwd;
begin
d := dom::listDiagonalClass(shape, eval, length);
// list of the number of elements of each diagonal class
card := [nops(dom::diagonalClass(d[i],shape,eval,length))$i=1..nops(d)];
print("card",card);
// computation of the number of elements for each subset corresponding
// to the same shape of the multipartition
// list of all the shape of all the rigged configuration
sh := map (combinat::ribbonsTableaux::list(shape, eval, length),
x-> experimental::ribbonsTableaux::riggedConfiguration(x,1)[2]);
print("sh",sh);
// list of all the shape without duplicates
shwd := listlib::removeDuplicates(sh);
print("shwd",shwd);
// list of the number of rc with each shape
tmp := map(select(sh, x->x=shwd[i]) $i=1..nops(shwd),nops);
print("tmp",tmp);
//first test: number of diagonal classes and shape of rigged configurations
//second test: comparison of the cardinal of each diagonal classes and each subset
//of RC of each shape
if nops(shwd)=nops(d) and sort(card) = sort([tmp]) then return(TRUE); else return(FALSE); end_if;
end_proc;
/////////////////////////////////////////////////////////////////////////////////////////
// Hall Polynomial computation
//////////////////////////////////////////////////////////////////////////////////////////
qEntier :=
proc(n ,q)
local i;
begin
simplify((1-q^n)/(1-q));
end_proc;
qProduit :=
proc(n,q)
begin
if n > 1 then
product((1-q^i), i=1..n);
else
return(1);
end_if;
end_proc;
qBinomial :=
proc(n, r, q)
begin
if (r >= 0 and r <= n) then
simplify( dom::qProduit(n,q) / dom::qProduit(r,q) / dom::qProduit(n-r,q) );
else
return(0);
end_if;
end_proc;
phi :=
proc(a, b, c, N, q)
local r;
begin
_plus( (-1)^r * q^(N*r+r*(r+1)/2)*dom::qBinomial(a,r,q)*dom::qBinomial(c-r,b-r,q) $ r=0..min(a,b));
end_proc;
nFunction :=
proc( part: combinat::partitions)
begin
_plus( (i-1)*part[i] $i=1..nops(part));
end_proc;
//Constituant elementaire des polynomes de hall
hallPolynomialS :=
proc (skt: Type::Union(combinat::skewTableaux, Type::TypeSkewTableau), q)
local r,l,res,a, b, c, N, i, j, chain, tmp;
begin
print(skt, combinat::skewTableaux::eval(skt));
chain := combinat::skewTableaux::toChain(skt);
//Normalisation de la chaine de partition en mettant des 0 pour completer les longueur
r := nops(chain) - 1;
l := nops(chain[r+1]);
tmp := array(0..r+1);
for i from 0 to r do
tmp[i] := [op(chain[i+1]),0 $ l-nops(chain[i+1])+1];
end_for;
tmp[r+1] := tmp[r];
a := array(0..l, 0..r);
b := matrix(l,r);
c := matrix(l,r);
N := matrix(l,r);
for j from 0 to r do
a[0,j]:=(tmp[j+1])[1] - (tmp[j])[2];
end_for;
for i from 1 to l do
a[i,0] := (tmp[1])[i+1] - (tmp[0])[i+1];
for j from 1 to min(i,r) do
a[i,j] := (tmp[j+1])[i+1] - (tmp[j])[i+1];
b[i,j] := (tmp[j-1])[i] - (tmp[j])[i+1];
c[i,j] := (tmp[j])[i] - (tmp[j])[i+1];
end_for;
end_for;
res := 1;
for i from 1 to l do
for j from 1 to min(i,r) do
//N[i,j] := _plus( a[h-1,j-1] - a[h,j] $ h=j..i);
N[i,j] := _plus( a[h-1,j-1] - a[h,j] $ h=j..i);
//res := res * dom::phi(a[i,j],b[i,j],c[i,j],N[i,j],1/q);
res := res * dom::phi(a[i,j],b[i,j],c[i,j],N[i,j],q);
end_for;
end_for;
print("le bon coeff de structures",res);
res := subs(res, q=1/q);
res := simplify(res);
//print("le coeff", q^(dom::nFunction(combinat::partitions::conjugate(tmp[r])) -
// dom::nFunction(combinat::partitions::conjugate(tmp[0])) -
// dom::nFunction(combinat::partitions::conjugate(combinat::skewTableaux::eval(skt)))));
return( factor( q^( dom::nFunction(combinat::partitions::conjugate(tmp[r]))
- dom::nFunction(combinat::partitions::conjugate(tmp[0]))
- dom::nFunction(combinat::partitions::conjugate(combinat::skewTableaux::eval(skt))))*res));
end_proc;
hallPolynomial :=
proc(mu :combinat::partitions, nu:combinat::partitions, lambda:combinat::partitions, q)
local res, k, temp, liste;
begin
res := 0;
mu := combinat::partitions::conjugate(mu);
nu := combinat::partitions::conjugate(nu);
lambda := combinat::partitions::conjugate(lambda);
liste := combinat::skewTableaux::listSemiStandard([lambda, mu],nu);
print(nops(liste));
for k from 1 to nops(liste) do
if experimental::ribbonsTableaux::isNewYamanouchiWord(
combinat::skewTableaux::toWord(liste[k])) = TRUE
then
print("calcul d'un element de la somme" );
temp := dom::hallPolynomialS(liste[k],q);
res := res + temp ;
end_if;
end_for;
if res <> 0 then print([mu, nu, lambda],"--->",res); end_if;
return(res);
end_proc;
isLexicoSup :=
proc(part: combinat::partitions, partfixe: combinat::partitions)
local tmp;
begin
tmp := zip(part, partfixe, _subtract);
if select(tmp, testtype, Type::NegInt) = [] then return(TRUE); else return(FALSE); end_if;
end_proc;
isLexicoInf :=
proc(part: combinat::partitions, partfixe: combinat::partitions)
begin
dom::isLexicoSup(partfixe, part);
end_proc;
multiHallPolynomial :=
proc( Lambda: Type::ListOf(combinat::partitions),lambda,q) option remember;
local h, la, lb, rho, liste;
begin
//print("dans multihall",Lambda,lambda);
if nops(Lambda)=2 then return(dom::hallPolynomial(Lambda[1],Lambda[2],lambda,q));
else
la := _plus(Lambda[1][i] $i=1..nops(Lambda[1]));
lb := _plus(lambda[i] $i=1..nops(lambda));
liste := [op(combinat::partitions::list(h)) $ h=la..lb];
if (liste <> []) then
return(_plus(dom::multiHallPolynomial([Lambda[i]$i=1..nops(Lambda)-1],rho,q)*dom::hallPolynomial(rho, Lambda[nops(Lambda)], lambda,q) $rho in liste));
end_if;
end_if;
end_proc;
// Calcul des fonctions W de l'exo 221 du MacDonald
wFunction :=
proc(mu : combinat::partitions, lambda: combinat::partitions,q)
local res, indices,liste,i,r;
begin
res := 0;
r := nops(mu);
liste := array(1..r);
for i from 1 to r do
liste[i] := combinat::partitions::list(mu[i]);
end_for;
indices := combinat::cartesianProduct(liste[i] $i=1..nops(liste));
print(nops(indices));
for i from 1 to nops(indices) do
res := res + dom::multiHallPolynomial(indices[i],lambda,q);
print("res à l'etape",i,res);
end_for;
return(res)
end_proc;
//////////////////////////////////////////////////////////////////////////////
// in order to find reading for fixed point into change of bases m to s
// into G functions
//////////////////////////////////////////////////////////////////////////////
conj2 :=
proc( part : combinat::partitions, length : Type::NonNegInt)
local cs, cm, csd, cmd, d, k, i, j, eval, liste, hm, hs;
begin
eval := combinat::partitions::list(_plus(part[i] $i=1..nops(part)));
print("eval",eval);
hm := dom::hFunction(part, length, base="m");
hs := dom::hFunction(part, length, base="s");
print("h sur monome",hm);
print("h dur schur", hs);
for k from 1 to nops(eval) do
liste := combinat::ribbonsTableaux::list([length*part[j] $j=1..nops(part)],eval[k],length);
cm := coeff(hm,eval[k]);
cs := coeff(hs,eval[k]);
cmd := degree(cm);
csd := degree(cs);
d := max(cmd,csd);
print("degree",d);
for i from 0 to d do
if coeff(cm,i) = coeff(cs,i) and coeff(cm,i) <> 0 then
print("sous-coeff ",i);
print(select(liste, x->combinat::ribbonsTableaux::spinTableau(x)=i));
end_if;
end_for;
end_for;
end_proc;
end_domain;
/////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
|