incr-set prlevel 1
if #0>=3 START
incr-set prlevel -1
;;; Usage:
;;; 	<sagbi gens newgens sagbigens n [d1 .. dn]
;;;
;;; Given an ideal gens, the script sets 
;;; newgens to the ideal obtained by applying the
;;; <sagbi_step
;;; procedure at most n times to gens. It 
;;; sets sagbigens to a minimal set of elements 
;;; in the algebra generated by gens whose 
;;; initial terms generate the same algebra as 
;;; the initial terms of gens and newgens, combined.
;;;    If the
;;; parameters di are present they are supplied
;;; as degree bounds to the sagbi_step 
;;; algorithm.
;;;     The script halts either when n steps
;;; are completed or when a sagbi_step
;;; produces no new sagbi basis elements; in
;;; the second case (at least when no degree bounds
;;; are specified) mingens is 
;;; a minimal sagbi basis for i.
;;;      Note that each "sagbi_step" potentially
;;; produces many new sagbi basis elements.  
;;; See <sagbi_step for a discussion of
;;; the method. 
;;;
;;; References:  Galligo-Robbiano-Sweedler (?)
;;; Kapur, D., Madlener, K. (1989). A completion procedure
;;; for computing a canonical basis of a $k$-subalgebra.
;;; Proceedings of {\it Computers and Mathematics 89}
;;; (eds. Kaltofen and Watt), MIT, Cambridge, June 1989.
;;;
;;; Also
;;;
;;; Robbiano, L., Sweedler, M. (1990). Subalgebra bases,
;;; in W.~Bruns, A.~Simis (eds.): {\sl Commutative Algebra},
;;; Springer Lecture Notes in Mathematics {\bf 1430}, pp.~61--87.
;;;
incr-set prlevel 1
jump END
;;; Parameters:
;;;       gens an ideal, reprsenting generators
;;;         of a sub-algbebra of the current ring.
;;;       n an integer >= 1
;;;       d1 ... dn optional integers.  The script 
;;;          succeeds iff di is >= to the 
;;;          max degree of a sagbi basis element
;;;          present after the ith step of 
;;;          the  sagbi process called without
;;;          degree bounds
;;;
;;; Output values:
;;;         newgens, sagbigens, ideals
;;;
;;;     The last computation of each "sagbi_step"
;;; actually gives some information on the first
;;; (and by far the hardest) computation of 
;;; the next.  However, it is not carried very
;;; far, and it enables the the first computation
;;; of the next step to start with sparser data,
;;; so it doesn't seem worth combining them.
;;;
;;; Caveats:
;;;     The script prints relatively many of
;;; progress reports; if the algorithm is
;;; used much for other purposes,this should
;;; be changed.
;;;
; created June 15, 1992 DE
START:
setring #1
copy #1 @i
<ideal #2
int @reps 0

if #0>4 checkdegs

; ;;;;;;;;;;;;;;;

nodegs:
int @reps @reps+1
if @reps>#4 minimize
<sagbi_step @i @j
ncols @j @numnew

if @numnew>0 continue1
shout echo sagbi basis completed at repetition #
shout type @reps
jump minimize

continue1:
concat @i @j
concat #2 @j
jump nodegs

; ;;;;;;;;;;;;;;;;;;;;;
checkdegs:
;check to see whether there are the right 
;number of degrees given.
if (#0-#4)=4 degs
shout echo You specified degrees, but not 
shout echo the same number as repetitions.
jump END
degs:
int @reps @reps+1
if @reps>#4 minimize
int @spot 4+(@reps)
int @degbnd #(@spot)
<sagbi_step @i @j @degbnd
ncols @j @numnew

if @numnew>0 continue2
shout echo sagbi basis completed at repetition #
shout type @reps
jump minimize

continue2:
concat @i @j
concat #2 @j
jump degs

; ;;;;;;;;;;;;;;;;;;;;;;;
;NOTE the following section is optimal.  If we were
;willing to settle for a nonminimal sagbi basis we
;could replace it by
;copy @i #3

minimize:
; Next replace @i by a minimal system whose
;initial forms generate the same subring.

shout echo starting to minimize generators of degrees
shout col-degs @i

in @i @ii 

ncols @ii @nvars
col-degs @ii @degs

ring @s
;
@nvars
A[1]-A[@nvars]
@degs
;
;
ring-sum #1 @s @t
fetch @ii @ii
fetch @s @svars
subtract @svars @ii @diffs

;To eliminate the extra generators that occur
;linearly in a relation, we only need to compute
;the relations up to the max degree of a 
;generator!
max @degs @max
set autocalc 1
set autodegree @max
shout std @diffs @diffs
set autocalc -1

elim @diffs @relns1
setring @s
fetch @relns1 @relns1

;find which variables occur linearly
;(if there's a difference of two, we'll
;want to eliminate just 1, etc)
contract @s @relns1 @trash
<zeromat 1 @nvars @zeros
ev @zeros @trash @trash
mult @s @trash @trash
;now trash contains just the linear terms of 
;the relns

std @trash @trash

;Make a minimized list of the variables that span, mod
;the trash
reduce @trash @s @min
set autocalc 1
set autodegree @max
std @min @min
set autocalc -1

ev @i @min #3

; ;;;;;;;;;;;;;;;;;

report:
shout echo sagbi basis has elements of degrees
shout col-degs #3
shout type #3

;(clean up code)
END:
incr-set prlevel -1

$;;;;;;;; EXAMPLE SECTION ;;;;;;;;;;;;;;;;;;;;;;;;;
reset
;symmetric functions of deg 3
<ring 3 a-z r
<ideal sym a+b+c a2+b2+c2 a3+b3+c3

<sagbi sym newsym sagbigens 3 3 3 3
betti newsym

;symmetric functions of deg 4
<ring 4 a-z r
<ideal sym a+b+c+d a2+b2+c2+d2 a3+b3+c3+d3 a4+b4+c4+d4
<sagbi sym newsym sagbigens 4


; 2x2 minors of a generic 3x3 mat
<ring 9 x[1,1]-x[3,3] r
<generic_mat x[1,1] 3 3 m
type m
; x[1,1] x[1,2] x[1,3] 
; x[2,1] x[2,2] x[2,3] 
; x[3,1] x[3,2] x[3,3] 
wedge m 2 m2
flatten m2 m2
<sagbi m2 n sagbigens 2


; 2x2 minors of a generic 3x4 mat
<ring 12 x[1,1]-x[3,4] r
<generic_mat x[1,1] 3 4 m
type m
wedge m 2 m2
flatten m2 m2
<sagbi m2 n sagbigens 3 4 4 4  ;this is the optimal bound

; now the example Bernd and I computed.  The
;"symmetric" quadratic artin ideal in 2x3 vars
<ring 6 a-z r
<ideal i a  b c
power i 2 i
<ideal i2 d e f
power i2 2 i2
<ideal i3 a+d b+e c+f
power i3 2 i3
concat i i2 i3
std i i
type i
<sagbi i new I 2 5 5
type I
; a2 ab ac b2 bc c2 d2 de df e2 ef f2 ad 
; bd+ae cd+af be ce+bf cf 
; bf3 af3 -aef2 
; ae2f ae3 -b3f -ab2f -2a2bf -a3f -a3e 


