ytableau.mac

/* Copyright (C) 2013 by Alessandro Campagni */

/*
 * This file is part of YoungTableaux.                                        
 *     YoungTableau is free software: you can redistribute it and/or modify   
 *     it under the terms of the GNU General Public License as published by   
 *     the Free Software Foundation, either version 3 of the License, or      
 *     (at your option) any later version.                                    
 *                                                                            
 *     YoungTableaux is distributed in the hope that it will be useful,       
 *     but WITHOUT ANY WARRANTY; without even the implied warranty of         
 *     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the          
 *     GNU General Public License for more details.                           
 *                                                                            
 *     You should have received a copy of the GNU General Public License      
 *     along with YoungTableaux.  If not, see <http://www.gnu.org/licenses/>.
 *
 *
 * Author: Alessandro Campagni <alessandro@lilik.it>
 */

defstruct (ytableau (word));

new_ytableau_safe (l) := block (
  [w],
  w : ytableauwordp (l),
  yt : false,
  if listp (w) then yt : new (ytableau (w)),
  yt);

/* let's check if the list w is a suitable word for some tableau */
ytableauwordp (w) :=
if listp (w) then block (
  rows : makelist (),
  for i:1 unless emptyp (w) do block (
    top : pop (w),
    /* errcatch returns an empty list in case of error, so */
    /* if some rows exist we get the list containing a list which represents */
    /* the last row, if rows is empty we get an empty list (i.e. a new row!) */
    lastrow : errcatch (backpop (rows)),
    /* print (lastrow), */
    if not emptyp (lastrow) then lastrow : first (lastrow),
    /* print (lastrow), */
    if top >>= lastrow then block (
      lastrow : append (lastrow, makelist (top)),
      rows : append (rows, makelist (lastrow)))
    else block (
      rows : append (rows, makelist (lastrow)),
      rows : append (rows, makelist (makelist (top))))),
  if rows = sort (rows, 'lengthlessp) then rows
  else false
) else false;

ytableaup (t) :=
if listp (t@word) then block (
  [l,w],
  l : makelist (),
  for i : 1 thru length (t@word) do
  if listp (t@word[i]) then l : append (l, t@word[i]),
  w : ytableauwordp (l),
  if listp (w) then return (true))
else false;

ytableau_bump (T, x) := block (
  appended : false,
  for i : length (T@word) step -1 while (i > 0 and not appended) do block (
    bumped : false,
    if x < last (T@word[i]) then block (
      for j : 1 unless (j>length (T@word[i])) or bumped do
      if x < (T@word[i])[j] then block (
        tmp : x,
        x : (T@word[i])[j],
        (T@word[i])[j] : tmp,
        bumped : true))
    else block (
      T@word[i] : append (T@word[i], [x]),
      appended : true)),
  if not appended then block ( 
    w : T@word,
    T@word : push ([x], w)),
  return (T));

ytableaux_product (T,U) := block (
  /* WARNING! R : T creates a reference to T, not a copy! */
  R : new (ytableau (copylist (T@word))), /* we return a new tableau R = T*U */
  for i : 1 thru length (U@word) do
  for j : 1 thru length (U@word[i]) do ytableau_bump (R, U@word[i][j]),
  return (R));

/* The transpose of a tableau need not to be a tableau, so we're */
/* using simple lists instead of tableaux. Input list should be */
/* a list of lists. */
/* l should be [] */
remove_tableau_column (t, l) :=
if emptyp (t) then return (l)
else block (
  [current_line, next_t],
  current_line : reverse (maplist (lambda ([x], first (x)), t)),
  next_t : maplist (lambda ([x], rest (x, 1)), t),
  next_t : delete ([], next_t),
  return (remove_tableau_column (next_t, append ([current_line], l))));

ytableau_transpose (T) := remove_tableau_column (T@word, []);