#############################################################################
##
#A  genVgreenfctsa       CHEVIE library          Meinolf Geck & Frank L"ubeck
##
#Y  Copyright 1992--1993,  Lehrstuhl D f"ur Mathematik,    RWTH Aachen,   and
#Y                         IWR   der   Universit"at    Heidelberg,   Germany.
##
#############################################################################
##
## Programs for computing Green functions of type A and ^2A
##
##
teilmenge:=proc(l,n)
  local  i, j, g, nl, erg, hi;
#  option remember;
  g:=convert(l,`+`);
  nl:=nops(l);
  if nl=1 then 
    RETURN([[n]]);
  elif g=n then
    RETURN([l]);
  elif n=0 then
    RETURN([[0$i=1..nl]]);
  else
    erg:=[];
    for i from max(0, n-g+l[nl]) to min(l[nl],n) do
      hi:=teilmenge([op(1..nl-1, l)],n-i);
      for j to nops(hi) do
        erg:=[op(erg),[op(hi[j]),i]];
      od;
    od;
  fi;
  erg;
end:
  
Standard:=proc(mu,la)
  local erg, n, nl, i, j, k, hi, hi1, nm, d, dd, ln, ll, r, p;
#  option remember;
  d:=[];
  nl:=nops(la);
  nm:=nops(mu);
  for i to nl-1 do
    d:=[op(d), la[i]-la[i+1]];
  od;
  d:=[op(d),la[nl]];
  n:=mu[nm];
  if n>convert(d,`+`) then
    RETURN([]);
  elif nm=1 then
    RETURN([[[1$j=1..n]]]);
  else
    erg:=[];
    hi:=teilmenge(d,n);
    for dd in hi do
      ln:=[];
      for k to nl do
        ln:=[op(ln),la[k]-dd[k]];
      od;
      if ln[nl]=0 then
        ln:=[op(1..nl-1, ln)];
      fi;
      if nops(ln)<nm then
        hi1:=Standard([op(1..nm-1,mu)], ln);
        for ll in hi1 do
          p:=ll;
          if nops(ln)<nl then
            p:=[op(p),[]];
          fi;
          for k to nl do
            r:=nm$j=1..dd[k];
            p:=subsop(k=[op(p[k]),r], p);
          od;
          erg:=[op(erg),p];
        od;
      fi;
    od;
  fi;
  erg;
end:


rum:=proc(l)
  local i, erg;
  erg:=NULL;
  for i in l do
    erg:=i,erg;
  od;
  [erg];
end:

TabWord:=proc(t)
  local l, erg;
  erg:=NULL;
  for l in t do
    erg:=erg,op(rum(l));
  od;
  [erg];
end:

position:=proc(i,l)
  local j;
  for j to nops(l) do
    if l[j]=i then
      RETURN(j);
    fi;
  od;
  false;
end:

Charge:=proc(l)
  local erg, a, i;
  erg:=0;
  a:=0;
  for i from 2 to nops(l) do
    if position(i,l)<position(i-1,l) then
       a:=a+1;
    fi;
    erg:=erg+a;
  od;
  erg;
end:

Extract := proc(w)
  local ll, buff, merk, search, res1, res2, i, hi, word;
  word:=w;
  ll := nops(word);
  buff := [0$i=1..ll];

  merk := position(1,word);
  buff:=subsop(merk=1,buff);
  word:=subsop(merk=0,word);

  for i to max(op(word))-1 do
    search := [op(merk+1..ll, word)];
    if member(i+1, search, 'hi')  then
       merk := merk + hi;
    else
      merk := position(i+1,word);
    fi;
    buff:=subsop(merk=i+1, buff);
    word:=subsop(merk=0, word);
  od;

  res1 := NULL;
  for i to nops(word) do
    if word[i]>0 then
      res1:=res1,word[i];
    fi;
  od;
  res1:=[res1];
  res2 := NULL;
  for i to nops(buff) do
    if buff[i]>0 then
      res2:=res2,buff[i];
    fi;
  od;
  res2:=[res2];
  [res1,res2];
end:

revpart:=proc(l)
  local i, j, erg;
  erg:=[1 $i=1..l[1]];
  for i from 2 to nops(l) do
    for j to l[i] do
      erg:=subsop(j=op(j,erg)+1,erg);
    od;
  od;
  erg;
end:

Nlambda := proc(part)
  local du, i, l, sum, run;
  du := revpart(part);
  l := nops(du);
  sum := 0;
  for i to l do
    run := du[i] * (du[i] - 1);
    sum := sum + (run/2);
  od;
  sum;
end:
 
FoulkesPol := proc(la,mu)
  local  list, erg, charge, i, j, word, buff, nla;  
  erg:=0;
  nla:=Nlambda(mu);
  if nops(mu) >= nops(la) then
    list := Standard(mu, la);
    if list <> {} then
      for i to nops(list) do
        word := TabWord(list[i]);
        charge := 0;
        if mu[1] = 1 then
          charge := Charge(word);
        else
          for j to mu[1]-1 do
            buff := Extract(word);
            word := buff[1];
            charge := charge + Charge(buff[2]);
          od;
          charge := charge + Charge(buff[1]);
        fi;
        charge := charge + 1;
        erg:=erg+q^(nla+1-charge);
      od;
    fi;
  fi;
  erg;
end:

with(combinat):
UniPotentCharA := proc(n)
  local  i, j,  pn,  erg; 
  pn := partition(n);
  lprint(`Number of conjugacy classes:`,nops(pn));
  pn:=map(rum,pn);
  erg:=array(1..nops(pn),1..nops(pn), []);
  for i to nops(pn) do
    for j to nops(pn) do
                               #lprint(i,j);
      erg[i,j] := FoulkesPol(pn[i], pn[j]);
    od;
  od;
  [op(erg),pn];
end:


GreenFunctionsA := proc(l)
  local n, i, j, k, U, erg, sum, akl, pn, pni, ti, 
        grp, file, tname, kl, quietmerk;
  n:=l+1; 
  ti:=time();
  U := UniPotentCharA(n);
  pn:=U[2];
#  pni:=rum(pn);
  akl:=nops(pn);
  U:=U[1];
  erg:=array(1..akl,1..akl,[]);
  lprint(`Foulkes polynomials computed.`);    #, time:`,time()-ti);
  lprint(`Now twisting to Green functions.`);  
  for i to akl do
    for j to akl do
                          #lprint(i,j);
      sum := 0;
      for k to akl do
#        sum := sum + Chi(rum(pn[k]),rum(pni[i]))*U[k,j];
        sum := sum + Chi(rum(pn[k]),rum(pn[i]))*U[k,j];
      od;
      erg[i,j] := factor(sum);
    od;
  od;
          #lprint(`Gesamtzeit:`,time()-ti);
#Eventuell Ausgabe in Datei:
  if nargs=2 then
    file:=args[2];
    grp:=grpord(n);
    tname:=n-1;
    tname:=A.tname.`002green`;
    quietmerk:=interface(quiet);
    interface(quiet=true);
    writeto(file);
    schreibdateikopfA(n);
    lprint();
    lprint(`GL`.n.`green:=array(-2..`.akl.`, -1..`);
    lprint(max(akl,5),`, [`);
    lprint(`[ ``GL_{`.n.`}(q)``,`,tname,`,`,grp,`,`,
             akl,`,`,akl,`,`,akl,`,`,akl,`],`);
    lprint(`[````, [`);
    for i to akl do
      lprint(`], [`,p2str(pn[i]));
    od;
    lprint(`] ],`);
    lprint(`[````, 1`);
    for i to akl do
      kl:=factor(grp/ocuni(pn[i]));
      lprint(`,`,kl);
    od;
    lprint(`]`);
    for i to akl do
#      lprint(`,[`,p2str(pni[i]),`,`,erg[i,1]);
      lprint(`,[`,p2str(pn[i]),`,`,erg[i,1]);
      for j to akl do 
        lprint(`,`, erg[i,j]);
      od;
      lprint(`]`);
    od;
    lprint(`]):`);
    lprint();
    lprint(`KlassentypOrd`.tname.`:=array(1..`.akl.`,`,
           [1$'k'=1..akl],  `):`);
    lprint(`NurPolynom`.tname.`:=true:`);
    schreibinformationA(tname,n);
    lprint(`g:=`.`GL`.n.`green:`);
    lprint(`print(``g := ````GL`.n.`green```` ``);`);
    writeto(terminal);
    interface(quiet=quietmerk);
    print(`Green functions of GL_`.n.` written in file `.file.`.`);
  fi;
  [op(erg),pn];
end:



schreibdateikopfA:=proc(n)
  local hi,i;
  hi:=``.n.`(q)`;
  for i to 3-length(n) do
    hi:=``.hi.` `;
  od;
  lprint(`#############################################################################`);
  lprint(`##`);
  lprint(`#F                             CHEVIE library`);
  lprint(`##`);
  lprint(`#Y  Copyright 1992--1993,  Lehrstuhl D f"ur Mathematik,    RWTH Aachen,   and`);
  lprint(`#Y                         IWR   der   Universit"at    Heidelberg,   Germany.`);
  lprint(`##`);
  lprint(`#############################################################################`);
  lprint(`#                                                                           #`);
  lprint(`#   Die Greenfunktionen der GL_`.hi.`                                       #`);
  lprint(`#                                                                           #`);
  lprint(`#############################################################################`);
  lprint(`##`);
  lprint(`#A {\\sc }, `);
  lprint(`#A `);
  lprint(`##`);
  lprint(`lprint(``**************************************************************************``);`);
  lprint(`lprint(``*                                                                        *``);`);
  lprint(`lprint(``*                                                                        *``);`);
  lprint(`lprint(``*                    Green Functions of GL_`.hi.`                        *``);`);
  lprint(`lprint(``*                                                                        *``);`);
  lprint(`lprint(``*                                                                        *``);`);
  lprint(`lprint(``**************************************************************************``);`);
  NULL;
end:

schreibinformationA:=proc(tname,n)
  lprint(`Information`.tname.`:=TEXT(`);
  lprint(```- Information about the tables of Green functions for GL_`.n.`(q).``,`);
  lprint(`````,`);
  lprint(```- CHEVIE-name of the table: GL`.n.`green``,`);
  lprint(`````,`);
  lprint(```- These Green functions were introduced in:``,`);
  lprint(```  {\\\\sc J.~A.~Green}, The characters of the finite general linear``,`);
  lprint(```  groups, {\\\\em Trans. Amer. Math. Soc.} {\\\\bf 80} (1955), 402--447.``,`);
  lprint(`````,`);
  lprint(```- See also:``,`);
  lprint(```  {\\\\sc R.~Steinberg}, The representations of $GL(3,q)$,  $GL(4,q)$, $PGL(3,q)$ ``,`);
  lprint(```  and $PGL(4,q)$, {\\\\em Can. J. of Math.} {\\\\bf 3} (1951), 225--235.``,`);
  lprint(`````,`);
  lprint(```- This CHEVIE-table is computed by an algorithm from ``,`);
  lprint(```  the following article:``,`);
  lprint(```  {\\\\sc A.~Lascoux and M.~P.~Sch{\\\\"u}tzenberger}, Sur une conjecture de ``,`);
  lprint(```  H.~O.~Foulkes, {\\\\em C. R. Acad. Sci. Paris} {\\\\bf 286A}  (1978), 323--324.``,`);
  lprint(`````,`);
  lprint(```- The program which generates the files with the Green functions ``,`);
  lprint(```  of GL_n(q) and GU_n(q) is part of the CHEVIE-system. You ``,`);
  lprint(```  can reproduce them with the CHEVIE commands: ``,`);
  lprint(```  > GreenFunctionsA(n,filename);``,`);
  lprint(```  > GreenFunctions2A(n,filename);``,`);
  lprint(```  (see the corresponding help)``,`);
  lprint(```  These programs are written by U. Porsch and F. Luebeck.``,`);
  lprint(`````):`);
  NULL;
end:
  


GreenFunctions2A := proc(l)
  local n, i, j, k, U, erg, sum, akl, pn, pni, ti, 
        grp, file, tname, kl, quietmerk; 
  n:=l+1;
  ti:=time();
  U := UniPotentCharA(n);
  pn:=U[2];
#  pni:=rum(pn);
  akl:=nops(pn);
  U:=U[1];
  erg:=array(1..akl,1..akl,[]);
  lprint(`Foulkes polynomials computed.`);    #, time:`,time()-ti);
  lprint(`Now twisting to Green functions.`);  
  for i to akl do
    for j to akl do
                          #lprint(i,j);
      sum := 0;
      for k to akl do
#        sum := sum + Chi(rum(pn[k]),rum(pni[i]))*U[k,j];
        sum := sum + Chi(rum(pn[k]),rum(pn[i]))*U[k,j];
      od;
      erg[i,j] := factor(sum);
    od;
  od;
  erg:=map(factor,subs(q=-q,op(erg)));
          #lprint(`Gesamtzeit:`,time()-ti);
#Eventuell Ausgabe in Datei:
  if nargs=2 then
    file:=args[2];
    grp:=factor(subs(q=-q,grpord(n)));
    grp:=grp/sign(grp);
    tname:=n-1;
    tname:=``.`2A`.tname.`002green`;
    quietmerk:=interface(quiet);
    interface(quiet=true);
    writeto(file);
    schreibdateikopf2A(n);
    lprint();
    lprint(`GU`.n.`green:=array(-2..`.akl.`, -1..`);
    lprint(max(akl,5),`, [`);
    lprint(`[ ``GU_{`.n.`}(q)``,`,````.tname.````,`,`,grp,`,`,
             akl,`,`,akl,`,`,akl,`,`,akl,`],`);
    lprint(`[````, [`);
    for i to akl do
      lprint(`], [`,p2str(pn[i]));
    od;
    lprint(`] ],`);
    lprint(`[````, 1`);
    for i to akl do
      kl:=factor(grp/subs(q=-q,ocuni(pn[i])));
      kl:=kl/sign(kl);
      lprint(`,`,kl);
    od;
    lprint(`]`);
    for i to akl do
#      lprint(`,[`,p2str(pni[i]),`,`,erg[i,1]);
      lprint(`,[`,p2str(pn[i]),`,`,erg[i,1]);
      for j to akl do 
        lprint(`,`, erg[i,j]);
      od;
      lprint(`]`);
    od;
    lprint(`]):`);
    lprint();
    lprint(`KlassentypOrd`.tname.`:=array(1..`.akl.`,`,
           [1$'k'=1..akl],  `):`);
    lprint(`NurPolynom`.tname.`:=true:`);
    schreibinformation2A(tname,n);
    lprint(`g:=`.`GU`.n.`green:`);
    lprint(`print(``g := ````GU`.n.`green```` ``);`);
    writeto(terminal);
    interface(quiet=quietmerk);
    print(`Green functions of GU_`.n.` written in file `.file.`.`);
  fi;
  [op(erg),pn];
end:



schreibdateikopf2A:=proc(n)
  local hi,i;
  hi:=``.n.`(q)`;
  for i to 3-length(n) do
    hi:=``.hi.` `;
  od;
  lprint(`#############################################################################`);
  lprint(`##`);
  lprint(`#F                             CHEVIE library`);
  lprint(`##`);
  lprint(`#Y  Copyright 1992--1993,  Lehrstuhl D f"ur Mathematik,    RWTH Aachen,   and`);
  lprint(`#Y                         IWR   der   Universit"at    Heidelberg,   Germany.`);
  lprint(`##`);
  lprint(`#############################################################################`);
  lprint(`#                                                                           #`);
  lprint(`#   Die Greenfunktionen der GU_`.hi.`                                       #`);
  lprint(`#                                                                           #`);
  lprint(`#############################################################################`);
  lprint(`##`);
  lprint(`#A {\\sc }, `);
  lprint(`#A `);
  lprint(`##`);
  lprint(`lprint(``**************************************************************************``);`);
  lprint(`lprint(``*                                                                        *``);`);
  lprint(`lprint(``*                                                                        *``);`);
  lprint(`lprint(``*                    Green Functions of GU_`.hi.`                        *``);`);
  lprint(`lprint(``*                                                                        *``);`);
  lprint(`lprint(``*                                                                        *``);`);
  lprint(`lprint(``**************************************************************************``);`);
  NULL;
end:


schreibinformation2A:=proc(tname,n)
  lprint(`Information`.tname.`:=TEXT(`);
  lprint(```- Information about the tables of Green functions for GU_`.n.`(q^2).``,`);
  lprint(`````,`);
  lprint(```- CHEVIE-name of the table: GU`.n.`green``,`);
  lprint(`````,`);
  lprint(```- By a theorem of Hotta, Springer and Kawanaka we can get the Green``,`);
  lprint(```  functions of the unitary group GU_`.n.`(q^2) from those of GL_`.n.`(q) ``,`);
  lprint(```  by substituting q by -q. This is proved in:``,`);
  lprint(```  {\\\\sc R.~Hotta and T.~A.~Springer}, A specialisation theorem for``,`);
  lprint(```  certain Weyl group representations, {\\\\em Invent. Math.} ``,`);
  lprint(```  {\\\\bf 41} (1977), 113--127.``,`);
  lprint(```  {\\\\sc N.~Kawanaka}, Generalized Gelfand--Graev characters and``,`);
  lprint(```  Ennola duality, {\\\\em Adv. Stud. Pure Math.} {\\\\bf 6} (1985), 175--206.``,`);
  lprint(`````,`);
  lprint(```- See also:``,`);
  lprint(```  {\\\\sc F.~Digne and J.~Michel}, Foncteurs de Lusztig et caract\\\\````{e}res``,`);
  lprint(```  des groupes lin\\\\'{e}aires et unitaires sur un corps fini, ``,`);
  lprint(```  {\\\\em J. of Alg.} {\\\\bf 107} (1987), 217--255.``,`);
  lprint(`````,`);
  lprint(```- For the computation of the Green functions for GL_n(q) see for example:``,`);
  lprint(```  > GreenFunTab(GL2);``,`);
  lprint(```  > PrintInfoTab(GL2green);``,`);
  lprint(`````):`);
  NULL;
end:



p2str:=proc(p)
  local i, j, erg;
  j:=p[1];
  erg:=`[[`.j;
  for i from 2 to nops(p) do
    j:=p[i];
    erg:=``.erg.`,`.j;
  od;
  ``.erg.`]]`;
end:
grpord:=proc(n)
  local i, erg;
  erg:=1;
  for i to n do
    erg:=erg*(q^n-q^(i-1));
  od;
  factor(erg);
end:

# fuer die folgenden Formeln siehe Borel et al., S.123-126:
onla:=proc(la)
  local i, mu, erg;
  mu:=revpart(la);
  erg:=0;
  for i to nops(mu) do
    erg:=erg+(mu[i]-1)*mu[i]/2;
  od;
  erg;
end:
ophir:=proc(r)
  local erg, i;
  erg:=1;
  for i to r do
    erg:=erg*(1-q^i);
  od;
  factor(erg);
end:
orfinden:=proc(la,i)
  local j,erg;
  erg:=0;
  for j to nops(la) do 
    if la[j]=i then
      erg:=erg+1;
    fi;
  od;
  erg;
end:
ophila:=proc(la)
  local i, erg;
  erg:=1;
  for i to convert(la,`+`) do
    erg:=erg*ophir(orfinden(la,i));
  od;
  erg;
end:
ocuni:=proc(la)
  factor(q^(convert(la,`+`)+2*onla(la))*subs(q=1/q, ophila(la)));
end:
