
incr-set prlevel 1
if #0=5 START
incr-set prlevel -1
;;; Usage:
;;; 	<first_adjoint r i y j e
;;;
;;;	r coordinate ring of P4, i ideal of surface in P4
;;;	y coordinate ring of Pr, j ideal of the adjoint surface
;;;	e ideal of the exceptional divisor, more precisely of the
;;;	corresponding points in V(j)
;;;    (brief description)
;;;
incr-set prlevel 1
jump END
;;; Parameters:
;;;
;;; Output values:
;;;
;;; (discussion)
;;;
;;; Caveats:
;;;
; created 92, FOS.
START:
copy #2 @i
set autocalc 1
set autodegree 6
res @i @fi 3
shout betti @fi
trans @fi.3 @m
set autocalc -1
res @m @fm 3
bet @fm
ncols @i @a
nrows @fm.3 @b
submat @fm.3 @w
@a+1..@b
;
std @w @w
shout deg @w
nrows @w @r
int @r @r-1
char #1 @char
ring @rs
@char
6+@r
x[0]-x[4]#3[0]-#3[@r]
;
;
fetch @w @w
submat @rs @y
1
6..6+@r
mult @y @w @yw
poly @x x[0]
poly @xx x[1]
set autodegree 2
set autocalc 1
quot @yw @x @j
quot @yw @xx @jj
copy @rs @map1
edit @map1
ce 1 2 0
ev @map1 @yw @yw1
ce 1 2 x[1]
ce 1 3 0
ev @map1 @yw @yw2
ce 1 3 x[2]
ce 1 4 0
ev @map1 @yw @yw3
ce 1 4 x[3]
ce 1 5 0
ev @map1 @yw @yw4
ce 1 5 x[4]
ce 1 1 0
ev @map1 @yw @yw5
quot @yw1 @x @j1
quot @yw2 @x @j2
quot @yw3 @x @j3
quot @yw4 @x @j4
quot @yw5 @xx @j0
ring #3
@char
@r+1
#3[0]-#3[@r]
;
;
fetch @jj @jj
fetch @j #4 
concat #4 @jj
fetch @j1 @j1
fetch @j2 @j2
fetch @j3 @j3
fetch @j4 @j4
fetch @j0 @j0
set autocalc -1
std #4 #4
shout deg #4
shout hilb #4
concat @j1 @j2 @j3 @j4 @j0
std @j1 @j1 
shout deg @j1 
deg @j1 @cd @dg
SAT:
ncols @j1 @col
LS:
<random_mat 1 1 #3 @yy
std @yy @yy
ncols @yy @cl
if @cl=0 LS
quot @j1 @yy #5
deg #5 @cod @deg
if @cod>@cd LS
if @deg<@dg LS
ncols #5 @cl
copy #5 @j1
if @cl>@col SAT
if @cl<@col SAT
kill @jj @j0 @j1 @j2 @j3 @j4 @j @yw @yw1 @yw2 @yw3 @yw4 @map1
kill @a @b @i @fi @w @r @x @char @y @rs @m @fm @xx @yw5 @yy @cd @deg
kill @dg @cod @col @cl
END:
incr-set prlevel -1
listvars
$;;;;;;;; EXAMPLE SECTION ;;;;;;;;;;;;;;;;;;;;;;;;;
