incr-set prlevel 1
if #0>=2 START
incr-set prlevel -1
;;; Usage:
;;; 	<radical i rad_i [verbose]
;;;
;;; computes the radical of an ideal.
;;; The script "unmixed_radical" is called for each pure dimensional part.
;;;
;;; Each pure dimensional part, along with its radical,
;;; can be printed by including a 3rd argument.
;
incr-set prlevel 1
jump END
;;; Parameters:
;;;         i an ideal
;;; Output values:
;;;         rad_i its radical
;;; 
;;; The strategy is:
;;;    1)  set i1 equal to i with the component of highest dim removed
;;;    2)  saturate i with respect to i1 
;;;        to find the smallest dimensional isolated part j of i.
;;;    3)  replace j by its unmixed radical
;;;    4)  If i1 is the unit ideal, we're done; else:
;;;    5)  repeat, starting with i1, and intersect j with the radical of i1
;;;        to get the radical of i.
;;;
;;; Note that the script "sat" is called often by this and by the scripts
;;; it calls.  At the moment these calls all ask for the iterative 
;;; version of sat, and that seems the best in simple tests, though 
;;; of course one can find examples where it is not.
;;;
;;; Caveats:  This script is limited essentially by the limitations on "unmixed_radical"
;;;
; created 11/17/89 DE
START:
copy #1 @i1
;ensure that @i is an ideal (a map to the ring, in degree 0)
min @i1 @rowdegi
dshift @i1 -@rowdegi


initialize:
<ideal #2 1

loop:

copy @i1 @i

<remove_lowest_dim @i @i1
<sat @i @i1 @j1 iterative
;if @j1 is the unit ideal, go round again (we removed embedded stuff only)
<is_zero @j1 @test
if @test=0 loop

;Branch according to the desired verbosity
if #0=2 continue

<unmixed_radical @j1 @j 
std @j @j
std @j1 @j1
shout echo XXXXXXXXXXXXXXXXXXXXXXXXX
shout echo Pure dimensional component:
shout degree @j1
shout type @j1
shout echo and its radical:
shout degree @j
shout type @j
shout echo XXXXXXXXXXXXXXXXXXXXXXXXX

jump after_unmixed_rad
continue:

<unmixed_radical @j1 @j

after_unmixed_rad:

intersect @j #2 #2

;if @i1 is the unit ideal, we're done; else repeat
<is_zero @i1 @test
if @test>0 loop

kill @i @rowdegi @i1 @j1 @j @test 

END:
incr-set prlevel -1

$;;;;;;; EXAMPLE SECTION ;;;;;;;;;;;;;;;;;;;;;;;;;
reset
<ring 4 a-z r

<ideal j1 a2
<radical j1 i1 ver
type i1

<ideal j2 a2 b3
<radical j2 i2
type i2

<ideal j3 b2 c2 d3 cd
<radical j3 i3
type i3

intersect i1 i2 i3 i
type i
; ad ab ac 

intersect j1 j2 j3 j
type j
; a2cd a2c2 a2b2 a2d3 

<radical j test verbose
;about 6 sec
type test ;this should be i
; ad ab ac 

;;;;;;;;;;;;;;;;;;;;;;
<ring 5 a-z R
<ideal i a b c
<ideal i1 c d
<mult_ideals i i1 j
type j
<radical j jrad verbose
type jrad


listvars
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Recovery of a scroll from a k3 carpet:

;First make a k3carpet in a+b+2 variables
;for this to work the following integers must
;be >=2

reset

int a 2
int b 2
<ring a+1 x[0]-x[a] r1
<ring b+1 y[0]-y[b] r2
ring-sum r1 r2 r
cat x[0] A
0 1
0..a-1
cat y[0] B
0 1
0..b-1
type A
type B

<k3carpet A B i

;set autocalc 1
;set autodegree 2
res i ii 
betti ii
;should - and does - show the last linear term
;in the bth place.  Note that the codim is a+b-1
;and the degree is 2(a+b) = 2(g-1).

type i

<radical i j verbose

;33 secs for the case a=b=2. 9 sec with 50mhz board (3/6/90)
;About 5 minutes for the case a=2,b=3.  

res j j
betti j


; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Varieties in the nilcone of matrices:
;Nilpotent nxn matrices:
reset
int n 3
<ring n*n a-z r
<generic_mat a n n M
mult M M M2
flatten M2 nilp
betti nilp

set prlevel -10
set timer 1
<radical nilp j verbose
;n=2 goes fast.  n=3 ran out of memory trying to show that the
;correct answer (which is already produced by the first 
;"remove lowest dim) is correct (its the 2x2's with the trace, codim = 5)
;The program was working on the 4x4 minors; it succeeded in doing
;a wedge 4 (of the 9x10 Jacobian matrix) in 52 min, but ran out of
;space on the following "flatten".
res j j
betti j
