Sorry, here are the files:
--- burge.max ----
Burge(TA) := Burgeaux(TA[1],TA[2],[],[]);
Burgeaux(TA1,TA2,t1,t2) :=
IF Length(TA1)=0
THEN [t1, t2]
ELSE Block([res],res:Insert(First(TA2),t1),
Burgeaux(Rest(TA1),Rest(TA2),First(res),
Place(First(TA1),t2,Last(res))));
Place(e,t,c):=IF c=Length(t)+1 THEN EndCons([e],t)
ELSE SubstInPart(EndCons(e,t[c]),t,c);
/* Insert performs column bumping as follows:
Let c=1
While c<=Length(t) Do
If Last(t[c]) > e
then find the first entry e_new >= e in t[c]
replace e_new in t[c] by e
increase c by 1, let e=e_new
else append e to column c of t
stop
end while
Its return value is [new tableau, column where last bumping occurred]
*/
Insert(e,t) := Insertaux(e,t,1,Length(t)+1);
Insertaux(e,t,c,l):=
IF c=l
THEN [EndCons([e],t),l]
ELSE Block([p],p:Position(e,t[c],lambda([e,f],e<=f)),
IF p=Length(t[c])+1
THEN [SubstInPart(EndCons(e,t[c]),t,c),c]
ELSE Insertaux(t[c][p],SubstInPart(e,t,c,p),c+1,l));
/* Position(element,list,test:e,f->[T,F]) gives the first index i such that
test(e,l[i]) is true, otherwise Length(l)+1 */
Position(e, l, test) := BLOCK([len], len:Length(l)+1,
FOR i:1 THRU len
DO IF i=len or Apply(test, [e,l[i]])
THEN return(i));
--- burge.lisp ----
(defun mlist2list (l) (cond ((atom l) l)
(T (mapcar 'mlist2list (cdr l)))))
(defun list2mlist (l) (cond ((atom l) l)
(T (cons '(mlist) (mapcar 'list2mlist l)))))
(defun $BURGE (TA) (list2mlist (Burge (mlist2list TA))))
(defun Burge (TA)
(Burgeaux (car TA) (cadr TA) nil nil))
(defun Burgeaux (TA1 TA2 tx1 tx2)
(Cond ((Null TA1) (list tx1 tx2))
(T (let ((res (insert (car TA2) tx1)))
(Burgeaux (cdr TA1) (cdr TA2) (car res)
(Place (car TA1) tx2 (cadr res)))))))
;/* Place e at the end of column c of tx
; tx may be destroyed */
(defun Place (e tx c)
(cond ((= c (Length tx)) (nconc tx (list (list e))))
(T (setf (nth c tx)
(nconc (nth c tx) (list e))) tx)))
;/* Insert performs column bumping as follows:
; Let c=0
; While c<=Length(tx) Do
; If Last(tx[c]) > e
; then find the first entry e_new >= e in tx[c]
; replace e_new in tx[c] by e
; increase c by 1, let e=e_new
; else append e to column c of tx
; stop
; end while
;
; Its return value is (new tableau, column where last bumping occurred)
;*/
(defun Insert (e tx)
+ (Insertaux e tx 0 (Length tx)))
(defun Insertaux (e tx c l)
(cond ((= c l) (list (nconc tx (list (list e))) l))
(T (let ((p (position-if #'(lambda (f) (<= e f)) (nth c tx))))
(cond (p (Insertaux (nth p (nth c tx))
(progn (setf (nth p (nth c tx)) e) tx)
(1+ c) l))
(T (progn (nconc (nth c tx) (list e))
(list tx c))))))))