#
# COPYLEFT NOTICE:
# Copyleft (c) 1991 by John R. Stembridge.
#  
# Permission is granted to anyone to to use, modify, or redistribute this
# software freely, subject to the following restrictions:
# 
# 1. The author accepts no responsibility for any consequences of this
# software and makes no guarantee that the software is free of defects.
# 2. The origin of this software must not be misrepresented, either by
# explicit claim or by omission.
# 3. This notice and the copyleft must be included in all copies or
# modified versions of this software.
# 4. This software may not be included or redistributed as part of any
# package to be sold for profit unless the author has given explicit written
# permission to do so.
# 
# John Stembridge
# Department of Mathematics
# University of Michigan
# Ann Arbor, MI 48109-1003
# Internet:  jrs@math.lsa.umich.edu
#
###############################################################################
#
# rho(R) computes half the sum of the positive roots of R without
#  actually computing the positive roots themselves.
# rho(S) does the same, using S as the list of base vectors.
#
`weyl/rho`:=proc() local rho,S,i,c;
  if type(args[1],'list') then S:=args[1] else S:=coxeter['base'](args[1]) fi;
  rho:=[seq(c[i]*S[i],i=1..nops(S))];
  rho:=collect(convert(rho,`+`),indets(S));
  {seq(2*coxeter['iprod'](i,rho)=coxeter['iprod'](i,i),i=S)};
  subs(solve("),rho);
end:
#
#
`weyl/store`:=proc(R) local S,n,len,r,j,roots;
  S:=coxeter['base'](R); n:=nops(S);
  len:=[seq(coxeter['iprod'](r,r),r=S)];
  roots:=coxeter['pos_roots'](R);
  `weyl/weights/`.R:=
    [seq([seq(2*coxeter['iprod'](r,S[j])/len[j],j=1..n)],r=roots)];
  coxeter['pos_roots'](R):=roots;
  NULL;
end:
#
#
# weight_coords(v,R) returns the coordinates of v with respect to the
#  fundamental weights. 
# weight_coords(v,S), where S is the base of R, does the same.
#
`weyl/weight_coords`:=proc(v) local S,s;
  if type(args[2],'list') then S:=args[2] else S:=coxeter['base'](args[2]) fi;
  [seq(2*coxeter['iprod'](v,s)/coxeter['iprod'](s,s),s=S)];
end:
#
#
# weight_mults(v,R) produces the dimensions of the weight spaces of the
#   irreducible rep'n of highest weight v. The output is a sum of the form
#   c1*M[w1]+c2*M[w2]+..., where w1,w2,... are the coordinates of the
#   dominant weights in the weight system of v, and c1,c2,... are their
#   multiplicities.
#
# weight_mults(v,u,R) computes the multiplicity of the weight u in the
#   rep'n of highest weight v. The weight u need not be dominant (but v must).
# 
#  u and v are assumed to be in the standard coordinates.
#
`weyl/weight_mults`:=proc(v0) local mults,R,S,Wt,Rp,rho,n,wR,i,j,j0,k,
    wts,v,v1,c,m,u,wl,J,dom,orb;
  if nargs>2 and args[1]=args[2] then RETURN(1) fi;
  R:=args[nargs]; S:=coxeter['base'](R); Wt:=weyl['weights'](R); 
  if nargs>2 then 
    v1:=coxeter['vec2fc'](args[2],S);
    for v in Wt do if coxeter['iprod'](v0-v1,v)<0 then RETURN(0) fi od;
  fi;
  Rp:=coxeter['pos_roots'](R); rho:=convert(Rp,`+`)/2;
  v:=coxeter['interior_pt'](S);
  wts:=weyl['weight_sys'](v0,R,'wl','wR');
  wts:=[seq([wts[i],wl[i],coxeter['iprod'](wts[i],v)],i=1..nops(wts))];
  wts:=sort(wts,proc(x,y) evalb(x[3]>=y[3]) end);
  wl:=map(<op(2,x)>,wts); wts:=map(<op(1,x)>,wts);
  if nargs>2 then member(weyl['weight_coords'](v1,S),wl,'n')
    else n:=nops(wts) fi;
  mults:=[1];
  for i from 2 to n do;
    v:=wts[i]; m:=0;
    J:=map(proc(x,y) if y[x]=0 then x fi end,[$1..nops(S)],wl[i]);
    c:=coxeter['iprod'](v0+rho,v0+rho)-coxeter['iprod'](v+rho,v+rho);
    for k to nops(Rp) do;
      dom:=evalb(0=0);
      for j in J while dom do if wR[k][j]<0 then dom:=evalb(1=0) fi od;
      if not dom then next else u:=v+Rp[k] fi;
      coxeter['vec2fc'](u,S);
      if not member(",wts,'j') then next fi;
      orb:=coxeter['orbit_size'](Rp[k],[seq(S[j0],j0=J)],-1);
      do;
        m:=m+mults[j]*orb*coxeter['iprod'](u,Rp[k]);
        u:=u+Rp[k]; coxeter['vec2fc'](u,S);
        if not member(",wts,'j') then break fi;
      od;
    od;
    mults:=[op(mults),m/c];
  od;
  if nargs>2 then mults[n] else
    convert([seq(mults[i]*M[op(wl[i])],i=1..nops(wts))],`+`) fi;
end: 
#
#
# weight_sys(v,R) produces the list of all dominant weights that are
#  "less" than the dominant weight v, w.r.t. the partial ordering in
#  which v1<v2 if v2-v1 is a sum of positive roots.
# weight_sys(v,R,'wl') will do the same, but also assigns to 'wl' the
#   coordinates of the weight vectors with respect to the fundamental
#   weights.
# weight_sys(v,R,'wl','wR') will do the above, as well as assign the
#   weight coordinates of the positive roots to 'wR'.
# To save time, one can prestore the positive roots and 'wR' via store(R).
#
`weyl/weight_sys`:=proc(v0,R) local n,S,Rplus,i,j,len,wR,res,wres,v,sat,wv;
  S:=coxeter['base'](R); n:=nops(S);
  Rplus:=coxeter['pos_roots'](R);
  if type(`weyl/weights/`.R,'list') then
    wR:=`weyl/weights/`.R
  else
    len:=[seq(coxeter['iprod'](i,i),i=S)];
    wR:=[seq([seq(2*coxeter['iprod'](i,S[j])/len[j],j=1..n)],i=Rplus)]
  fi;
  wres:=[weyl['weight_coords'](v0,S)];
  res:=[v0]; sat:=0;
  while sat<nops(res) do;
    for i to nops(Rplus) do;
      v:=res[sat+1]-Rplus[i];
      if member(v,res) then next fi;
      wv:=[seq(wres[sat+1][j]-wR[i][j],j=1..n)];
      if min(op(wv))<0 then next fi;
      res:=[op(res),v]; wres:=[op(wres),wv];
    od;
    sat:=sat+1;
  od;
  if nargs>2 then assign(args[3],wres) fi;
  if nargs>3 then assign(args[4],wR) fi;
  res;
end:
#
#
# weights(R) returns the list of fundamental weights for R.
# weights(S) does the same, using S as an ordered list of simple roots.
#
`weyl/weights`:=proc(R) local S,n,A,i,j,B;
  if type(R,'list') then S:=R else S:=coxeter['base'](R) fi;
  n:=nops(S); A:=array(symmetric,1..n,1..n);
  for i to n do;
    for j from i to n do;
      A[i,j]:=coxeter['iprod'](S[i],S[j]);
    od;
  od;
  B:=linalg['inverse'](A);
  [seq(A[i,i]*convert([seq(B[i,j]*S[j],j=1..n)],`+`)/2,i=1..n)];
end:
#
#
# Note that this algorithm is inefficient if several computations of
# weyl_dim()'s are required for the same choice of R. To increase 
# efficiency in such cases one should store the pos_roots(R) in the 
# remember table: coxeter['pos_roots'](R):=pos_roots(R);
#
`weyl/weyl_dim`:=proc(v,R) local r,roots,rho,q,res;
  roots:=coxeter['pos_roots'](R);
  rho:=convert(roots,`+`)/2;
  if nargs=2 then
    [seq(1+coxeter['iprod'](r,v)/coxeter['iprod'](r,rho),r=roots)];
    res:=convert(",`*`);
  else
    q:=args[3]; res:=q^(-coxeter['iprod'](rho,v));
    for r in roots do;
      res:=res*(q^(coxeter['iprod'](r,v+rho))-1)
        /(q^(coxeter['iprod'](r,rho))-1);
    od;
  fi;
  res;
end:
#
#
#
# Supplement to Coxeter for manipulating Weyl characters
#
# Calling sequence:    weyl[<funcname>](<arguments>)
#
weyl:='weyl':
`weyl/reader`:=proc(x) local y; eval(`weyl/`.x) end:
#
weyl[rho]:=`weyl/reader`(rho):
weyl[store]:=`weyl/reader`(store):
weyl[weights]:=`weyl/reader`(weights):
weyl[weight_coords]:=`weyl/reader`(weight_coords):
weyl[weight_mults]:=`weyl/reader`(weight_mults):
weyl[weight_sys]:=`weyl/reader`(weight_sys):
weyl[weyl_dim]:=`weyl/reader`(weyl_dim):

`help/text/weyl` := TEXT(
`HELP FOR: The weyl package`,
`      `,
`CALLING SEQUENCES:`,
`   <function>(args)`,
`   weyl[<function>](args)`,
`      `,
`SYNOPSIS:   `,
`   `,
`- The coxeter package contains 30 basic procedures for studying roots systems`,
`  and finite Coxeter groups.  The weyl package is a supplement to the coxeter`,
`  package that contains 7 procedures for manipulating weight vectors and`,
`  computing multiplicities for irreducible representations of semisimple Lie`,
`  algebras.  Note: to use the weyl package, you must first load the coxeter`,
`  package in the same way you have loaded the weyl package, i.e. by doing`,
`  read coxeter;  or  read ``coxeter.m```,
`   `,
`- To use <function>, either use the long notation weyl[<function>](...);`,
`  or first define the posets functions by doing  with(weyl);  then use`,
`  the short notation  <function>(...);`,
`      `,
`- The functions in the weyl package are:`,
`   `,
`  rho            weight_coords  weight_sys     weyl`,
`  store          weight_mults   weights        weyl_dim`,
`   `,
`- Help for any of these functions can be obtained with ?weyl,<function>`,
`   `,
`- An overall description of the weyl package is given in the TeX document in`,
`  the file coxeter.tex.`,
`   `,
`- The examples subdirectory contains a number of example applications to`,
`  the weyl package.  These are Maple source code files.`
):

`help/weyl/text/rho` := TEXT(
`    `,
`FUNCTION :  rho - half the sum of the positive roots`,
`    `,
`CALLING SEQUENCE :  rho(R);`,
`                    rho(S);`,
`    `,
`PARAMETERS :  R = a crystallographic root system`,
`              S = a list of base vectors for R`,
`   `,
`SYNOPSIS :   `,
` Let R be a crystallographic root system with base S=[S[1],...,S[n]],`,
`  expressed in terms of the standard coordinates e1,e2,e3,...`,
` rho(S) returns half the sum of the positive roots of R. It does not`,
`  actually generate the positive roots--it uses the fact that rho(S) is`,
`  the sum of the fundamental weights.`,
` rho(R) does the same thing, using the base vectors supplied by base(R).`,
`   `,
`EXAMPLES :   `,
`  rho(C3);                       yields   e1+2*e2+3*e3`,
`  rho([-e1-e2,e2-e1,e3+e1]);     yields    -e1+2*e3`,
`    `,
`SEE  ALSO :  coxeter[base], coxeter[pos_roots], weights`,
`   `
):

`help/weyl/text/store` := TEXT(
`    `,
`FUNCTION :  store - pre-store data for weight multiplicity computations`,
`    `,
`CALLING SEQUENCE :  store(R);`,
`    `,
`PARAMETERS :  R = a crystallographic root system `,
`   `,
`SYNOPSIS :   `,
` Let R be a crystallographic root system. , the procedure  store(R) `,
` store(R) does the following: (a) compute the list of positive roots of R`,
`  relative to base(R), and store them in the remember table of`,
`  coxeter[pos_roots], and (b) compute the coordinates of the positive roots`,
`  with respect to the fundamental weights, saving them in a list named`,
`  ``weyl/weights/``.R.`,
` For multiple computations involving the same root system R (especially the`,
`  larger ones), the speed of weyl_dim(), weight_sys(), and weight_mults()`,
`  will all be improved if the above data is first saved via store().`,
` The value returned is NULL.`,
`   `,
`EXAMPLES :   `,
` store(E8); W:=weights(E8);`,
` weight_sys(W[8],E8);            yields             [e8+e7, 0]`,
` weight_sys(W[7],E8);            yields    [e6+e7+2*e8, 2*e8, e8+e7, 0]`,
`    `,
`SEE  ALSO :  coxeter[pos_roots], weight_coords, weight_mults, weight_sys,`,
`  weights, weyl_dim`,
`   `
):

`help/weyl/text/weight_coords` := TEXT(
`    `,
`FUNCTION :  weight_coords - coords of a vector w.r.t. fundamental weights`,
`    `,
`CALLING SEQUENCE :  weight_coords(v,R);`,
`                    weight_coords(v,S);`,
`    `,
`PARAMETERS :  R = a crystallographic root system `,
`              S = a list of base vectors for R`,
`              v = a vector in standard coordinates`,
`   `,
`SYNOPSIS :   `,
` Let R be a crystallographic root system with base vectors S=[S[1],...,S[n]],`,
`  and fundamental weights W=[W[1],...,W[n]]. Let v be a vector in the span`,
`  of S, expressed in terms of the standard coordinates e1,e2,e3,...`,
` weight_coords(v,S) returns the list of coordinates of v with respect to W;`,
`  i.e., it returns a list [c_1,...,c_n] s.t. v=c_1*W[1]+...+c_n*W[n].`,
` weight_coords(v,R) does the same thing, relative to the base vectors`,
`  supplied by base(R).`,
` The coefficients of v must be rational, algebraic, or floating-point.`,
`   `,
`EXAMPLES :   `,
`  weight_coords(rho(F4),F4);    yields             [1,1,1,1]`,
`  pr:=coxeter[pos_roots](G2);`,
`  map(weight_coords,pr,G2);     yields `,
`                                  [[2,-1],[-3,2],[-1,1],[3,-1],[1,0],[0,1]]`,
`    `,
`SEE  ALSO :  coxeter[root_coords], weights`,
`   `
):

`help/weyl/text/weight_mults` := TEXT(
`    `,
`FUNCTION :  weight_mults - weight multiplicities in irreducible rep'ns`,
`    `,
`CALLING SEQUENCE :  weight_mults(v,R);`,
`                    weight_mults(v,u,R);`,
`    `,
`PARAMETERS :  R = a crystallographic root system `,
`              v = a dominant weight vector in standard coordinates`,
`              u = a weight vector in standard coordinates`,
`   `,
`SYNOPSIS :   `,
` Let R be a crystallographic root system with fundamental weights`,
`  W=[W[1],...,W[n]], expressed in terms of the standard coordinates e1,e2,...`,
`  Let v be an integral dominant weight; i.e., a linear combination of the`,
`  form  m_1*W[1]+...+m_n*W[n],  where m_1,...,m_n are nonnegative integers.`,
` weight_mults(v,R) computes the dimensions of the weight spaces in the`,
`  irreducible representation of the Lie algebra of R with highest weight v.`,
`  The output is expressed as a linear combination of the form`,
`  c1*M[w1]+c2*M[w2]+..., where w1,w2,... are the weight-coordinates of the`,
`  dominant weights that occur in the representation (cf. weight_sys()), and`,
`  c1,c2,... are their multiplicities.`,
` In the second form, if u is any integral weight vector (i.e., any integer`,
`  linear combination of the fundamental weights, not necessarily dominant)`,
`  expressed as a linear combination of the standard coordinates e1,e2,...,`,
`  then weight_mults(v,u,R) will compute the multiplicity of the weight u`,
`  in the highest weight representation indexed by v.`,
` The algorithm used is essentially the same as the one given by Moody and`,
`  Patera (Bull. Amer. Math. Soc. 7 (1982), 237--242), which in turn is`,
`  based on Freudenthal's algorithm. `,
` If more than one computation of weight_mults() is anticipated for the same`,
`  root system R, then it is more efficient to first call the procedure`,
`  store(R). This way, the positive roots and their weight coordinates will`,
`  not need to be regenerated each time weight_mults() is called.`,
`   `,
`EXAMPLES :   `,
` store(C3); W:=weights(C3);`,
` v:=W[1]+W[3];`,
` weight_mults(v,C3);       yields   M[1,0,1]+M[0,0,2]+3*M[0,1,0]+4*M[0,0,0]`,
` u:=e1+e3;   `,
` weight_mults(v,u,C3);     yields                  3`,
` weight_coords(u,C3);      yields              [1, -1, 1]`,
`    `,
`SEE  ALSO :  coxeter[pos_roots], store, weight_coords, weight_sys`,
`  weights, weyl_dim`,
`   `
):

`help/weyl/text/weight_sys` := TEXT(
`    `,
`FUNCTION :  weight_sys - weight vectors dominated by a given highest weight`,
`    `,
`CALLING SEQUENCE :  weight_sys(v,R);`,
`                    weight_sys(v,R,'wc');`,
`    `,
`PARAMETERS :  R = a crystallographic root system `,
`              v = a dominant weight vector in standard coordinates`,
`             wc = a name (optional)`,
`   `,
`SYNOPSIS :   `,
` Let R be a crystallographic root system with fundamental weights`,
`  W=[W[1],...,W[n]], expressed in the standard coordinates e1,e2,e3,...`,
`  Let v be an integral dominant weight; i.e., a linear combination of the`,
`  form  m_1*W[1]+...+m_n*W[n],  where m_1,...,m_n are nonnegative integers.`,
` weight_sys(v,R) returns the list of all integral dominant weights that`,
`  are '<=' v in the partial ordering for which v1<v2 whenever v2-v1`,
`  is an integral sum of positive roots. These weight vectors are the ones`,
`  that occur with nonzero multiplicity in the irreducible representation of`,
`  the Lie algebra of R with highest weight v.`,
` weight_sys(v,R,<name>) does the same thing, but also assigns to <name> the`,
`  list of coordinates of the weight vectors with respect to the fundamental`,
`  weights.   `,
` If more than one computation of weight_sys(v,R) is anticipated for the same`,
`  root system R, then it is more efficient to first call the procedure`,
`  store(R). This way, the positive roots and their weight coordinates will`,
`  not need to be regenerated each time weight_sys() is called.`,
`   `,
`EXAMPLES :   `,
` W:=weights(C3); v:=W[1]+W[3];`,
` weight_sys(v,C3);              yields      [e1+e2+2*e3, 2*e3, e2+e3, 0]`,
` W:=weights(G2); v:=3*W[1];`,
` weight_sys(v,G2,'wc'); wc;     yields  [[3,0],[1,1],[0,1],[2,0],[1,0],[0,0]]`,
`    `,
`SEE  ALSO :  coxeter[pos_roots], store, weight_coords, weight_mults`,
`  weights, weyl_dim`,
`   `
):

`help/weyl/text/weights` := TEXT(
`    `,
`FUNCTION :  weights - fundamental weights of a root system`,
`    `,
`CALLING SEQUENCE :  weights(R);`,
`                    weights(S);`,
`    `,
`PARAMETERS :  R = a crystallographic root system `,
`              S = a list of base vectors for R`,
`   `,
`SYNOPSIS :   `,
` Let R be a crystallographic root system with base vectors S=[S[1],...,S[n]]`,
`  expressed in terms of the standard coordinates e1,e2,e3,...`,
` weights(S) returns the list of fundamental weights for R; i.e., the`,
`  vectors [W[1],...,W[n]] such that `,
`                  iprod(W[i],S[j])`,
`              2 * ---------------- = Kronecker_Delta(i,j).`,
`                  iprod(S[j],S[j])`,
` weights(R) does the same thing, using the base vectors supplied by base(R).`,
`   `,
`EXAMPLES :   `,
`  weights(G2);                  yields   [-e1+e3,-e2-e1+2*e3]`,
`  S:=[e1-e2,e2-e3,2*e3];`,
`  weights(S);                   yields   [e1, e1+e2, e1+e2+e3]`,
`    `,
`SEE  ALSO :  coxeter[base, iprod], rho, weight_coords, weight_sys`,
`   `
):

`help/weyl/text/weyl_dim` := TEXT(
`    `,
`FUNCTION :  weyl_dim - Weyl dimension formula for irreducible rep'ns`,
`    `,
`CALLING SEQUENCE :  weyl_dim(v,R);     weyl_dim(v,R,q);`,
`                    weyl_dim(v,S);     weyl_dim(v,S,q);`,
`    `,
`PARAMETERS :  R = a crystallographic root system `,
`              S = a list of base vectors for R`,
`              v = a (weight) vector in standard coordinates`,
`              q = a variable (optional)`,
`   `,
`SYNOPSIS :   `,
` Let R be a crystallographic root system with positive roots [r_1,...,r_n],`,
`  and let v be a vector in the standard coordinates e1,e2,e3,..., regarded`,
`  as a weight vector indexing some irreducible representation of the Lie`,
`  algebra of type R.`,
` weyl_dim(v,R) computes the dimension of the representation indexed by v,`,
`  using the Weyl dimension formula.`,
` weyl_dim(v,S) does the same thing, using the root system generated by the`,
`  base vectors S.`,
` If a third argument, say 'q', is present, then weyl_dim() computes a`,
`  'q-analogue' of the dimension formula; namely,`,
`                -iprod(v,rho)       (1-q^iprod(v+rho,r_i))`,
`               q             * prod ----------------------.`,
`                                 i   (1-q^iprod(rho,r_i))  `,
`  This can be viewed as a formal substitution of 'q^rho' into the Weyl`,
`  character indexed by v.`,
` If several computations of weyl_dim(v,R) are anticipated for the same`,
`  root system R, then it is more efficient to use the procedure store(R)`,
`  to save the positive roots of R in a remember table, so that they need`,
`  not be re-generated each time weyl_dim() is called.`,
`   `,
`EXAMPLES :   `,
` W:=weights(C2);`,
` v:=collect(a*W[1]+b*W[2],[e1,e2]);`,
` normal(weyl_dim(v,C2));           yields  1/6*(1+a)*(1+b)*(2+a+b)*(3+2*a+b)`,
` W:=weights(F4); store(F4);`,
` map(weyl_dim,W,F4);               yields      [26, 273, 1274, 52]`,
` weyl_dim(2*e2+e1,B2,q^2);         yields  (q^7-1)*(q^10-1)/q^7/(q-1)/(q^2-1)`,
`    `,
`SEE  ALSO :  coxeter[base, iprod, pos_roots], rho, store, weights`,
`   `
):

#save `weyl.m`;
#quit
