incr-set prlevel 1
if #0>=3 START
incr-set prlevel -1
;;; Usage:
;;; 	<rat_nor_osc_locus u r I
;;;
;;;     We require 1 <= u <= r-1.
;;; 	I is set to the idea of the union of the osculating 
;;; u-planes to the  standard rational normal curve 1 t t^2 ... ,
;;; over the current ring, which must have >= r+1 variables.
;;;
;;; Caveats:  The script does not produce a minimal set of generators.
;;; Use nres or std to get one.
;;;
;;; Also, there is a spurious warning message because of the way 
;;; the matrices in question are produced.
;;;
incr-set prlevel 1
jump END
;;; Parameters:
;;;        0  u <= r-1 integers
;;; Output values:
;;;        I a prime ideal in the current ring, using the first r+1 vars.
;;;
; created 12/9/DE
START:
;Get info on current ring
<getvars @curring
nvars @curring @nvars
char @curring @char

;Check for bad parameters
if @nvars<#2+1 badparameters
if #1>#2-2 badparameters
if #1<1 badparameters

;Make a new ring, with extra vars parametrizing the osculating variety
;ring @r
ring @r
	@char
	#1+2
	z[1]-z[#1]st
	;
	;
	
;Form the matrices needed to produce the ideal from which to eliminate
shout echo The following 2 "module isn't homogeneous" messages 
shout echo can be ignored.
submat @r @zrow1
	1
	1..#1
<ideal @zrow 1
setdegs @zrow
	0
	1
concat @zrow @zrow1

;Next make the matrix whose first row is 1 t ... t^r
;and whose successive rows are the derivatives of this.
;Total of u+1 rows.

<ideal @trow 1 t
power @trow #2 @tmat   ;the first row
copy @tmat @row
<ideal @t t

int @i 0

loop:
int @i @i+1
if @i>=#1+1 done_with_tmat
diff @t @row @newrow
<stack @tmat @tmat @newrow
copy @newrow @row
jump loop

done_with_tmat:

;Now multiply with the z's and homogenize
mult @zrow @tmat @fmat
transpose @fmat @fmat
setdegs @fmat
	;
	;
homog @fmat s @fmat
transpose @fmat @fmat
setdegs @fmat
	;
	;

;move back to the original ring
setring @curring
<subring @fmat #3

jump cleanup
badparameters:
shout echo rat_nor_osc_locus was called with bad parameters.

cleanup:
<ideal @newrow   ;so there is something to kill in every case
kill @curring @nvars @char @r'zero @r @zrow @zrow1 @trow @tmat @row 
kill @t @i @fmat @newrow 
END:
incr-set prlevel -1
$;;;;;;;; EXAMPLE SECTION ;;;;;;;;;;;;;;;;;;;;;;;;;
<ring 4 a-z r
<rat_nor_osc_locus 1 3 I
betti I ;should give a quartic equation

<ring 5 a-z r
<rat_nor_osc_locus 1 4 I
nres I I
betti I ;complete int of degrees 2,3

<ring 5 a-z r
<rat_nor_osc_locus 2 4 I
nres I I
betti I ;sextic hypersurface

<ring 6 a-z r
<rat_nor_osc_locus 2 5 I
<nres I I
betti I ;
; total:      1     6     6     1 
; --------------------------------
;     0:      1     -     -     - 
;     1:      -     -     -     - 
;     2:      -     -     -     - 
;     3:      -     6     6     1 

<ring 7 a-z r
<rat_nor_osc_locus 2 6 I
<nres I I
betti I ;
; total:      1     5    10     7     1 
; --------------------------------------
;     0:      1     -     -     -     - 
;     1:      -     1     -     -     - 
;     2:      -     3     -     -     - 
;     3:      -     1    10     7     1 

set prlevel -1
<ring 8 a-z r
<rat_nor_osc_locus 2 7 I
<nres I I
betti I ;
; total:      1     7    14    15     8     1 
; --------------------------------------------
;     0:      1     -     -     -     -     - 
;     1:      -     3     -     -     -     - 
;     2:      -     4    10     -     -     - 
;     3:      -     -     4    15     8     1 

<ring 9 a-z r
<rat_nor_osc_locus 2 8 I
<nres I I
betti I
; total:      1     7    24    31    21     9     1 
; --------------------------------------------------
;     0:      1     -     -     -     -     -     - 
;     1:      -     6     -     -     -     -     - 
;     2:      -     1    24    21     -     -     - 
;     3:      -     -     -    10    21     9     1 


<ring 10 a-z r
<rat_nor_osc_locus 2 9 I
<nres I I
betti I
; total:      1    10    43    71    56    28    10     1 
; --------------------------------------------------------
;     0:      1     -     -     -     -     -     -     - 
;     1:      -    10     8     -     -     -     -     - 
;     2:      -     -    35    70    36     -     -     - 
;     3:      -     -     -     1    20    28    10     1 

<ring 11 a-z r
;set prlevel -3
<rat_nor_osc_locus 2 10 I
set autocalc 1
set autodegree 4
nres I I
betti I ;This took 33 Megabytes
; total:      1    15    59   140   159    90    36    11     1 
; --------------------------------------------------------------
;     0:      1     -     -     -     -     -     -     -     - 
;     1:      -    15    25     -     -     -     -     -     - 
;     2:      -     -    34   140   154    55     -     -     - 
;     3:      -     -     -     -     5    35    36    11     1 

<ring 12 a-z r
<rat_nor_osc_locus 2 11 I
set autocalc 1
set autodegree 3
nres I I ;This nres failed after using 52 megabytes on the Decstation.
betti I
