##########
# File @(#) ListTab (TAB PACKAGE) Tue Jan  9 16:45:39 MET 1996
##########
interface(verboseproc=0);
#
# ListTab(shape, comp) builds the list of all tableaux of a given shape
#                      and a given evaluation comp (composition).
#                      If comp is increasing then it is more efficient.
#                      One can also give a tableau (list of lists in fact)
#                      describing minimal entries in the result
#                      (mintab=[[-infinity, 5], [1,6]] for instance).
#
#                      construit la liste de tous les tableaux d'une forme
#                      shape donnee et d'evaluation comp donnee (composition).
#                      Si comp est croissante, c'est plus efficace.
#                      On peut aussi specifier un tableau (liste de listes
#                      en fait) decrivant les entrees minimales dans le
#                      resultat (mintab=[[-infinity, 5], [1,6]] par exemple).
#
# Remarque: je pense qu'il y a moyen de faire la construction directe du
# tableau (et non pas de la matrice de 0 et 1 puis de la matrice au sens
# du tableau en deux dimensions puis du tableau code par ligne) car avec
# les longueurs de chaque ligne du tableau, on doit pouvoir savoir  sans
# difficulte la place des lettres que l'on vient de rajouter...a voir...
#
# SV090196 SV140196 SV220497
`TAB/NbTab/rec`:=proc(conjs, comp, ininconjs, inincomp)
  local
    res,    # the result...
    ncomp,  # nops(comp)...
    nconjs; # nops(conjs)...
  # this option remember implies to put a map(copy, recursive call)
  # at the end of the function. Otherwise it does not work because
  # all matrices are the same at the end...
  # option remember;
  # in fact, sometimes conjs, comp are the same for some ininconjs, inincomp
  # different so we manage ourselves the remember table...
  if (op(4, op(procname))<>NULL) then
    if (assigned(op(4, op(procname))[conjs, comp])) then
      RETURN(op(4, op(procname))[conjs, comp])
    fi
  fi;
  ncomp:=nops(comp);
  nconjs:=nops(conjs);
  if (comp[1]>nconjs) then
    res:=0;
    `TAB/NbTab/rec`(conjs, comp):=res;
    res
  else
    if (ncomp=1) then
      res:=1;
      `TAB/NbTab/rec`(conjs, comp):=res;
      res
    else
      res:=convert(map(proc(v, conjs, nconjs, newcomp, ncomp,
                                         ininconjs, inincomp)
                         local i, j, newconjs;
                         newconjs:=[seq(conjs[i]-v[i], i=1..nconjs)];
                         if (newconjs[1]=-1) then
                           0
                         else
                           for j from 2 to nconjs do
                             if ((newconjs[j]>newconjs[j-1]) or
                                 (newconjs[j]=-1)) then
                               RETURN(0)
                             fi
                           od;
                           # newconjs is a partition with eventually some
                           # 0's at the end...
                           `TAB/NbTab/rec`(subs(0=NULL, newconjs),
                                           newcomp, ininconjs, inincomp)
                         fi
                       end, `SG/ListPerm`([1$comp[1],0$(nconjs-comp[1])]),
                       conjs, nconjs, [op(2..ncomp, comp)],
                       ncomp, ininconjs, inincomp), `+`);
      `TAB/NbTab/rec`(conjs, comp):=res;
      res
    fi
  fi
end;
#
# SV190597
`TAB/NbTab/elem`:=proc(shape, comp)
  local
    i,     # variable for sequence...
    res,   # the result...
    conjs; # conjugate shape...
  if (convert(shape, `+`)<>convert(comp, `+`)) then
    0
  else
    if (shape=[]) then
      # comp=[] because of the previous test...
      1
    else
      # both shape and comp are not empty...
      conjs:=`PART/Part2Conjugate`(shape);
      if (nargs=3) then
        res:=`TAB/NbTab/rec`(conjs, [seq(comp[-i], i=-nops(comp)..-1)],
                             nops(conjs), nops(comp));
        forget(`TAB/NbTab/rec`);
      else
        # we do not forget the result because an internal function
        # needs to remember. Moreover, this internal function will
        # forget at the end (cf. SYMF/s2m)...
        res:=`TAB/NbTab/rec`(conjs, [seq(comp[-i], i=-nops(comp)..-1)],
                             nops(conjs), nops(comp))
      fi;
      res
    fi
  fi
end;
#
# SV190597
`TAB/NbTab`:=proc(shape, evalu)
  `TAB/NbTab/elem`(shape, subs(0=NULL, evalu), args[3..nargs])
end;
#
# SV090196 SV140196 SV220497 SV071197
`TAB/NbTab/mintab/rec`:=proc(conjs, comp, ininconjs, inincomp, mmini)
  local
    i,      # variable for loop...
    res,    # the result...
    ncomp,  # nops(comp)...
    nconjs; # nops(conjs)...
  # this option remember implies to put a map(copy, recursive call)
  # at the end of the function. Otherwise it does not work because
  # all matrices are the same at the end...
  # option remember;
  # in fact, sometimes conjs, comp are the same for some ininconjs, inincomp
  # different so we manage ourselves the remember table...
  if (op(4, op(procname))<>NULL) then
    if (assigned(op(4, op(procname))[conjs, comp, mmini])) then
      RETURN(op(4, op(procname))[conjs, comp, mmini])
    fi
  fi;
  ncomp:=nops(comp);
  nconjs:=nops(conjs);
  if (comp[1]>nconjs) then
    res:=0;
    `TAB/NbTab/mintab/rec`(conjs, comp, mmini):=res;
    res
  else
    if (ncomp=1) then
      for i from 1 to comp[1] do
        if (1<mmini[inincomp, i]) then
          res:=0;
          `TAB/NbTab/mintab/rec`(conjs, comp, mmini):=0;
          RETURN(res)
        fi
      od;
      res:=1;
      `TAB/NbTab/mintab/rec`(conjs, comp, mmini):=res;
      res
    else
      res:=convert(map(proc(v, conjs, nconjs, newcomp, ncomp,
                                         ininconjs, inincomp, mmini)
                         local i, j, newconjs;
                         newconjs:=[seq(conjs[i]-v[i], i=1..nconjs)];
                         if (newconjs[1]=-1) then
                           0
                         else
                           for i from 1 to nops(v) do
                             if (v[i]=1) then
                               if (ncomp<mmini[inincomp+1-conjs[i],i]) then
                                 RETURN(0)
                               fi;
                             fi
                           od;
                           for j from 2 to nconjs do
                             if ((newconjs[j]>newconjs[j-1]) or
                                 (newconjs[j]=-1)) then
                               RETURN(0)
                             fi
                           od;
                           # newconjs is a partition with eventually some
                           # 0's at the end...
                           `TAB/NbTab/mintab/rec`(subs(0=NULL, newconjs),
                                           newcomp, ininconjs, inincomp, mmini)
                         fi
                       end, `SG/ListPerm`([1$comp[1],0$(nconjs-comp[1])]),
                       conjs, nconjs, [op(2..ncomp, comp)],
                       ncomp, ininconjs, inincomp, mmini), `+`);
      `TAB/NbTab/mintab/rec`(conjs, comp, mmini):=res;
      res
    fi
  fi
end;
#
# SV190597 SV071197
`TAB/NbTab/mintab/elem`:=proc(shape, comp, mmini)
  local
    i,     # variable for sequence...
    res,   # the result...
    conjs; # conjugate shape...
  if (convert(shape, `+`)<>convert(comp, `+`)) then
    0
  else
    if (shape=[]) then
      # comp=[] because of the previous test...
      1
    else
      # both shape and comp are not empty...
      conjs:=`PART/Part2Conjugate`(shape);
      if (nargs=4) then
        res:=`TAB/NbTab/mintab/rec`(conjs, [seq(comp[-i], i=-nops(comp)..-1)],
                             nops(conjs), nops(comp), mmini);
        forget(`TAB/NbTab/mintab/rec`);
      else
        # we do not forget the result because an internal function
        # needs to remember. Moreover, this internal function will
        # forget at the end (cf. SYMF/s2m)...
        res:=`TAB/NbTab/mintab/rec`(conjs, [seq(comp[-i], i=-nops(comp)..-1)],
                             nops(conjs), nops(comp), mmini)
      fi;
      res
    fi
  fi
end;
#
# SV190597 SV071197 SV130800
`TAB/NbTab/mintab`:=proc(shape, evalu, mini)
  local
    nmini, # new mini...
    mmini, # matrix mini...
    v,     # a vector...
    i,     # variable for loop...
    j,k,   # variables for sequence...
    dec,   # a counter...
    cnt,   # another counter...
    seqs;  # sequence for substitution...
  v:=subs(0=NULL, evalu);
  dec:=nops(evalu)-nops(v);
  if (shape<>[]) then
    nmini:=[op(1..nops(v),
            [seq([seq(-infinity, k=1..nops(op(1, shape)))],
            j=1..nops(v)-nops(op(2, mini))),
            op(op(2, mini))])];
    nmini:=map(proc(l, n) local i;
                   if (nops(l)<n) then
                     [op(l), seq(-infinity, i=1..n-nops(l))]
                   else
                     [op(1..n, l)]
                   fi
                 end, nmini, op(1, shape));
    mmini:=linalg['matrix'](nops(v), op(1, shape), nmini);
  else
    mmini:=linalg['matrix'](1,1,[[-infinity]])
  fi;
  if (dec=0) then
    if (nargs=4) then
      `TAB/NbTab/mintab/elem`(shape, v, mmini, args[4]);
    else
      `TAB/NbTab/mintab/elem`(shape, v, mmini);
    fi
  else
    seqs:=NULL;
    cnt:=1;
    for i from 1 to nops(evalu) do
      if (evalu[i]<>0) then
        seqs:=seqs, i=cnt;
        cnt:=cnt+1
      else
        seqs:=seqs, i=-infinity
      fi
    od;
    mmini:=subs({seqs}, eval(mmini));
    if (nargs=4) then
      `TAB/NbTab/mintab/elem`(shape, v, mmini, args[4]);
    else
      `TAB/NbTab/mintab/elem`(shape, v, mmini);
    fi
  fi
end;
#
# SV080196 SV220497
`TAB/ListTab/rec`:=proc(conjs, comp, ininconjs, inincomp)
  local
    k,      # variable for sequence...
    ncomp,  # nops(comp)...
    nconjs; # nops(conjs)...
  # this option remember implies to put a map(copy, recursive call)
  # at the end of the function. Otherwise it does not work because
  # all matrices are the same at the end...
  option remember;
  ncomp:=nops(comp);
  nconjs:=nops(conjs);
  if (comp[1]>nconjs) then
    []
  else
    if (ncomp=1) then
      [linalg['matrix'](inincomp, ininconjs,
             [seq(0, k=1..(inincomp-1)*ininconjs),
              seq(1, k=1..comp[1]),
              seq(0, k=1..(ininconjs-comp[1]))])]
    else
      map(proc(v, conjs, nconjs, newcomp, ncomp, ininconjs, inincomp)
            local i, j, newconjs;
            newconjs:=[seq(conjs[i]-v[i], i=1..nconjs)];
            if (newconjs[1]=-1) then
              NULL
            else
              for j from 2 to nconjs do
                if ((newconjs[j]>newconjs[j-1]) or (newconjs[j]=-1)) then
                  RETURN(NULL)
                fi
              od;
              # newconjs is a partition with eventually some 0's at the end...
              op(map(proc(m, v, nconjs, ncomp, ininconjs, inincomp) local i;
                    for i from 1 to nconjs do
                      m[inincomp+1-ncomp,i]:=v[i]
                    od;
                    m
                 end, map(copy, `TAB/ListTab/rec`(subs(0=NULL, newconjs),
                      newcomp, ininconjs, inincomp)),
                      v, nconjs, ncomp, ininconjs, inincomp))
            fi
          end, `SG/ListPerm`([seq(1, k=1..comp[1]),
                              seq(0, k=1..(nconjs-comp[1]))]),
               conjs, nconjs, [op(2..ncomp, comp)], ncomp, ininconjs, inincomp)
    fi
  fi
end;
#
# SV080196 SV160496 SV220497
`TAB/ListTab/elem`:=proc(shape, comp)
  local
    i,     # variable for sequence...
    res,   # the result...
    conjs; # conjugate shape...
  if (convert(shape, `+`)<>convert(comp, `+`)) then
    []
  else
    if (shape=[]) then
      # comp=[] because of the previous test...
      [[]]
    else
      # both shape and comp are not empty...
      conjs:=`PART/Part2Conjugate`(shape);
      # we conjugate the shape and compute the mirror image of
      # the evaluation because it is useful for the recursive call...
      res:=map(proc(mat01, nconjs, ncomp) local m, c, r, deb, k;
                 m:=linalg['matrix'](ncomp, nconjs,
                                     [seq(` `, k=1..ncomp*nconjs)]);
                 for c from 1 to nconjs do
                   deb:=ncomp;
                   r:=deb;
                   while ((deb<>0) and (r<>0)) do
                     while ((mat01[r, c]=0)) do
                       r:=r-1; if (r=0) then break fi
                     od;
                     if (r=0) then
                       deb:=0
                     else
                       m[deb, c]:=ncomp+1-r;
                       r:=r-1;
                       deb:=deb-1
                     fi
                   od
                 od;
                 subs([]=NULL, `TAB/Mat2Tab`(m))
               end, `TAB/ListTab/rec`(conjs,
                                      [seq(comp[-i], i=-nops(comp)..-1)],
                                      nops(conjs), nops(comp)),
                                      nops(conjs), nops(comp));
      forget(`TAB/ListTab/rec`);
      res
    fi
  fi
end;
#
# SV080196 SV220497 SV071197
`TAB/ListTab/mintab/rec`:=proc(conjs, comp, ininconjs, inincomp, mmini)
  local
    i,      # variable for loop...
    k,      # variable for sequence...
    ncomp,  # nops(comp)...
    nconjs; # nops(conjs)...
  # this option remember implies to put a map(copy, recursive call)
  # at the end of the function. Otherwise it does not work because
  # all matrices are the same at the end...
  option remember;
  ncomp:=nops(comp);
  nconjs:=nops(conjs);
  if (comp[1]>nconjs) then
    []
  else
    if (ncomp=1) then
      for i from 1 to comp[1] do
        if (1<mmini[inincomp, i]) then
          RETURN([])
        fi
      od;
      [linalg['matrix'](inincomp, ininconjs,
             [seq(0, k=1..(inincomp-1)*ininconjs),
              seq(1, k=1..comp[1]),
              seq(0, k=1..(ininconjs-comp[1]))])]
    else
      map(proc(v, conjs, nconjs, newcomp, ncomp, ininconjs, inincomp, mmini)
            local i, j, newconjs;
            newconjs:=[seq(conjs[i]-v[i], i=1..nconjs)];
            if (newconjs[1]=-1) then
              NULL
            else
              for i from 1 to nops(v) do
                if (v[i]=1) then
                  if (ncomp<mmini[inincomp+1-conjs[i],i]) then
                    RETURN(NULL)
                  fi;
                fi
              od;
              for j from 2 to nconjs do
                if ((newconjs[j]>newconjs[j-1]) or (newconjs[j]=-1)) then
                  RETURN(NULL)
                fi
              od;
              # newconjs is a partition with eventually some 0's at the end...
              op(map(proc(m, v, nconjs, ncomp, ininconjs, inincomp) local i;
                    for i from 1 to nconjs do
                      m[inincomp+1-ncomp,i]:=v[i]
                    od;
                    m
                 end, map(copy,
                      `TAB/ListTab/mintab/rec`(subs(0=NULL, newconjs),
                      newcomp, ininconjs, inincomp, mmini)),
                      v, nconjs, ncomp, ininconjs, inincomp))
            fi
          end, `SG/ListPerm`([seq(1, k=1..comp[1]),
                              seq(0, k=1..(nconjs-comp[1]))]),
               conjs, nconjs, [op(2..ncomp, comp)], ncomp,
               ininconjs, inincomp, mmini)
    fi
  fi
end;
#
# Tableaux generators with minimal entries given in the matrix mmini...
#
# SV080196 SV160496 SV220497 SV071197
`TAB/ListTab/mintab/elem`:=proc(shape, comp, mmini)
  local
    i,     # variable for sequence...
    res,   # the result...
    conjs; # conjugate shape...
  if (convert(shape, `+`)<>convert(comp, `+`)) then
    []
  else
    if (shape=[]) then
      [[]]
    else
      conjs:=`PART/Part2Conjugate`(shape);
      res:=map(proc(mat01, nconjs, ncomp) local m, c, r, deb, k;
                 m:=linalg['matrix'](ncomp, nconjs,
                                     [seq(` `, k=1..ncomp*nconjs)]);
                 for c from 1 to nconjs do
                   deb:=ncomp;
                   r:=deb;
                   while ((deb<>0) and (r<>0)) do
                     while ((mat01[r, c]=0)) do
                       r:=r-1; if (r=0) then break fi
                     od;
                     if (r=0) then
                       deb:=0
                     else
                       m[deb, c]:=ncomp+1-r;
                       r:=r-1;
                       deb:=deb-1
                     fi
                   od
                 od;
                 subs([]=NULL, `TAB/Mat2Tab`(m))
               end, `TAB/ListTab/mintab/rec`(conjs,
                                      [seq(comp[-i], i=-nops(comp)..-1)],
                                      nops(conjs), nops(comp), mmini),
                                      nops(conjs), nops(comp));
      forget(`TAB/ListTab/mintab/rec`);
      res
    fi
  fi
end;
#
# SV160496 SV220497 SV071197 SV130800
`TAB/ListTab/mintab`:=proc(shape, evalu, mini)
  local
    nmini, # new mini...
    mmini, # matrix mini...
    res,   # the result...
    v,     # a vector...
    i,     # variable for loop...
    j,k,   # variables for sequence...
    dec,   # a counter...
    cnt,   # another counter...
    seqs,  # sequence for substitution...
    val;   # a value...
  v:=subs(0=NULL, evalu);
  dec:=nops(evalu)-nops(v);
  if (shape<>[]) then
    nmini:=[op(1..nops(v),
            [seq([seq(-infinity, k=1..nops(op(1, shape)))],
            j=1..nops(v)-nops(op(2, mini))),
            op(op(2, mini))])];
    nmini:=map(proc(l, n) local i;
                   if (nops(l)<n) then
                     [op(l), seq(-infinity, i=1..n-nops(l))]
                   else
                     [op(1..n, l)]
                   fi
                 end, nmini, op(1, shape));
    mmini:=linalg['matrix'](nops(v), op(1, shape), nmini);
  else
    mmini:=linalg['matrix'](1,1,[[-infinity]])
  fi;
  if (dec=0) then
    `TAB/ListTab/mintab/elem`(shape, v, mmini);
  else
    seqs:=NULL;
    cnt:=1;
    for i from 1 to nops(evalu) do
      if (evalu[i]<>0) then
        seqs:=seqs, i=cnt;
        cnt:=cnt+1
      else
        seqs:=seqs, i=-infinity
      fi
    od;
    mmini:=subs({seqs}, eval(mmini));
    res:=`TAB/ListTab/mintab/elem`(shape, v, mmini);
    for i from nops(evalu) by -1 to 1 do
      if (evalu[i]=0) then
        dec:=dec-1
      else
        val:=i-dec;
        res:=subs(val=i, res)
      fi
     od;
    res
  fi
end;
#
# SV240497 SV071197
`TAB/ListTab/interface`:=proc(shape, evalu)
  if (nargs=3 or nargs=4) then
    if (args[3]='nb') then
      if (nargs=4) then
        if (type(args[4], `=`)) then
          `TAB/NbTab/mintab`(args[1..2], args[4]);
        else
          # this is the case for instance in SYMF/s2m where
          # args[4] = `dontforget`...
          `TAB/NbTab`(args);
        fi
      else
        `TAB/NbTab`(args);
      fi
    else
      if (nargs=4) then
        `TAB/NbTab/mintab`(args);
      else
        `TAB/ListTab/mintab`(args);
      fi
    fi
  else
    `TAB/ListTab`(args);
  fi
end;
#
# This is the same function but for the TAB package so that it provides
# some verifications on the arguments.
#
# SV090196 SV160496
`TAB/ListTab/check`:=proc(shape, comp)
  local
    tab,  # a tableau...
    i, j; # variables for loop...
  # checking types...
  if (not TYP['IsPart'](shape)) then
    ERR['TABPerror'](1,procname)
  fi;
  if (not type(comp, list)) then
    ERR['TABPerror'](3,procname)
  fi;
  for i from 1 to nops(comp) do
    if (not type(comp[i], nonnegint)) then
      ERR['TABPerror'](4,procname)
    fi
  od;
  if (nargs=3 or nargs=4) then
    if (type(args[3], symbol)) then
      if (args[3]<>'nb') then
        ERR['TABPerror'](6,procname)
      fi
    elif (type(args[3],`=`)) then
      if (type(op(1, args[3]), symbol)) then
        if (op(1, args[3])<>'mintab') then
          ERR['TABPerror'](6,procname)
        fi;
        tab:=op(2, args[3]);
        if (not type(tab, list)) then
          ERR['TABPerror'](6,procname)
        fi;
        for i from 1 to nops(tab) do
          if (not type(op(i, tab), list)) then
            ERR['TABPerror'](6,procname)
          fi;
        od
      fi
    else
      ERR['TABPerror'](5,procname)
    fi;
    if (nargs=4) then
      if (type(args[4], symbol)) then
        if (args[4]<>'nb') then
          ERR['TABPerror'](8,procname)
        fi
      elif (type(args[4],`=`)) then
        if (type(op(1, args[4]), symbol)) then
          if (op(1, args[4])<>'mintab') then
            ERR['TABPerror'](8,procname)
          fi;
          tab:=op(2, args[4]);
          if (not type(tab, list)) then
            ERR['TABPerror'](8,procname)
          fi;
          for i from 1 to nops(tab) do
            if (not type(op(i, tab), list)) then
              ERR['TABPerror'](8,procname)
            fi;
          od
        fi
      else
        ERR['TABPerror'](7,procname)
      fi;
    fi;
  elif (nargs<>2) then
    ERR['TABPerror'](9,procname)
  fi;
end;
#
# SV160497
`TAB_PACK/ListTab`:=proc(shape, comp)
  `TAB/ListTab/check`(args);
  `TAB/ListTab/interface`(args)
end;
#
save `TAB/NbTab/rec`,
     `TAB/NbTab/elem`,
     `TAB/NbTab`,
     `TAB/NbTab/mintab/rec`,
     `TAB/NbTab/mintab/elem`,
     `TAB/NbTab/mintab`,
     `TAB/ListTab/rec`,
     `TAB/ListTab/elem`,
     `TAB/ListTab/mintab/rec`,
     `TAB/ListTab/mintab/elem`,
     `TAB/ListTab/mintab`,
     `TAB/ListTab/interface`,
     `TAB/ListTab/check`,
     `TAB_PACK/ListTab`,
     ``.TABLib.`/TAB/src/ListTab.m`;
# savelib(`TAB/NbTab/rec`, `TAB/NbTab/rec.m`);
# savelib(`TAB/NbTab/elem`, `TAB/NbTab/elem.m`);
# savelib(`TAB/NbTab`, `TAB/NbTab.m`);
# savelib(`TAB/NbTab/mintab/rec`, `TAB/NbTab/mintab/rec.m`);
# savelib(`TAB/NbTab/mintab/elem`, `TAB/NbTab/mintab/elem.m`);
# savelib(`TAB/NbTab/mintab`, `TAB/NbTab/mintab.m`);
# savelib(`TAB/ListTab/rec`, `TAB/ListTab/rec.m`);
# savelib(`TAB/ListTab/elem`, `TAB/ListTab/elem.m`);
# savelib(`TAB/ListTab/mintab/rec`, `TAB/ListTab/mintab/rec.m`);
# savelib(`TAB/ListTab/mintab/elem`, `TAB/ListTab/mintab/elem.m`);
# savelib(`TAB/ListTab/mintab`, `TAB/ListTab/mintab.m`);
# savelib(`TAB/ListTab/interface`, `TAB/ListTab/interface.m`);
# savelib(`TAB/ListTab/check`, `TAB/ListTab/check.m`);
# savelib(`TAB_PACK/ListTab`, `TAB_PACK/ListTab.m`);
if (not assigned(_NOQUIT)) then quit; fi;