Anforderungen  |   Konzepte  |   Entwurf  |   Entwicklung  |   Qualitätssicherung  |   Lebenszyklus  |   Steuerung
 
 
 
 


Quelle  symmcomb.gi   Sprache: unbekannt

 
#######################################################################
##  Hecke - symmcomb.gi : Combinatorial functions on partitions.     ##
##                                                                   ##
##     This file contains most of the combinatorial functions used   ##
##     by Specht. Most are standard operations on Young diagrams     ##
##     or partitions.                                                ##
##                                                                   ##
##     These programs, and the enclosed libraries, are distributed   ##
##     under the usual licensing agreements and conditions of GAP.   ##
##                                                                   ##
##     Dmitriy Traytel                                               ##
##     (heavily using the GAP3-package SPECHT 2.4 by Andrew Mathas)  ##
##                                                                   ##
#######################################################################

## Hecke 1.0: June 2010:
##   - Translated to GAP4

## SPECHT Change log
## 2.4: October 1997:
##  - added functions MullineuxSymbol, PartitionMullineuxSymbol,
##    NormalNodes (plus undocumented friends), BetaSet, PartitionBetaSet.

## 2.2: June 1996:
##  - mainly change of function names to make it more compatible with
##    GAP conventions.

## 2.1: April 1996:
##  - added functions for finding paths in the good node partition
##    lattice.

## 2.0: March 1996 : symmcomb.g file created, breaking by specht.g
##  - added functions for finding Kleshchev's "good nodes" and implemented
##    his (and James') algorithm for the Mullineux map.

## 1.0: December 1995: initial release.

######################################################################

#F Lexicographic ordering on partitions
## Lexicographic(mu,nu); -mu and nu are lists
InstallMethod(
  LexicographicOp,
  "for two partitions",
  [IsList,IsList],
  function(lambda,mu) return lambda=mu or lambda>mu; end
); # LexicographicOp

#F LengthLexicographic(mu,nu); -mu and nu are lists
## By default this is used by DecompositionMatrix().
InstallMethod(
  LengthLexicographicOp,
  "for two partitions",
  [IsList,IsList],
  function(mu,nu)
    if Length(mu)=Length(nu) then
      return mu=nu or mu>nu;
    else return Length(mu)<Length(nu);
    fi;
  end
); # LengthLexicographicOp

#F Yet another total order. *** undocumented
InstallMethod(
  ReverseDominanceOp,
  "for two partitions",
  [IsList,IsList],
  function(nu,mu) local i, Mu, Nu;
    if Length(nu)=Length(mu) then
      i:=Length(mu);
      Mu:=0; Nu:=0;
      while i > 0 do
        Mu:=Mu + mu[i]; Nu:=Nu + nu[i];
        if Nu < Mu then return true;
        elif Nu > Mu then return false;
        fi;
        i:=i - 1;
      od;
    else return Length(nu)<Length(mu);
    fi;
  end
); # ReverseDominanceOp

## dominance ordering: returns true is mu dominates, or equals, nu
#F Dominates(mu,nu);  -mu and nu are lists
InstallMethod(
  DominatesOp,
  "for two partitions",
  [IsList,IsList],
  function(mu, nu) local i, m, n;
    if nu=mu then return true;
    elif Sum(nu)=0 then return true;
    elif Sum(nu)>Sum(mu) then return false;
    fi;
    m:=0; n:=0; # partial sums
    i:=1;
    while i <=Length(nu) and i<=Length(mu) do
      m:=m + mu[i]; n:=n + nu[i];
      if n > m then return false; fi;
      i:=i + 1;
    od;
    return true;
  end
); # DominatesOp

## The coonjugate partition to arg.
#F ConjugatePartition(mu);  -mu is a sequence or a list
InstallMethod(
  ConjugatePartitionOp,
  "for partition",
  [IsList],
  function(arg) local part, d, l, dl, x;
    part:=Flat(arg);
    d:=[];
    l:=Length(part);
    dl:=0;
    while l > 0 do
      if part[l] > dl then
        Append(d, List([dl+1..part[l]], x->l));
        dl:=part[l];
      fi;
      l:=l - 1;
    od;
    return d;
  end
); # ConjugatePartitionOp

#F The Littlewood-Richardson Rule.
## the algorithm has (at least), one obvious improvement in that it should
## collect like terms using something like H.operations.Collect after wrapping
## on each row of beta.
InstallMethod(
  LittlewoodRichardsonRuleOp,
  "for two partitions",
  [IsList,IsList],
  function(alpha, beta)
    local lrr, newlrr, x, i, j, row, Place, max, newbies;

    # place k nodes in row r>1 and above; max is the maximum number
    # of new nodes which may be added on this row and below (so
    # this is dependent upon p.new=the number of nodes added to a
    # given row from the previous row of beta).
    Place:=function(p, k, r, max) local newp, np, m, i, M;

      if r > Length(p.lam) then  # top of the partition
        Add(p.lam, k); Add(p.new, k); return [ p ]; else
        if r > 1 and p.lam[r]=p.lam[r-1] then
          max:=max + p.new[r];
          p.new[r]:=0;
          return Place(p, k, r+1, max);
        else
          if r=1 then            # m number of nodes that can be new
            m:=Minimum(k, max);  # to row r
          else m:=Minimum(p.lam[r-1]-p.lam[r], k, max);
          fi;
          if m >=0 and k-m <=p.lam[r] then  # something may fit
            newp:=[];
            for i in [0..m] do  # i nodes on row r
              if k-i <=p.lam[r] then      # remaining nodes will fit on top
                M:=max - i + p.new[r];    # uncovered nodes in previous rows
                np:=StructuralCopy(p);
                if k-i=0 and m > 0 then   # all gone
                  np.lam[r]:=np.lam[r] + i;
                  np.new[r]:=i;
                  Add(newp, np);
                else                      # more nodes can still be placed
                  np.new[r]:=i;
                  for np in Place(np, k-i, r+1, M) do
                    np.lam[r]:=np.lam[r] + i;
                    Add(newp, np);
                  od;
                fi;
              fi;
            od;
            return newp;
          fi;
          return [];
        fi;
      fi;
    end;  # end of Place; LRR internal

    if alpha=[] or alpha=[0] then return [ beta ];
    elif beta=[] or beta=[0] then return [ alpha ];
    elif Length(beta)*Sum(beta) > Length(alpha)*Sum(alpha) then
      return LittlewoodRichardsonRuleOp(beta, alpha);
    else
      lrr:=Place(rec(lam:=StructuralCopy(alpha),# partition
                   new:=List(alpha, i->0)),  # new nodes added from this row
                   beta[1], 1, beta[1]);
      for i in [2..Length(beta)] do
        newlrr:=[];
        for x in lrr do
          row:=1;
          while x.new[row]=0 do row:=row + 1; od;
          max:=x.new[row];
          x.new[row]:=0;
          Append(newlrr, Place(x, beta[i], row+1, max));
        od;
        lrr:=newlrr;
      od;
      return List(lrr, x->x.lam);
    fi;
  end
); # LittlewoodRichardsonRuleOp

#F Not used anywhere, but someone might want it. It wouldn't be too hard
## to write something more efficient, but...
InstallMethod(
  LittlewoodRichardsonCoefficientOp,
  "for three partitions",
  [IsList,IsList,IsList],
  function(lambda,mu,nu)
    local x;

    if Sum(nu)<>Sum(mu)+Sum(lambda) then return 0;
    else return Length(Filtered(LittlewoodRichardsonRuleOp(lambda,mu),x->x=nu));
    fi;
  end
); # LittlewoodRichardsonCoefficientOp

#F the inverse Littlewood-Richardson Rule
InstallMethod(
  InverseLittlewoodRichardsonRuleOp,
  "for partitions",
  [IsList],
  function(alpha)
    local initialise, fill, n, l, invlr, p, r, npp, newp, row, max, x;

    initialise:=function(p, r) local M, np, newp, i;
      if r=1 then newp:=[ ]; M:=alpha[1];
      else newp:=[ StructuralCopy(p) ]; M:=Minimum(alpha[r], p[r-1]);
      fi;
      for i in [1..M] do
        np:=StructuralCopy(p);
        np[r]:=i;
        if r < Length(alpha) then Append(newp, initialise(np, r+1));
        else Add(newp, np);
        fi;
      od;
      return newp;
    end;

    fill:=function(p, row, r, max) local m, M, np, newp, i, x;
      newp:=[];
      m:=Minimum(Minimum(p.total[r-1],alpha[r])-p.total[r], max);
      if row > 1 then m:=Minimum(m, p.mu[row-1]-p.mu[row]); fi;
      max:=max + p.new[r];
      for i in [0..m] do
        np:=StructuralCopy(p);
        np.new[r]:=i;
        np.mu[row]:=np.mu[row] + i;
        if r=Length(alpha) then np.total[r]:=np.total[r] + i; Add(newp, np);
        else
          for x in fill(np, row, r+1, max-i) do
             x.total[r]:=x.total[r] + i; Add(newp, x);
          od;
        fi;
      od;
      return newp;
    end;

    n:=Sum(alpha);
    invlr:=[ [ [], alpha ] ];
    for l in initialise([], 1) do
      npp:=[rec(total:=StructuralCopy(l), new:=List(alpha, r -> 0), mu:=[])];
      for r in [Length(npp[1].total)+1..Length(alpha)] do
        npp[1].total[r]:=0;
      od;
      row:=1;
      while npp<>[] do
        newp:=[];
        for p in npp do
          if row > 1 then r:=row - 1;
          else r:=1;
          fi;
          max:=0;
          while r < Length(p.total) and p.total[r]=alpha[r] do
            max:=max + p.new[r]; p.new[r]:=0; r:=r + 1;
          od;
          p.mu[row]:=alpha[r] - p.total[r];
          if row=1 or p.mu[row] <=max then
            if row=1 then max:=p.total[1];
            else max:=max + p.new[r] - p.mu[row];
            fi;
            p.new[r]:=p.mu[row];
            if r < Length(alpha) then
              for x in fill(p, row, r+1, max) do
                x.total[r]:=x.total[r] + p.mu[row];
                if Sum(x.total)=n then Add(invlr, [l, x.mu]);
                else Add(newp, x);
                fi;
              od;
            else Add(invlr, [l, p.mu]);
            fi;
          fi;
        od;
        row:=row + 1;
        npp:=newp;
      od;
    od;
    invlr[Length(invlr)]:=[alpha,[]];   ## rough hack...
    return invlr;
  end
);  # InverseLittlewoodRichardsonRuleOp

#F dimension of a Specht module
InstallMethod(
  SpechtDimensionOp,
  "for partitions",
  [IsList],
  function(arg) local Dim,part;
  part := Flat(arg);
    Dim:=function(mu) local mud, i,j,d;
      mud:=ConjugatePartitionOp(mu);
      d:=Factorial(Sum(mu));
      for i in [1..Length(mu)] do
        for j in [1..mu[i]] do
          d:=d/(mu[i] + mud[j] - i - j + 1);
        od;
      od;
      return d;
    end;

    return Dim(part);
  end
);

InstallMethod(
  SpechtDimensionOp,
  "for Specht modules",
  [IsHeckeSpecht],
  function(S) local coeffs, parts;

    coeffs := SpechtCoefficients(S);
    parts := SpechtPartitions(S);
    return Sum([1..Length(coeffs)], y->coeffs[y]*SpechtDimensionOp(parts[y]));
  end
); # SpechtDimension


## returns a set of the beta numbers for the partition mu
InstallMethod(
  BetaNumbersOp,
  "for partitions",
  [IsList],
  function(mu)
    return mu + [Length(mu)-1, Length(mu)-2..0];
  end
); # BetaNumbersOp

## ALREADY AVAILABLE IN GAP4
## returns a set of the beta numbers for the partition mu
## InstallMethod(
##   BetaSetOp,
##   [IsList],
##   function(mu)
##     if mu=[] then return [0];
##     else return Reversed(mu) + [0..Length(mu)-1];
##     fi;
##   end
## );

## given a beta set return the corresponding partition
InstallMethod(
  PartitionBetaSetOp,
  "for beta sets",
  [IsList],
  function(beta) local i;
    if beta[Length(beta)]=Length(beta)-1 then return []; fi;
    beta:=beta-[0..Length(beta)-1];
    if beta[1]=0 then
      beta:=beta{[First([1..Length(beta)],i->beta[i]>0)..Length(beta)]};
    fi;
    return Reversed(beta);
  end
); # PartitionBetaSetOp


## **** undocumented
## The runners for a partition on an abacus; a multiple of e-runners
## is returned
#F EAbacusRunners(mu);  -mu is a list
InstallMethod(
  EAbacusRunnersOp,
  "for an integer and a partition",
  [IsInt,IsList],
  function(e,mu) local i, j, k, aba, beta;
    aba:=List([1..e], i->[]);
    if mu=[] or mu=[0] then return aba; fi;

    ## first we find a set of beta numbers for mu; we want an e-multiple
    ## of (strictly) decreasing beta numbers for mu.
    beta:=BetaNumbersOp(mu);

    if Length(beta) mod e <> 0 then ## now add beta numbers back to get
      i:=-Length(beta) mod e;       ## an e-multiple of beta numbers
      beta:=beta+i;
      Append(beta,[i-1,i-2..0]);
    fi;

    for i in beta do
      Add(aba[ (i mod e)+1 ], Int(i/e) );
    od;
    return aba;
  end
); # EAbacusRunnersOp

#F ECore(e,mu), ECore(H,mu); -mu is a sequence or a list
##   Find the core of a partition (all partitions are 0-cores).
InstallMethod(
 ECoreOp,
 "for an integer and a partition",
 [IsInt,IsList],
 function(e,mu) local core, beta, i, j;
    if e=0 then return mu; fi;
    beta:=List(EAbacusRunnersOp(e,mu), i->Length(i));
    beta:=beta - Minimum(beta);  # remove all fully occupied rows
    if Maximum(beta)=0 then return [];
    else
      ## at present beta contains the number of beads on each runner of
      ## the abacus. next we get the beta numbers for all of the beads
      core:=[];
      for i in [1..e] do
        Append(core, List([1..beta[i]], j->e*(j-1)+i-1));
      od;
      Sort(core);
      if core[1]=0 then ## remove the beads which don't affect the beta numbers
        if core[Length(core)]=Length(core)-1 then return []; fi; #empty
        i:=First([1..Length(core)], i->core[i]<>i-1);
        core:=core{[i..Length(core)]}-i+1;
      fi;

      ## finally, we unravel the beta numbers of our core
      core:=List([1..Length(core)],i->core[i]-i+1);
      return core{[Length(core),Length(core)-1..1]};
    fi;
 end
);

InstallMethod(
 ECoreOp,
 "for an algebra and a partition",
 [IsAlgebraObj,IsList],
 function(H,mu)
  return ECoreOp(OrderOfQ(H),mu);
 end
); # ECoreOp

#F True is mu is an e-core. slightly better than the test mu=ECore(e,mu)
InstallMethod(
 IsECoreOp,
 "for an integer and a partition",
 [IsInt,IsList],
 function(e,mu)
  return ForAll(EAbacusRunnersOp(e,mu),r->r=[] or Length(r)=r[1]+1);
 end
);

InstallMethod(
 IsECoreOp,
 "for an algebra and a partition",
 [IsAlgebraObj,IsList],
 function(H,mu)
  return ForAll(EAbacusRunnersOp(OrderOfQ(H),mu),r->r=[] or Length(r)=r[1]+1);
 end
); # IsECoreOp

## returns the e-weight of a partition
#F EWeight(e,mu);  -mu is a sequence or a list
## again, a slight improvement on (Sum(mu)-Sum(ECore(e,mu))/e
InstallMethod(
 EWeightOp,
 "for an integer and a partition",
 [IsInt,IsList],
 function(e,mu)
   if e=0 then return 0;
    else return Sum(EAbacusRunnersOp(e,mu),r->Sum(r)-Length(r)*(Length(r)-1)/2);
    fi;
 end
);

InstallMethod(
 EWeightOp,
 "for an algebra and a partition",
 [IsAlgebraObj,IsList],
 function(H,mu) local e;
    e:=OrderOfQ(H);

  if e=0 then return 0;
    else return Sum(EAbacusRunnersOp(e,mu),r->Sum(r)-Length(r)*(Length(r)-1)/2);
    fi;
 end
); # EWeightOp

#F EQuotient(e,mu);  -mu is a sequence or a list
## e-quotient of a partition. algorithm based on the "star diagram"
InstallMethod(
 EQuotientOp,
 "for an integer and a partition",
 [IsInt,IsList],
 function(e,mu) local q, d, i, j, qj, x;

    if e=0 then return []; fi;
    d:=ConjugatePartitionOp(mu);
    q:=List([1..e], j->[]);
    for i in [1..Length(mu)] do
      x:=0;
      qj:=(mu[i]-i) mod e;
      for j in [1..mu[i]] do
        if (j-d[j]-1) mod e=qj then x:=x + 1; fi;
      od;
      if x<>0 then Add(q[qj+1], x); fi;
    od;
    return q;
 end
);

InstallMethod(
 EQuotientOp,
 "for an algebra and a partition",
 [IsAlgebraObj,IsList],
 function(H,mu)
  return EQuotientOp(OrderOfQ(H),mu);
 end
); # EQuotientOp

## Prints the e-abacus for the partition arg (the number of beads is
## divisible by e, and it is the smallest abacus for arg with this
## property). Pretty to look at, but useful?
#P EAbacus(mu);  -mu is a sequence or a list
InstallMethod(
 EAbacusOp,
 "for an integer and a partition",
 [IsInt,IsList],
 function(e,mu) local i, j, m;
    if e=0 then Print(List([1..Sum(mu)],i->'.'),"\n");
    elif mu=[] or mu=[0] then
      for j in [1..e] do Print("  ."); od;
      Print("\n\n");
    else
      mu:=EAbacusRunnersOp(e,mu);
      m:=Maximum(Flat(mu)) + 1;
      for i in [0..m] do
        for j in [1..e] do
          if  i in mu[j] then Print("  0");
          else Print("  .");
          fi;
        od;
        Print("\n");
      od;
      Print("\n");
    fi;
 end
);

InstallMethod(
 EAbacusOp,
 "for an algebra and a partition",
 [IsAlgebraObj,IsList],
 function(H,mu)
    EAbacusOp(OrderOfQ(H),mu);
 end
); # EAbacusOp

## combine a quotient and core to give a partition using abacuses.
#F CombineEQuotientECore(e,quot,core);
##   <quot> is a list of e-partitions and <core> is a partition.
InstallMethod(
 CombineEQuotientECoreOp,
 "for an integer, a list of partition and a partition",
 [IsInt,IsList,IsList],
 function(e,q,c) local aba, m, beta, i, j;
    if e<>Length(q) then
      Error("usage, CombineEQuotientECore(<H>,<q>,<c>) or ",
            "CombineEQuotientECore(<e>,<q>,<c>) ",
            "where <q> must be a list of <e> partitions");
    fi;

    aba:=EAbacusRunnersOp(e,c); # abacus with an e-multiple of runners to which
                                # we need to add m beads to fit the quotient
    m:=Maximum(List([1..e], i->Length(q[i])-Length(aba[i])));
    m:=Maximum(m, 0);
    beta:=[];
    for i in [1..e] do
      if q[i]<>[] then
        q[i]:=q[i] + Length(aba[i]) + m;
        for j in [1..Length(q[i])] do Add(beta, (q[i][j]-j)*e + i - 1); od;
      fi;
      for j in [1..Length(aba[i])+m-Length(q[i])] do
        Add(beta, (j-1)*e + i - 1);
      od;
    od;
    if Length(beta) = 0 then
      return beta;
    fi;
    Sort(beta);
    if beta[1]=0 then  ## remove irrelevant beta numbers; see ECore()
      if beta[Length(beta)]=Length(beta)-1 then return []; fi;
      m:=First([1..Length(beta)],i->beta[i]<>i-1);
      beta:=beta{[m..Length(beta)]}-m+1;
    fi;
    beta:=List([1..Length(beta)], i->beta[i]-i+1);
    return beta{[Length(beta),Length(beta)-1..1]};
 end
);

InstallMethod(
 CombineEQuotientECoreOp,
 "for an algebra, a list of partition and a partition",
 [IsAlgebraObj,IsList,IsList],
 function(H,q,c)
  return CombineEQuotientECoreOp(OrderOfQ(H),q,c);
 end
); # CombineEQuotientECoreOp

## true is arg is a ERegular partition
#F IsERegular(e,mu), IsERegular(H,mu)  -mu is a sequence or a list

InstallMethod(
 IsERegularOp,
 "for an integer and a partition",
 [IsInt,IsList],
 function(e,mu)
    if e=0 then return false;
    else ## assume that mu is ordered
      e:=e-1;
      return ForAll([1..Length(mu)-e], i->mu[i]<>mu[i+e]);
    fi;
 end
);

InstallMethod(
 IsERegularOp,
 "for an algebra and a partition",
 [IsAlgebraObj,IsList],
 function(H,mu) local e;
    e:=OrderOfQ(H);

    if e=0 then return false;
    else ## assume that mu is ordered
      e:=e-1;
      return ForAll([1..Length(mu)-e], i->mu[i]<>mu[i+e]);
    fi;
 end
); # IsERegularOp

#F list of the ERegular partitions of n
## ??? add support for e-regular partitions of length k ???
InstallMethod(
 ERegularPartitionsOp,
 "for two integers <e> and <n>",
 [IsInt,IsInt],
 function(e,n)
  if n<2 then return [ [n] ];
    elif e=0 then return Partitions(n);
    fi;

    e:=e-1;
    return Filtered(Partitions(n),p->ForAll([1..Length(p)-e], i->p[i]<>p[i+e]));
 end
);

InstallMethod(
 ERegularPartitionsOp,
 "for an algebra and an integer",
 [IsAlgebraObj,IsInt],
 function(H,n) local e;
    e:=OrderOfQ(H);

  if n<2 then return [ [n] ];
    elif e=0 then return Partitions(n);
    fi;

    e:=e-1;
    return Filtered(Partitions(n),p->ForAll([1..Length(p)-e], i->p[i]<>p[i+e]));
 end
); # ERegularPartitionsOp

#P usage: EResidueDiagram(e,mu) or EResidueDiagram(x), the second form
## returns the residue daigrams of the e-regular partitions in x
InstallMethod(
 EResidueDiagramOp,
 "for an integer and a partition",
 [IsInt,IsList],
 function(e,mu) local i, j;
    if mu=[] then Print("\n");
    else
      for i in [1..Length(mu)] do
        for j in [1..mu[i]] do
          Print(String((j-i) mod e,4));
        od;
        Print("\n");
      od;
    fi;
    return true;
 end
);

InstallMethod(
 EResidueDiagramOp,
 "for an algebra and a partition",
 [IsAlgebraObj,IsList],
 function(H,mu)
  return EResidueDiagramOp(OrderOfQ(H),mu);
 end
);

InstallMethod(
 EResidueDiagramOp,
 "for a Specht module",
 [IsHeckeSpecht],
 function(x) local e, r, rs;
    rs:=ListERegulars(x);
    e:=OrderOfQ(x);
    if rs=[] or IsInt(rs[1]) then EResidueDiagramOp(e, rs);
    else
      for r in rs do
        if r[1]<>1 then Print(r[1],"*"); fi;
        Print(r[2],"\n");
        EResidueDiagramOp(e, r[2]);
      od;
      if Length(rs) > 1 then
        Print("# There are ", Length(rs), " ", e,
                "-regular partitions.\n");
      fi;
    fi;
    return true;
 end
); # EResidueDiagramOp

#F Returns the partion obtained from mu by pushing nodes to the top
## of their e-ladders (see [JK]; there the notation is mu^R).
InstallMethod(
 ETopLadderOp,
 "for an integer and a partition",
 [IsInt,IsList],
 function(e,mu) local ladder, r, c, C, k;
    ladder:=List(mu,r->List([1..r],c->0));

    for r in [2..Length(mu)] do
      for c in [1..mu[r]] do
        k:=r-(e-1)*Int(r/(e-1));
        if k<1 then k:=k+e-1; fi;
        while k<r do
          C:=c+(r-k)/(e-1);
          if IsBound(ladder[k][C]) then k:=k+e-1;
          else
            ladder[k][C]:=0;
            Unbind(ladder[r][c]);
            k:=r;
          fi;
        od;
      od;
    od;
    return List(Filtered(ladder,r->Length(r)>0), r->Length(r));
 end
);

InstallMethod(
 ETopLadderOp,
 "for an algebra and a partition",
 [IsAlgebraObj,IsList],
 function(H,mu)
  return ETopLadderOp(OrderOfQ(H),mu);
 end
); # ETopLadderOp

#P hook lengths in a diagram mod e
## *** undocumented: useful when lookng at the q-Schaper theorem
InstallMethod(
 EHookDiagramOp,
 "for an integer and a partition",
 [IsInt,IsList],
 function(e,mu) local mud, i, j;
    mud:=ConjugatePartitionOp(mu);
    for i in [1..Length(mu)] do
      for j in [1..mu[i]] do
          Print("  ", (mu[i]+mud[j]-i-j+1) mod e);
      od;
      Print("\n");
    od;
    return true;
 end
);

InstallMethod(
 EHookDiagramOp,
 "for an algebra and a partition",
 [IsAlgebraObj,IsList],
 function(H,mu)
  return EHookDiagramOp(OrderOfQ(H),mu);
 end
); # EHookDiagramOp

#P hook length diagram
InstallMethod(
 HookLengthDiagramOp,
 "for a partition",
 [IsList],
 function(mu) local mud, i, j;
    mud:=ConjugatePartitionOp(mu);
    for i in [1..Length(mu)] do
      for j in [1..mu[i]] do
        Print(String(mu[i]+mud[j]-i-j+1, 4));
      od;
      Print("\n");
    od;
    return true;
 end
); # HookLengthDiagramOp

#F Returns the numbers of the rows which end in one of Kleshchev's
## "normal nodes" (see [LLT] or one of Kleshchev's papers for a description).
##   usage: NormalNodes(H|e, mu [,i]);
InstallMethod(
 NormalNodesOp,
 "for an integer and a partition",
 [IsInt,IsList],
 function(e,mu) local normalnodes, res, i, r;
  normalnodes:=List([1..e],i->[]);    ## will hold the normal nodes
    res:=List([1..e], i->0);          ## tally of #removable-#addable r-nodes
    for i in [1..Length(mu)] do
      r:=(mu[i]-i) mod e;
      r:=r+1;
      if i=Length(mu) or mu[i]>mu[i+1] then  ## removable r-node
        if res[r]=0 then Add(normalnodes[r],i);
        else res[r]:=res[r]+1;
        fi;
      fi;
      if r=e then r:=1; else r:=r+1; fi;
      if i=1 or mu[i]<mu[i-1] then           ## addable r-node
        res[r]:=res[r]-1;
      fi;
    od;
    return normalnodes;
 end
);

InstallMethod(
 NormalNodesOp,
 "for an algebra and a partition",
 [IsAlgebraObj,IsList],
 function(H,mu)
  return NormalNodesOp(OrderOfQ(H),mu);
 end
);

InstallMethod(
 NormalNodesOp,
 "for an integer, a partition and a residue",
 [IsInt,IsList,IsInt],
 function(e,mu,I)
    if I<0 or I>=e then
      Error("usage: NormalNodes(<e|H>, mu [, I]) where 0 <= I < e\n");
  else return NormalNodesOp(e,mu)[I+1];
    fi;
 end
);

InstallMethod(
 NormalNodesOp,
 "for an algebra, a partition and a residue",
 [IsAlgebraObj,IsList,IsInt],
 function(H,mu,I) local e;
    e:=OrderOfQ(H);
    if I<0 or I>=e then
      Error("usage: NormalNodes(<e|H>, mu [, I]) where 0 <= I < e\n");
  else return NormalNodesOp(e,mu)[I+1];
    fi;
 end
); # NormalNodesOp

## usage: RemoveNormalNodes(H|e, mu, i)
## returnsthe partition obtained from <mu> by removing all the normal
## nodes of residue <i>.
InstallMethod(
 RemoveNormalNodesOp,
 "for an integer, a partition and a residue",
 [IsInt,IsList,IsInt],
 function(e,mu,I) local res, i, r;
    if I<0 or I>=e then
      Error("usage: RemoveNormalNodes(<e|H>, mu , I) where 0 <= I < e\n");
    fi;
   mu:=StructuralCopy(mu);          ## we are going to change this so...
    res:=0;                     ## tally of #removable-#addable I-nodes
    for i in [1..Length(mu)] do
      r:=(mu[i]-i) mod e;
      if r=I and (i=Length(mu) or mu[i]>mu[i+1]) then  ## removable I-node
        if res=0 then mu[i]:=mu[i]-1;                  ## normal I-node
        else res:=res+1;
        fi;
      fi;
      if r=e then r:=1; else r:=r+1; fi;
      if r=I and (i=1 or mu[i]<mu[i-1]) then           ## addable I-node
        res:=res-1;
      fi;
    od;
    return mu;
 end
);

InstallMethod(
 RemoveNormalNodesOp,
 "for an algebra, a partition and a residue",
 [IsAlgebraObj,IsList,IsInt],
 function(H,mu,I)
  return RemoveNormalNodesOp(OrderOfQ(H),mu,I);;
 end
); # RemoveNormalNodesOp

#F Returns the numbers of the rows which end in one of Kleshchev's
## "good nodes" (see [LLT] or one of Kleshchev's papers for a description).
## Basically, reading from the top down, count +1 for a *removable* node
## of residue r and -1 for an *addable* node of residue r. The last
## removable r-node with all of these tallies strictly positive is
## the (unique) good node of residue r - should it exist.
##   usage: GoodNodes(H|e, mu [,I]);
## If <I> is supplied the number of the row containing the unique good node
## of residue I is return.
InstallMethod(
 GoodNodesOp,
 "for an integer and a partition",
 [IsInt,IsList],
 function(e,mu) local goodnodes, res, i, r;
    goodnodes:=List([1..e],i->fail); ## will hold the good nodes
    res:=List([1..e], i->0);          ## tally of #removable-#addable r-nodes
    for i in [1..Length(mu)] do
      r:=(mu[i]-i) mod e;
      r:=r+1;
      if i=Length(mu) or mu[i]>mu[i+1] then  ## removable r-node
        if res[r]=0 then goodnodes[r]:=i;
        else res[r]:=res[r]+1;
        fi;
      fi;
      if r=e then r:=1; else r:=r+1; fi;
      if i=1 or mu[i]<mu[i-1] then           ## addable r-node
        res[r]:=res[r]-1;
      fi;
    od;
    return goodnodes;
 end
);

InstallMethod(
 GoodNodesOp,
 "for an algebra and a partition",
 [IsAlgebraObj,IsList],
 function(H,mu)
  return GoodNodesOp(OrderOfQ(H),mu);
 end
);

InstallMethod(
 GoodNodesOp,
 "for an integer, a partition and a residue",
 [IsInt,IsList,IsInt],
 function(e,mu,I)
    if I<0 or I>=e then
      Error("usage: GoodNodes(<e|H>, mu [, I]) where 0 <= I < e\n");
  else return GoodNodesOp(e,mu)[I+1];
    fi;
 end
);

InstallMethod(
 GoodNodesOp,
 "for an algebra, a partition and a residue",
 [IsAlgebraObj,IsList,IsInt],
 function(H,mu,I) local e;
    e:=OrderOfQ(H);
    if I<0 or I>=e then
      Error("usage: GoodNodes(<e|H>, mu [, I]) where 0 <= I < e\n");
  else return GoodNodesOp(e,mu)[I+1];
    fi;
 end
); # GoodNodesOp

#F Given an e-regular partition mu this function returns the corresponding
## good node sequence (= path is Kleshchev's e-good partition lattice).
##   usage: GoodNodeSequence(e|H, mu);
InstallMethod(
 GoodNodeSequenceOp,
 "for an integer and a partition",
 [IsInt,IsList],
 function(e,mu) local goodnodeseq,  row, res, r;
    if not IsERegularOp(e,mu) then
      Error("GoodNodeSequence(<e>,<mu>): <mu> must be <e>-regular\n");
    fi;
    goodnodeseq:=[];
    while mu<>[] do
      row:=1;
      while row<Length(mu) and mu[row]=mu[row+1] do
        row:=row+1;      ## there is a good node with the same residue as
      od;                ## the first removable node
      r:=(mu[row]-row) mod e;
      res:=0;
      repeat
        if r=(mu[row]-row) mod e and (row=Length(mu) or mu[row]>mu[row+1])
        then
           if res=0 then
             if mu[row]=1 then Unbind(mu[row]);
             else mu[row]:=mu[row]-1;
             fi;
             Add(goodnodeseq, r);
           else res:=res+1;
           fi;
         elif r=(mu[row]+1-row) mod e and mu[row]<mu[row-1] then ## addable
           res:=res-1;
         fi;
         row:=row+1;
      until row>Length(mu);
    od;
    return goodnodeseq{[Length(goodnodeseq),Length(goodnodeseq)-1..1]};
 end
);

InstallMethod(
 GoodNodeSequenceOp,
 "for an algebra and a partition",
 [IsAlgebraObj,IsList],
 function(H,mu)
  return GoodNodeSequenceOp(OrderOfQ(H),mu);
 end
); # GoodNodeSequenceOp

#F Returns the list of all good node sequences for the partition <mu>
InstallMethod(
 GoodNodeSequencesOp,
 "for an integer and a partition",
 [IsInt,IsList],
 function(e,mu) local r, gnss, nu, s, res;
    if not IsERegularOp(e,mu) then
      Error("GoodNodeSequence(<e>,<mu>): <mu> must be <e>-regular\n");
    fi;

    if mu=[1] then gnss:=[ [0] ];
    else
      gnss:=[];
      for r in GoodNodesOp(e,mu) do
        if r<>fail then
          nu:=StructuralCopy(mu);
          nu[r]:=nu[r]-1;
          if nu[r]=0 then Unbind(nu[r]); fi;
          res:=(mu[r]-r) mod e;
          for s in GoodNodeSequencesOp(e,nu) do
            Add(s,res);
            Add(gnss, s);
          od;
        fi;
      od;
    fi;
    return gnss;
 end
);

InstallMethod(
 GoodNodeSequencesOp,
 "for an algebra and a partition",
 [IsAlgebraObj,IsList],
 function(H,mu)
  return GoodNodeSequencesOp(OrderOfQ(H),mu);
 end
); # GoodNodeSequencesOp

#F Given a good node sequence this function returns the corresponding
## partition, or fail if the sequence is not a good node sequence.
##   usage: GoodNodeSequence(H|e, gns)
InstallMethod(
 PartitionGoodNodeSequenceOp,
 "for an integer and a good node sequence",
 [IsInt,IsList],
 function(e,gns) local mu, r, i, res, row;
    mu:=[];
    for r in gns do
      row:=0;
      res:=0;
      for i in [1..Length(mu)] do
        if r=(mu[i]-i) mod e and (i=Length(mu) or mu[i]>mu[i+1]) and res<0
        then res:=res+1;
        elif r=(mu[i]+1-i) mod e and (i=1 or mu[i]<mu[i-1]) then
          if res=0 then row:=i; fi;
          res:=res-1;
        fi;
      od;
      if res=0 and r=(-Length(mu))mod e then mu[Length(mu)+1]:=1;
      elif row>0 then mu[row]:=mu[row]+1;
      else return fail;  ## bad sequence
      fi;
    od;
    return mu;
 end
);

InstallMethod(
 PartitionGoodNodeSequenceOp,
 "for an algebra and a good node sequence",
 [IsAlgebraObj,IsList],
 function(H,gns)
  return PartitionGoodNodeSequenceOp(OrderOfQ(H),gns);
 end
); # PartitionGoodNodeSequenceOp

#F GoodNodeLatticePath: returns a path in the good partition lattice
## from the empty partition to <mu>.
InstallMethod(
 GoodNodeLatticePathOp,
 "for an integer and a partition",
 [IsInt,IsList],
 function(e,mu) local gns;
   gns:=GoodNodeSequenceOp(e,mu);
    return List([1..Length(gns)],i->PartitionGoodNodeSequenceOp(e,gns{[1..i]}));
 end
);

InstallMethod(
 GoodNodeLatticePathOp,
 "for an algebra and a partition",
 [IsAlgebraObj,IsList],
 function(H,mu) local e, gns;
    e:=OrderOfQ(H);
   gns:=GoodNodeSequenceOp(e,mu);
    return List([1..Length(gns)],i->PartitionGoodNodeSequenceOp(e,gns{[1..i]}));
 end
); # GoodNodeLatticePathOp

#F GoodNodeLatticePath: returns the list of all paths in the good partition
## lattice from the empty partition to <mu>.
InstallMethod(
 GoodNodeLatticePathsOp,
 "for an integer and a partition",
 [IsInt,IsList],
 function(e,mu) local gns;
   gns:=GoodNodeSequencesOp(e,mu);
    return List(gns, g->List([1..Length(g)],
              i->PartitionGoodNodeSequenceOp(e,g{[1..i]})));
 end
);

InstallMethod(
 GoodNodeLatticePathsOp,
 "for an algebra and a partition",
 [IsAlgebraObj,IsList],
 function(H,mu) local e, gns;
    e:=OrderOfQ(H);
   gns:=GoodNodeSequencesOp(e,mu);
    return List(gns, g->List([1..Length(g)],
              i->PartitionGoodNodeSequenceOp(e,g{[1..i]})));
 end
); # GoodNodeLatticePathsOp

#F LatticePathGoodNodeSequence()
## Returns the path in the e-good partition lattice corresponding
## to the good node sequence <gns>.
InstallMethod(
 LatticePathGoodNodeSequenceOp,
 "for an integer and a good node sequence",
 [IsInt,IsList],
 function(e,gns)
    gns:=List([1..Length(gns)],i->PartitionGoodNodeSequenceOp(e,gns{[1..i]}));
    if fail in gns then return gns{[1..Position(gns,fail)]};
    else return gns;
    fi;
 end
);

InstallMethod(
 LatticePathGoodNodeSequenceOp,
 "for an algebra and a good node sequence",
 [IsAlgebraObj,IsList],
 function(H,gns) local e;
    e:=OrderOfQ(H);
    gns:=List([1..Length(gns)],i->PartitionGoodNodeSequenceOp(e,gns{[1..i]}));
    if fail in gns then return gns{[1..Position(gns,fail)]};
    else return gns;
    fi;
 end
); # LatticePathGoodNodeSequenceOp

#F returns the Mullineux symbol of the <e>-regular partition <mu>
##   usage, MullineuxSymbol(<H>|<e>, <mu>)
## the algorithms is basically to shuffle the first column hooks lengths;
## this is a reformulation of Mullineux's approach.
## e.g. if e=3 and mu=[4,3,2] then we do the following:
##    betanums =  [6, 4, 2, 0]
##             -> [4, 3, 1, 0] :6->4, 4->3 ( we want 2 but can only
##                                           remove 1 more node as e=3 )
##             -> [3, 2, 1, 0].
## To get the Mullineux symbols we record the number of beads removed at
## each stage and also the number of signiciant numbers in the previous
## beta number (i.e. the numebr of rows); here we get
##                  5, 3, 1
##                  3, 2, 1
InstallMethod(
 MullineuxSymbolOp,
 "for an integer and a partition",
 [IsInt,IsList],
 function(e,mu) local betaset, newbetaset, tally, difference,i,ms;
  if mu=[] or mu=[0] then return [ [0],[0] ];
    elif IsList(mu[1]) then mu:=mu[1];
    fi;
    betaset:=BetaSet(mu);
    ms:=[ [],[] ];
    while betaset<>[] do
      newbetaset:=StructuralCopy(betaset);
      RemoveSet(newbetaset, newbetaset[Length(newbetaset)]);
      AddSet(newbetaset,0);
      difference:=betaset-newbetaset;
      tally:=0;
      Add(ms[1], 0);
      Add(ms[2], Length(betaset));
      for i in [Length(betaset),Length(betaset)-1..1] do
        tally:=tally+difference[i];
        if tally>=e then
          newbetaset[i]:=newbetaset[i]+tally-e;
          ms[1][Length(ms[1])]:=ms[1][Length(ms[1])]+e;
          tally:=0;
        fi;
      od;
      ms[1][Length(ms[1])]:=ms[1][Length(ms[1])]+tally;
      betaset:=newbetaset;
      if not IsSet(betaset) then return fail; fi; ## can happen?
      if betaset[1]=0 then
        if betaset[Length(betaset)]=Length(betaset)-1 then
          betaset:=[];
        else
          i:=First([1..Length(betaset)], i->betaset[i]<>i-1);
          betaset:=betaset{[i..Length(betaset)]}-i+1;
        fi;
      fi;
    od;
    return ms;
 end
);

InstallMethod(
 MullineuxSymbolOp,
 "for an algebra and a partition",
 [IsAlgebraObj,IsList],
 function(H,mu)
  return MullineuxSymbolOp(OrderOfQ(H),mu);
 end
); # MullineuxSymbolOp

#F given a Mullineux Symbol <ms> and an integer <e>, return the corresponding
## <e>-regular partition.
InstallMethod(
 PartitionMullineuxSymbolOp,
 "for an integer and a mullinex symbol",
 [IsInt,IsList],
 function(e,Ms) local ms, betaset, i,tally,betaN;
    ms:=StructuralCopy(Ms);

    betaset:=[0..ms[2][1]-1];
    ms[2]:=ms[2][1]-ms[2]+1;  # significant numbers in betaset
    i:=Length(ms[1]);
    while i>0 do
      tally:=0;
      betaN:=ms[2][i];
      repeat
        if tally=0 then
          tally:=ms[1][i] mod e;
          if tally=0 then tally:=e; fi;
          ms[1][i]:=ms[1][i]-tally;
        fi;
        if betaN=Length(betaset) then
          betaset[betaN]:=betaset[betaN]+tally;
          tally:=0;
        else
          if betaset[betaN+1]-betaset[betaN]>tally then
            betaset[betaN]:=betaset[betaN]+tally;
            tally:=0;
          else
            tally:=tally-betaset[betaN+1]+betaset[betaN];
            betaset[betaN]:=betaset[betaN+1];
          fi;
        fi;
        betaN:=betaN+1;
      until (tally=0 and ms[1][i]=0) or betaN>Length(betaset);
      if tally>0 or ms[1][i]>0 then return fail; fi;
      i:=i-1;
    od; ## while
    return PartitionBetaSetOp(betaset);
 end
);

InstallMethod(
 PartitionMullineuxSymbolOp,
 "for an algebra and a mullinex symbol",
 [IsAlgebraObj,IsList],
 function(H,mu)
  return PartitionMullineuxSymbolOp(OrderOfQ(H),mu);
 end
); # PartitionMullineuxSymbolOp

#F removes the rim hook from mu which corresponding to the
## (row,cols)-th hook.
InstallMethod(
 RemoveRimHookOp,
 "for a partition, two integers and another partition",
 [IsList,IsInt,IsInt,IsList],
  function(mu,row,col,mud) local r, c, x, nx;
    mu:=StructuralCopy(mu);
    r:=mud[col];
    x:=col;
    while r >=row do
      nx:=mu[r];
      if x=1 then Unbind(mu[r]);
      else mu[r]:=x - 1;
      fi;
      x:=nx;
      r:=r - 1;
    od;
    return mu;
  end
);

InstallMethod(
 RemoveRimHookOp,
 "for a partition and two integers",
 [IsList,IsInt,IsInt],
  function(mu,row,col)
    return RemoveRimHookOp(mu,row,col,ConjugatePartitionOp(mu));
  end
); # RemoveRimHookOp

#F Returns the partition obtained from mu by adding a rim hook with
## foot in row <row>, of length of length <h>. The empty partition []
## is returned if the resulting diagram is not a partition.
InstallMethod(
 AddRimHookOp,
 "for a partition and two integers",
 [IsList,IsInt,IsInt],
  function(nu, row, h) local r;
    nu:=StructuralCopy(nu);
    r:=row;
    if r=Length(nu) + 1 then nu[r]:=0;
    elif r > Length(nu) then h:=0;
    fi;
    while r > 1 and h > 0 do
      h:=h-nu[r-1]+nu[r]-1;
      if h > 0 then
        nu[r]:=nu[r-1]+1;
        r:=r-1;
      elif h < 0 then
        nu[r]:=h+nu[r-1]+1;
      fi;
    od;
    if h > 0 then nu[1]:=nu[1] + h; r:=1;
    elif h=0 then return fail;
    fi;
    return [nu, row - r];
  end
); # AddRimHookOp


[ Dauer der Verarbeitung: 0.40 Sekunden  (vorverarbeitet)  ]

                                                                                                                                                                                                                                                                                                                                                                                                     


Neuigkeiten

     Aktuelles
     Motto des Tages

Software

     Produkte
     Quellcodebibliothek

Aktivitäten

     Artikel über Sicherheit
     Anleitung zur Aktivierung von SSL

Muße

     Gedichte
     Musik
     Bilder

Jenseits des Üblichen ....

Besucherstatistik

Besucherstatistik

Monitoring

Montastic status badge