# Luminy.mpl # Functions to add to ACE for the course, July 04 lprint(` Matrices de la representation naturelle a partir de la mat de\ Rutherford`); lprint(`MatRutherford(pa), Perm2MatScal(pa,perm), Perm2RepNatural(pa,perm) `); lprint(`CoInvScalProd(pol,)`); ####################### SYMMETRIC FUNCTIONS ######################## # incr=increasing partition, lA=list of alphabets MultiSchur:=proc(incr,lA) local n,i,j,ma; n:=nops(incr); transpose(array([seq( map(proc(x,i,ll) if (x>0) then s[x](op(i,ll)) elif (x=0) then 1 else 0 fi end,[seq(incr[i]-j+i,j=1..n)],i,lA),i=1..n)] )); end: # ############# 0,1 MATRICES with row and column sums fixed ############# `GenMat1/rec`:=proc(rows, cols) local i, lr,nr,nc; option remember; nr := nops(rows); nc := nops(cols); if (nr=1) then if max(op(cols))<= 1 then [[cols]] else [] fi; else if (op(1, rows)=0) then lr := [[seq(0, i=1..nc)]] else lr := `COMP/ListCompo`(op(1, rows), 'allowzeros', 'maxouter'=[1$nc], 'lg'=nc, 'dontforget') fi; map(proc(compo, rows, cols, nc) local i; op(map(proc(mat, row) [row, op(mat)] end, `GenMat1/rec`(rows, [seq(cols[i]-compo[i], i=1..nc)]), compo)) end, lr, [op(2..nr, rows)], cols, nc) fi end: GenMat1:=proc(rows, cols) # AL 16 Mai 02 if (not TYP['IsCompo'](subs(0=NULL, rows)) or not TYP['IsCompo'](subs(0=NULL, cols))) then ERROR(`Compositions with possible zeros expected...`); elif (convert(rows, `+`)<>convert(cols, `+`)) then [] elif (nops(rows)=0 and nops(cols)=0) then [linalg['matrix'](0,0)] elif (nops(rows)=0 or nops(cols)=0) then [] else # both rows and cols not empty... map(proc(mat) linalg['matrix'](mat) end, `GenMat1/rec`(rows, cols)) fi end: ############### GROUP ALGEBRA OF THE SYMMETRIC GROUP ################ Sga2Inv:=proc(f); if member(whattype(f),{`+`,`*`,`^`}) then map(Sga2Inv,f) elif (whattype(f)=`indexed` and op(0,f)=A) then RETURN(A[op(Perm2Inv([op(f)]))]) else f fi; end: # composition -> perm maximum du sous groupe de Young Compo2Omega := proc(pa) local i,j,dec,res; res:=NULL;dec:=1; for i from 1 to nops(pa) do res:=res, seq(dec+pa[i]-j,j=1..pa[i]); dec:=dec+pa[i]; od; [res]; end: Compo2Young:=proc(v) local u; # option N=negative group ; Positive group by default if nargs=2 and args[2]=N then convert([seq( (-1)^(convert(u,`+`))*A[op(Code2Perm(u))], u=Perm2Interval(Compo2Omega(v)))],`+`) else convert([seq(A[op(Code2Perm(u))],u=Perm2Interval(Compo2Omega(v)))],`+`) fi; end: ########## # permutation which intertwines between 2 conjugate compositions # 2 compo conjuguees I,J->\zeta(I,J) telle que \carre_I \zeta \nabla_J \neq 0 DeuxCompo2Perm:=proc(v1,v2) local i,j,k,ma; ma:=op(GenMat1(v1,v2)); k:=1; for i from 1 to rowdim(ma) do for j from 1 to coldim(ma) do if ma[i,j]<>0 then ma[i,j]:=k; k:=k+1; fi; od; od; subs(0=NULL,map(op,convert(transpose(ma),listlist))) end: #Compo2Omega:=proc(v) local i,j; # Code2Perm([seq(seq(v[i]-j,j=1..v[i]),i=1..nops(v))]) # end: List2Sga:=proc(lsga) local i,res; # by default SGA options if nops(lsga)=0 then RETURN(1) elif nops(lsga)=1 then RETURN(op(lsga)) fi; res:=lsga[1]; if nargs=2 and args[2]='nil' then for i from 2 to nops(lsga) do res:=NcaMult(res,lsga[i]) od; elif nargs=2 and args[2]='idca' then for i from 2 to nops(lsga) do res:=IdcaMult(res,lsga[i]) od; elif nargs=2 and args[2]='heka' then for i from 2 to nops(lsga) do res:=HekaMult(res,lsga[i]) od; else for i from 2 to nops(lsga) do res:=SgaMult(res,lsga[i]) od; fi; res end: ####################### YANG ELEMENTS in the GROUP ALGEBRA ############ # YangList(perm); YangList(r[..]); YangList(perm,v); YangList(r[..],v); # v=[x1,x2,...] par defaut YangList:=proc(u) local rd,n,p,q,i,j,v; if whattype(u)=list then n:=nops(u); rd:=`SG/Perm2Rd`(u); else n:=max(op(u))+1; # cas d'une decomposition reduite rd:=[op(u)] fi; if nargs=1 then v:=[seq(cat(x,i),i=1..n)] else v:= args[2] fi; q:=NULL; p:=[$1..n]; for i from 1 to nops(rd) do q:=q,v[p[rd[i]+1]]-v[p[rd[i]]]; p:=subsop(rd[i]=p[rd[i]+1],rd[i]+1=p[rd[i]],p) od; if (q=NULL) then RETURN([A[$1..n]]) fi; q:=[q]; # ajoute A[$1..n] pour normaliser terme constant [A[$1..n],seq( A[seq(j,j=1..rd[i]-1),rd[i]+1,rd[i],seq(j,j=rd[i]+2..n)] +1/op(i,q),i=1..nops(rd))] end: MatYang2Perm:=proc(n) local i,j,lp,v,res,sga; if nargs=2 then v:=args[2] else v:=[seq(cat(x,i),i=1..n)] fi; lp:=map(op,ListPerm(n,level)); res:=NULL; for j from 1 to nops(lp) do sga:=List2Sga(YangList(lp[j],v)); res:=res,[seq(coeff(sga,A[op(i)]),i=lp)] od; matrix([res]) end: ###################### YANG-BAXTER GRAPH ############################# # # [3,2,2] -> monome x^000 33 55 ou vecteur [000 33 55] PremierMonome:=proc(pa) local i,j,k,res; res:=NULL; k:=0; for i from 1 to nops(pa) do res:= res, k$pa[i]; k:=k+pa[i] od; res:=[res]; if nargs=2 and args[2]=vecteur then res else convert([seq(cat(x,i)^res[i],i=1..nops(res))],`*`) fi; end: ### Le premier tableau donne le vecteur [123..] Tab2Vec := proc(tab) local i,n; n:=nops(tab); [seq( op(tab[n+1-i]),i=1..n)] end: # Base de Yang-Baxter et base adjointe # pa=[322] -> [ [vecteurs de contents], [chemins de Yang-Baxter], # [images du monome x^000 33 5 ],[images du monome x^012 01 0] # option=domin ->termes dominants des pol # option=vecteur -> exposants de ces monomes # GrapheYB:=proc(pa) local i,j,k,lv, lrd,lc,u, lyang,yy,yy2,lpol,lpol3; lc:=[[ seq(seq(j-i,j=1..pa[i]),i=1..nops(pa))]]; lyang:=[[]]; lpol:= [PremierMonome(args)]; u:=[seq( (i-1)$pa[i],i=1..nops(pa))]; lpol3:=[convert([seq(cat(x,i)^u[i],i=1..nops(u))],`*`)]; lrd:= sort( map(z->Perm2Rd(Tab2Vec(z)), Part2ListStdTab(pa)), proc(a,b) evalb(nops(a)lg(b) -> a>b triPerm:=proc(objet) sort(objet, proc(a,b) evalb(Perm2Length(a)>Perm2Length(b)) end) end: ##### u=lecture ligne -> omega u^(-1) omega Tab2Perm := proc(tab) local i,k,n,u; k:=nops(tab); u:= [seq( op(tab[k+1-i]),i=1..k)]; n:=nops(u); Perm2Inv( [seq(n+1-u[n+1-i],i=1..n)]); end: ### # part -> base de la representation comme intervalle initial du Permutoedre # Part2ListPerm:= proc(pa) triPerm(map(Tab2Perm, Part2ListStdTab(pa))) end: # ##### Matrice triangulaire des produits scalaires des deux bases # de monomes (notees ly, ly2) MatRutherford:= proc(pa) local n,pa2,lp,ly,ly2,u,i,j,h,k,ma,perm; option remember; n:=convert(pa,`+`); lp:=Part2ListPerm(Part2Conjugate(pa)); pa2:=Part2Conjugate(pa); u:=NULL; for i from 1 to nops(pa2) do u:= i$(pa2[i]), u od; u:=[u]; ly2:= map(proc(mu,u) local i;[seq(op(mu[i],u),i=1..nops(mu))] end, lp,u); u:=0;j:=0; for i from nops(pa) by -1 to 2 do j:=j+pa[i]; u:=j,u; od; u:=[u]; u:=[seq(u[nops(pa)-i]$(pa[nops(pa)-i]),i=0..nops(pa)-1)]; perm:=Perm2Inv(op(1,lp)); u:=[seq(op(perm[i],u),i=1..n)]; ly:= map( proc(mu,u) local i; [seq(op(mu[i],u),i=1..nops(mu))] end, lp,u); k:=nops(ly); lprint(ly2); lprint(ly); ma:=linalg[matrix](k,k); for i from 1 to k do for j from 1 to k do perm:= [seq(op(h,op(i,ly))+op(h,op(j,ly2)),h=1..n)]; if IsPerm(perm) then ma[i,j]:= (-1)^(Perm2Length(perm)); else ma[i,j]:=0; fi; od; od; eval(ma); end: # RuthInv:=proc(pa) option remember; inverse(MatRutherford(pa)) end: # ### Matrice des produits scalaires pour l'image de la base par une permutation Perm2MatScal:= proc(pa,nu) local n,pa2,lp,ly,ly2,u,v,i,j,h,k,ma,perm; n:=convert(pa,`+`); lp:=Part2ListPerm(Part2Conjugate(pa)); pa2:=Part2Conjugate(pa); u:=NULL; for i from 1 to nops(pa2) do u:= i$(pa2[i]), u od; u:=[u]; ly2:= map( proc(mu,u) local i; [seq(op(mu[i],u),i=1..nops(mu))] end, lp,u); u:=0;j:=0; for i from nops(pa) by -1 to 2 do j:=j+pa[i]; u:=j,u; od; u:=[u]; u:=[seq(u[nops(pa)-i]$(pa[nops(pa)-i]),i=0..nops(pa)-1)]; perm:=Perm2Inv(op(1,lp)); u:=[seq(op(perm[i],u),i=1..n)]; ly:= map( proc(mu,u) local i; [seq(op(mu[i],u),i=1..nops(mu))] end, lp,u); ly:=[seq(PermOnVec(nu,v),v=ly) ]; k:=nops(ly); ma:=linalg[matrix](k,k); for i from 1 to k do for j from 1 to k do perm:= [seq(op(h,op(i,ly))+op(h,op(j,ly2)),h=1..n)]; if IsPerm(perm) then ma[i,j]:= (-1)^(Perm2Length(perm)); else ma[i,j]:=0; fi; od; od; eval(ma); end: # # produit a droite # leproduit s1 s2 s3 s4 donne bien Perm2Ruth( [2,3,4,5,1]) Perm2RepNatural:=proc(pa,perm) multiply( RuthInv(pa), Perm2MatScal(pa,perm)) end: # ### Liste des matrices representant les transpositions simples GeneratorsRepNatural:=proc(pa) local i,n; n:=convert(pa,`+`); [seq(Perm2RuthRep(pa,[$1..i-1,i+1,i,$i+2..n]),i=1..n-1)] end: ################## COINVARIANT RING ############################## # graded multiplicities of the coinvariant ring CharacterCoInv:=proc(n) local tab; convert([seq( q^Word2CoCharge(Tab2Word(tab))*s[op(Tab2Part(tab))], tab=ListStdTab(n))], `+`) end: # # Scalar Product of $f,g$ Enter expand(f*g) # The order $n$ is global (given by CLG_n(n)), or the second argument CoInvScalProd:=proc(pol) local i,n,perm; global _Sn; # degree of the symmetric group... if (type(pol,`+`)) then RETURN(map(CoInvScalarProd,pol,args[2..nargs])) fi; # pol is a monomial... if (nargs=1) then n:=_Sn else n:=args[2] fi; perm:=[seq(1+degree(pol,cat(x,n-i+1)),i=1..n)]; if IsPerm(perm) then RETURN(subs(seq(cat(x,i)=1,i=1..n),pol)*Perm2Sign(perm)) else RETURN(0) fi; end: # Liste de polynomes de dg donne ->matrice dans la base Schubert MatFamily2X:=proc(lpol,n,dg) local pol,v,lX,u,res; res:=NULL; Flag(n); lX:=[seq(X[op(u)],u= op(dg+1,ListPerm(n,level)))]; for pol in lpol do v:=ToX(pol); res:=res,[seq(coeff(v,u),u=lX)] od; matrix([res]) end: # space of all monomials whose exponent is a permutation of v WeightSpace:=proc(v) local i,u,lpol; lpol:=[seq( convert([seq(cat(x,i)^u[i],i=1..nops(u))],`*`),u=ListPerm(v))]; MatFamily2X(lpol,nops(v),convert(v,`+`)) end: JucysOnPol:=proc(n,pol) local i,polX; Flag(n); polX:=ToX(pol); [seq( simplify(ToX(SgaOnPol(SgaJucis(i),pol))/ polX), i=2..n)] end: ############### RECURSION ON SCHUBERT POLYNOMIALS ##################### lprint(` RecY(cod); RecY(cod, see) `); # option pol= X[],Y[],x # otherwise the input is a polynomial in x # sequence of $pi_i$ or multiplication by x_1..x_k PiRdOnPol:=proc(pol,rd) local res,i,k; if nargs>2 then res:=Tox(pol) else res:=pol fi; for i from 1 to nops(rd) do k:=op(i,rd); if k>0 then res:=normal((-cat(x,k)*res +cat(x,k+1)* subs({cat(x,k)=cat(x,k+1),cat(x,k+1)=cat(x,k)},res) )/(x.(k+1)-x.k) ); else res:=res* convert([seq(cat(x,j),j=1..-k)],`*`) fi; od; res end: # One can view the steps: RecY([2,0,2], see) RecY:=proc(cod) local i,j,out; if cod=[0$nops(cod)] then RETURN(1) fi; if member(0,cod,'j')=true then if nargs>1 then lprint(`PiRdOnPol`, Y[seq(cod[i]-1,i=1..j-1),seq(cod[i],i=j+1..nops(cod))], [seq(nops(cod)-i,i=1..nops(cod)-j),-j+1]); fi; PiRdOnPol( RecY([seq(cod[i]-1,i=1..j-1), seq(cod[i],i=j+1..nops(cod))], args[2]..nargs), [seq(nops(cod)-i,i=1..nops(cod)-j),-j+1]) else if nargs>1 then lprint(Y[seq(cod[i]-1,i=1..nops(cod))]* convert([seq(cat(x,i),i=1..nops(cod))],`*`)); fi; RecY([seq(cod[i]-1,i=1..nops(cod))], args[2]..nargs)* convert([seq(cat(x,i),i=1..nops(cod))],`*`) fi; end: