incr-set prlevel 1
if #0>=3 START
incr-set prlevel -1
;;; Usage:
;;;     <sat I J K [iterative]
;;;
;;; This script computes K = (I:J^*) 
;;;	by the "rational normal" method.  If no 4th argument
;;; appears, it uses the method of Bayer's thesis; if
;;; there is a 4th argument, it iteratively computes the 
;;; quotient (in which case the answer comes with a standard
;;; basis computed.)  The first method is well-suited to the
;;; case where J is generated by few forms of low degree, and
;;; where quotient might take many iterations. The iterative
;;; method is sometimes faster in the contrary case.
;;;
incr-set prlevel 1
jump END
;;; Parameters:
;;;		I = module (regarded as a submodule of a free module)
;;;		J = ideal
;;; Output values:
;;;		K = (I:J^*), that is \union_N (I:J^N)
;;;
;;; 	The calls sat1 to compute (I:f^*), where f is a
;;; a combination of the generators of J with coefficients
;;; the powers of a new variable, suitably homogenized.
;;;
;;; Caveats:
;;;		One could do the same thing taking f to be a random linear
;;; combination of the generators of J.  This might be faster in
;;; some cases.  However, since one would have to bring all the
;;; generators up to the same degree first, f might be a
;;; very nonsparse polynomial.
;Created January 6, 1989.  Last modified 2/20/89 DE
START:
if #0>3 iterative ;choose the method

setring #1
<getvars oldvars@
nvars #1 noldvars@

<ring 2 st ring2@
ring-sum #1 ring2@ ring@
;Now bring I and J over to the new ring:
;Use a row of all the vars coming from the ring of origin for a map:
cat 0 firstvars@
	0
	0..noldvars@-1  
;We can't use keep here, because the base ring
;might have several blocks.

ev firstvars@ #1 I@
ev firstvars@ #2 J@

;replace J@ by a minimal set of generators for J@ mod I@ if I@ is an ideal:
nrows I@ idealtest@
if idealtest@>1 continue1
;prepare for "representatives" by making sure I and J are ideals:
setdegs I@
	;
	;
setdegs J@
	;
	;
<representatives J@ I@ J@
jump continue2

continue1:
;else just replace J@ by a minimal set of generators:
std J@ J@

continue2:
;Form the column vector of the powers of s
<ideal powers@ 1 s
ncols J@ ngens@
power powers@ ngens@-1 powers@
transpose powers@ powers@

;Form the "generic element of J@"
mult J@ powers@ f@
homog f@ t f@
<sat1 I@ f@ K@

;map the answer back to its ring of origin
ev oldvars@ K@ #3

kill ngens@ oldvars@ ring2@ ring@ noldvars@
kill powers@ firstvars@ I@ J@ f@ K@
kill ring@'zero ring2@'zero idealtest@
jump END

; ;;;;;;;;;;;;;;;;;The iterative option;;;;;;;;;;;;;;;;
iterative:

;initialize
int @count 1
copy #1 @I
nrows @I @idealtest
copy #2 @J


;find a minimal set of  generators for @J if @I is not an ideal
if @idealtest=1 continue_it1
std @J @J
jump continue_it2

continue_it1:
;if @I is an ideal, make sure its in a free module generated in degree 0
setdegs @I
	;
	;
continue_it2:
;Make sure that @J is an ideal generated in
;degree 0 -- else quotient complains
setdegs @J
;
;

std @I @I ;necessary for the reduce step

loop:
if @idealtest>1 continue_it3
<representatives @J @I @J

continue_it3:
quotient @I @J #3
reduce @I #3 @test
compress @test @test
ncols @test @test
if @test=0 done

;the following lines have the effect
;of copying the std basis, so that reduce works:
putstd #3 @I
forcestd @I @I

int @count @count+1
jump loop

done:
;shout type @count
kill @I @count @test @J @idealtest
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




END:
incr-set prlevel -1

$;;;;;;;; EXAMPLE SECTION ;;;;;;;;;;;;;;;;;;;;;;;;;
reset
<ring 3 a-z r
<ideal A a2 ab ac bc
<ideal f a+b+c
<sat
<sat A r L
;1.5 sec
type A
std L L
type L
; a bc 
listvars

kill L
<sat A r L it
;<1 sec
type A
type L
listvars

;A harder case:
<ring 3 a-z r
<ideal A a2 ab ac bc
power A 10 A
<sat
<sat A r L
;1min, 5 sec
type A
std L L
type L
; a bc 

kill L
<sat A r L it
;55 sec
type A
type L
listvars


; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
reset
<ring 5 a-z r
cat 0 m
0 1
0..3
wedge m 2 m2 ;A perfect ideal (saturated with resp to r)
betti m2
; total:      1     6 
; --------------------
;     0:      1     - 
;     1:      -     6 

power r 2 P
transpose P P'
mult P' m2 prod
betti prod
flatten prod prod ;Prod is m2 times the ideal of quadrics
<sat prod r tellus ;remove the ideal of quadrics
;7 sec
std tellus tellus
betti tellus
; total:      1     6 
; --------------------
;     0:      1     - 
;     1:      -     6 

kill tellus
<sat prod r tellus it
;24 sec
betti tellus
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Computing the dual of a plane curve f=0: (see the script dual_variety
;for an automated version.)

;The ring of P2xP2
reset

ring r
! characteristic (if not 31991)       ? ;
! number of variables                 ? 6
!   6 variables, please               ? abcxyz
! variable weights (if not all 1)     ? ;
! monomial order (if not rev. lex.)   ? 3 3

poly f b2c-a2(a-c) ;the nodal cubic
type f
jacob f j
type j
transpose j j'

;form the row of variables of the second factor
<getvars vars
elim vars vars2

;Now form the graph of the Gauss map
transpose vars2 vars2'
concat j' vars2'
wedge j' 2 i
flatten i i
concat i f
type i
type j

;Remove the components coming from the singular locus
<sat i j k
std k k
;<4 sec for the sat, about 8 with the following std (built in with it)
type k
kill k
<sat i j k it
;16 sec
type k
betti i
betti j
quotient i j k

;and project
<ring 3 x[1]-x[3] s
<project_from_product k 3 k1
type k1
; x[1]4+2x[1]2x[2]2+x[2]4+x[1]3x[3]+9x[1]x[2]2x[3]+27/4x[2]2x[3]2 


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;An example where i is not an ideal, to see if all the conditionals work:
reset

<ring 3 a-z r
<ideal i ab ac bc
dsum i i m
type m
poly f a
<sat1 m f n
type n
<sat m f n
type n
<sat m f n it
type n
listvars
