;;;;;;;; BEGIN adj_of_cat ;;;;;;;;;;;
reset


<ring 6 a-f r
<adj_of_cat
<adj_of_cat 4 5 m
type m
; a b c d e 0 0 0 
; 0 a b c d e 0 0 
; 0 0 a b c d e 0 
; 0 0 0 a b c d e 


listvars
;;;;;;;; END adj_of_cat ;;;;;;;;;;;;;

;;;;;;;; BEGIN adjoin_fractions ;;;;;;;;;;;
reset

;Normalization of the smooth rational quartic:

<ring 4 a-d r
<monomial_curve 1 3 4 i
std i i
qring i R

;The variable a represents s4, while b represents s3t, so b2/a = s2t2,
;the missing generator.
poly numerator b2
poly denominator a

;Set up the ring for the output:
<ring 1 x S0
ring-sum R S0 S

;Now adjoin b2/a:
<adjoin_fractions
<adjoin_fractions denominator numerator K
std K K
betti K
; total:      1     5 
; --------------------
;     0:      1     - 
;     1:      -     5 

;Note that K has only 5 generators: the sixth is in the defining
;ideal of S!
present-ring S L
fetch K K1
concat L K1

nres L L
betti L  ; The ideal of the rational normal quartic!
; total:      1     6     8     3 
; --------------------------------
;     0:      1     -     -     - 
;     1:      -     6     8     3 


listvars
;;;;;;;; END adjoin_fractions ;;;;;;;;;;;;;

;;;;;;;; BEGIN adjoint ;;;;;;;;;;;
reset

ring r
;
7
a[1]-a[3]
b[1]-b[4]
;
;

cat a[1] a
0
0..2
cat b[1] b
0
0..3

outer a b f
<idencoldegs a A
<idencoldegs b B

<adjoint
<adjoint f A B g
type f
type g
; a[1]b[1] a[2]b[1] a[3]b[1]
; a[1]b[2] a[2]b[2] a[3]b[2]
; a[1]b[3] a[2]b[3] a[3]b[3]
; a[1]b[4] a[2]b[4] a[3]b[4]



listvars
;;;;;;;; END adjoint ;;;;;;;;;;;;;

;;;;;;;; BEGIN analytic_spread ;;;;;;;;;;;
reset
;First a case where the catalecticant matrix
;has the same analytic spread as the generic matrix:
<ring 5 a-z r
cat a m
0 1
0..3
type m
wedge m 2 m2
<analytic_spread m2
;5
listvars
;;;;;;;; END analytic_spread ;;;;;;;;;;;;;

;;;;;;;; BEGIN annihilated ;;;;;;;;;;;
reset
<ring 2 ab r
<ideal row1 a b 0
<ideal row2 0 a b
<stack m row1 row2 
type m
betti m
<ideal i a
<ideal j a2
<annihilated i m
<annihilated j m
<annihilated i m ans
type ans
<annihilated j m ans
type ans

listvars
;;;;;;;; END annihilated ;;;;;;;;;;;;;

;;;;;;;; BEGIN annihilator1 ;;;;;;;;;;;
reset


;In these two examples, annihilator2 is much faster:
<ring 4 a-z rr

iden 10 ID
smult ID a X

<annihilator1
<annihilator1 X ann_X
type ann_X
; a 

<annihilator2
<annihilator2 X ann2_X
type ann2_X
; a 


listvars
;;;;;;;; END annihilator1 ;;;;;;;;;;;;;

;;;;;;;; BEGIN annihilator2 ;;;;;;;;;;;
reset

<annihilator2
see tests in annihilator1


listvars
;;;;;;;; END annihilator2 ;;;;;;;;;;;;;

;;;;;;;; BEGIN binomial ;;;;;;;;;;;
reset

set prlevel 0
<binomial
<binomial 4 2 n


listvars
;;;;;;;; END binomial ;;;;;;;;;;;;;

;;;;;;;; BEGIN cohomology ;;;;;;;;;;;
reset


<ring 4 a-z r

;construct a module which will represent O(-3) restricted
;to a line in P3
<ideal supp a b
setdegs supp
	3
	;

<cohomology
<cohomology 0 supp 1 h
type h
betti h


<cohomology 1 supp 2 h
type h
std h h
hilb h
;       2 t  0
;      -7 t  1
;       8 t  2
;      -2 t  3
;      -2 t  4
;       1 t  5

;       2 t  0
;       1 t  1

; codimension = 4
; degree      = 3

;Remark:  taking j=1 in this computation does not work --
;that is, the bound given in the comment above is sharp
;in this case.


listvars
;;;;;;;; END cohomology ;;;;;;;;;;;;;

;;;;;;;; BEGIN cohomology1 ;;;;;;;;;;;
reset


; The cotangent sheaf of a plane curve of
;degree d is 0(d-3)
;
;Here's the case of a plane quartic
int d 4

<ring 3 xyz r

ideal i
1
x^d+y^d+z^d

<cotan i w
<prune w w
type w
betti w

;The answer is not yet of depth 2, so we must
;compute H^0_*

<cohomology1
<cohomology1 0 w 3 W
type W
<prune W W
type W
betti W
; total:      1     1 
; --------------------
;    -1:      1     - 
;     0:      -     - 
;     1:      -     - 
;     2:      -     1 

;This is the depth 2 version -- its 0(1) on the quartic.
;j=3 is really the smallest value that suffices here.


listvars
;;;;;;;; END cohomology1 ;;;;;;;;;;;;;

;;;;;;;; BEGIN column_vector ;;;;;;;;;;;
reset

<ring 5 a-e r
<column_vector j a2 ab ac a(b+c)^2
type j

listvars
;;;;;;;; END column_vector ;;;;;;;;;;;;;

;;;;;;;; BEGIN complement ;;;;;;;;;;;
reset


<ring 8 a-z r

mat a
2
2
1
a
b
c2
type a
setdegs a
1 0
;
type a
<complement
<complement a b

type b
listvars
;;;;;;;; END complement ;;;;;;;;;;;;;

;;;;;;;; BEGIN copyring ;;;;;;;;;;;
reset

ring r 
3
4
abxy
1 2 3 4
w 2 c
a

ideal j
    3
    a4
    a3b
    ax

qring j s
<copyring
<copyring u t
pring t
type t


listvars
;;;;;;;; END copyring ;;;;;;;;;;;;;

;;;;;;;; BEGIN cotan ;;;;;;;;;;;
reset


; The cotangent sheaf of a plane curve of
;degree d is 0(d-3)
;
;Here's the case of a plane quartic
int d 4

<ring 3 xyz r

ideal i
1
x^d+y^d+z^d

<cotan
<cotan i w
<prune w w
type w
betti w

;The answer is not yet of depth 2, so we must
;compute H^0_*

<cohomology1 0 w 3 W
type W
<prune W W
type W
betti W
; total:      1     1 
; --------------------
;    -1:      1     - 
;     0:      -     - 
;     1:      -     - 
;     2:      -     1 
;This is the depth 2 version -- its 0(1) on the quartic.


listvars
;;;;;;;; END cotan ;;;;;;;;;;;;;

;;;;;;;; BEGIN cotan_bihom ;;;;;;;;;;;
reset


; The cotangent sheaf of P2 embedded as the diag in P2 x P2


<ring 6 stuxyz r

;the ideal of the diagonal:
<generic_mat s 2 3 i
type i
wedge i 2 i2
flatten i2 i2 
type i2

<cotan_bihom
<cotan_bihom s..u x..z i2 Om
<prune Om Om
res Om Om
betti Om
; total:      9    22    18     6     1 
; --------------------------------------
;     2:      9    22    18     6     1 
;Note depth 2 with respect to the maximal ideal.
;An unusual view of the cotangent sheaf!
;The meaning is:  O(a,b) on P2xP2 restricts to O(a+b) on P2;
;and "total degree 2" over the bihomogeneous ring is the sum of
;bidegrees (2,0), (1,1), and (0,2).  So the fact that 
;	h^0 ( Omega_{P2}(1) ) = 0 
;shows that Omega as a bigraded module will be 0 in total degree1,
;while in total degree 2 it will consist of 3 copies of 
;	H^0 ( Omega_{P2}(2) ) ,
;which is 3-dimensional, for a total of 9 dimensions, as shown.


listvars
;;;;;;;; END cotan_bihom ;;;;;;;;;;;;;

;;;;;;;; BEGIN curve_on_cubic ;;;;;;;;;;;
reset

<ring 3 a-z P2
<ring 4 a-z P3

setring P2

;Make the matrix of points:
<ideal p1 1 -1 2
<ideal p2 1 2 3
transpose p1 p1
transpose p2 p2
copy p1 p
concat p p2
type p

;a plane curve:
setring P2
<ideal C1 3a+4b+5c ;line not through any point
setring P3

<curve_on_cubic p C1 I
nres I I
betti I
; total:      1     3     2 
; --------------------------
;     0:      1     -     - 
;     1:      -     3     2 
;twisted cubic
listvars
;;;;;;;; END curve_on_cubic ;;;;;;;;;;;;;

;;;;;;;; BEGIN diagonal_submodule ;;;;;;;;;;;
reset

;The bihomogeneous coordinate ring of P1xP1:
ring r
;
4
x[0]-x[1]
y[0]-y[1];
;
;

;Form the segre map
cat x[0] xvars
0
0..1
cat y[0] yvars
0
0..1

transpose yvars yvars'
mult yvars' xvars zvars
flatten zvars f
type f

;The bihomogeneous ideal of a point:
ideal i
2
x[0]
y[0]

;An inclusion map from the ring to a diagonally generated free module:
<ideal h 1

<ring 4 z[0,0]-z[1,1] s
;The diagonal submodule
<diagonal_submodule
<diagonal_submodule f i h M1
type M1
; x[1]y[0] x[0]y[1] x[0]y[0] 


listvars
;;;;;;;; END diagonal_submodule ;;;;;;;;;;;;;

;;;;;;;; BEGIN diff ;;;;;;;;;;;
reset

<ring 2 xy r
mat n 
	2
	2
x2
x
y3
xy
setdegs n
	0 1
	;
type n
<ideal i x y
<diff i n nn
betti n
; total:      2     2 
; --------------------
;     0:      1     - 
;     1:      1     1 
;     2:      -     1 

betti nn
; total:      4     2 
; --------------------
;     1:      2     1 
;     2:      2     1 
type n
; x2 y3 
; x  xy 

type nn
; 2x 0   
; 1  y   
; 0  3y2 
; 0  x   

listvars
;;;;;;;; END diff ;;;;;;;;;;;;;

;;;;;;;; BEGIN double_dual ;;;;;;;;;;;
reset


;Torsion in the cotangent sheaf of a nodal curve:

;The nodal plane cubic:
<ring 3 x-z r
poly i y2z-x2(x-z)
type i

<cotan i Omega
type Omega
;The following line is necessary because of a bug (5/14/89)
std i i    
qring i rr
fetch Omega Omega
<double_dual Omega N f
<kernel
<kernel f Omega N torsion
<prune torsion torsion
type torsion
; y x 

;The cotangent sheaf has torsion at the origin!


listvars
;;;;;;;; END double_dual ;;;;;;;;;;;;;

;;;;;;;; BEGIN double_dual1 ;;;;;;;;;;;
reset

<ring 4 a-z r
<ideal R 0

;something reflexive
<ideal m3 a b c
transpose m3 m3
<double_dual1 m3 R nn3 ff3
; b  
; -a 
; c  
type ff3
; 0  1 0 
; -1 0 0 
; 0  0 1 

listvars
;;;;;;;; END double_dual1 ;;;;;;;;;;;;;

;;;;;;;; BEGIN dual_variety ;;;;;;;;;;;
reset


;Duality in the plane:
ring r

3
a-z
;
;
;Use the above ring for the following examples:

;The nonsingular cubic
poly f1 a3+b3+c3

<dual_variety
<dual_variety f1 1 j
type j
<dual_variety j 1 i
type i


listvars
;;;;;;;; END dual_variety ;;;;;;;;;;;;;

;;;;;;;; BEGIN equality ;;;;;;;;;;;
reset
<ring 2 a-z r
<ideal i a2 ab b2
<ideal j a2 ab b3
<equality i j ans
type ans
<equality j j ans
type ans
listvars
;;;;;;;; END equality ;;;;;;;;;;;;;

;;;;;;;; BEGIN ext ;;;;;;;;;;;
reset


<ring 4 a-z r
<ideal i a

;Note that "r" is a presentation of the 
;residue class field
<ext
<ext 3 r i e
type e

<prune e f
type f
; a c b d    ;the residue class field


listvars
;;;;;;;; END ext ;;;;;;;;;;;;;

;;;;;;;; BEGIN ext(-,R) ;;;;;;;;;;;
reset

<ring 3 a-z r
<ideal i a b

<ext(-,R)
<ext(-,R) 0 i e
type e

<ext(-,R) 1 i e
type e

<ext(-,R) 2 i e
type e
; b a 				;this is the only nonzero one

<ext(-,R) 3 i e
type e

<ext(-,R) 4 i e
type e


listvars
;;;;;;;; END ext(-,R) ;;;;;;;;;;;;;

;;;;;;;; BEGIN extend_ring ;;;;;;;;;;;
reset

;Normalization in P4 of the smooth rational quartic in P3


;Form the coordinate ring R of the quartic:
<ring 4 a-d s
<monomial_curve 1 3 4 i
std i i
qring i R

;Next make a test ideal j:
<powers R 2 j

<extend_ring
<extend_ring j x S
; total:      1 
; --------------
;     1:      1 
present-ring S K

;Note that K is an ideal in a polynomial ring over R,
;which is not itself a polynomial ring.  In fact, the
;number of minimal generators of K is only 5, since
;one of the quadrics in the ideal is 0 in R!  We can
;get everything up to a polynomial ring to look at it as
;follows:

present-ring K L
setring L
fetch K K1
concat L K1
nres L L
betti L
; total:      1     6     8     3 
; --------------------------------
;     0:      1     -     -     - 
;     1:      -     6     8     3 

listvars

;;;;;;;; END extend_ring ;;;;;;;;;;;;;

;;;;;;;; BEGIN from_bigraded ;;;;;;;;;;;
reset


;Sheaves on P1 x P1:

;The bihomogeneous coordinate ring of P1xP1:
ring r
;
4
x[1]-x[2]
y[1]-y[2];
;
;

;The twisted cubic:
ideal k
1
x[1]y[1]2+x[2]y[2]2

;Note that the generator 1 in r is of degree 0,0

;The homogeneous coordinate ring of P3:
<ring 4 z[1,1]-z[2,2] s

<from_bigraded
<from_bigraded 1 1 k N segre
type segre
type N
nres N N
betti N
; total:      1     3     2 
; --------------------------
;     0:      1     -     - 
;     1:      -     3     2 


listvars
;;;;;;;; END from_bigraded ;;;;;;;;;;;;;

;;;;;;;; BEGIN from_div_powers ;;;;;;;;;;;
reset

<ring 3 xyz r
poly f x2+xy+y2               ;(x+y)^(2)
<from_div_powers
<from_div_powers f g
type g
; 1/2x2+xy+1/2y2              ;This is (1/2) (x+y)^2

<to_div_powers g h
type h


listvars
;;;;;;;; END from_div_powers ;;;;;;;;;;;;;

;;;;;;;; BEGIN generic_mat ;;;;;;;;;;;
reset

<ring 12 a[1,1]-a[3,4] R
<generic_mat
<generic_mat a[1,1] 3 4 M
type M


listvars
;;;;;;;; END generic_mat ;;;;;;;;;;;;;

;;;;;;;; BEGIN getvars ;;;;;;;;;;;
reset

<ring 30 a[1]-a[30] r
<getvars
<getvars vars
type vars
 


listvars
;;;;;;;; END getvars ;;;;;;;;;;;;;

;;;;;;;; BEGIN hom ;;;;;;;;;;;
reset

; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Finding Hom(J,r), for normalization:

;The ring r/i of the rational quartic in P3:
<ring 2 st p1
<ideal f s4 s3t st3 t4
<ring 4 a-z r
<subring f i
type i
; c3-bd2 bc-ad b3-a2c ac2-b2d 

;The test ideal:
<ideal j a2 b2 c2 d2
;and its presentation matrix j.2:
res j j 2

<hom j.2 i r1
<prune r1 r1
type r1
betti r1
; total:      2     5 
; --------------------
;     0:      1     - 
;     1:      1     5 
;Note the extra generator in degree 1!


listvars
;;;;;;;; END hom ;;;;;;;;;;;;;

;;;;;;;; BEGIN hom_and_map ;;;;;;;;;;;
reset

<hom_and_map
;This script is used by double_dual1


listvars
;;;;;;;; END hom_and_map ;;;;;;;;;;;;;

;;;;;;;; BEGIN hom_is_0 ;;;;;;;;;;;
reset


<ring 4 a-z s
poly X a+b+c+d

;An ideal n1 mod which X  is a nonzerodivisor:
ideal n1
6
ab
ac
ad
bc
bd
cd

<hom_is_0
<hom_is_0 X n1


;An ideal n2 mod which X is not a nonzerodivisor:
transpose s s'
mult s' n1 n2
flatten n2 n2

<hom_is_0 X n2


listvars
;;;;;;;; END hom_is_0 ;;;;;;;;;;;;;

;;;;;;;; BEGIN homology ;;;;;;;;;;;
reset

 
;homology of the complex
;   a2        a2
; R --> R/a3 --> R/a3
;
;where R is the ring k[a]/a4.
;(The homology is the residue class field.)

<ring 1 a r
<ideal i a4
qring i qr

<ideal j1 a3
copy j1 j2
setdegs j2
-2
;

<ideal f1 a2
copy f1 f2
setdegs f2
-2
;

<homology
<homology j1 j2 f1 f2 h
type h
; a 


listvars
;;;;;;;; END homology ;;;;;;;;;;;;;

;;;;;;;; BEGIN ideal ;;;;;;;;;;;
reset

<ring 5 a-e r
<ideal
<ideal j a2 ab ac a(b+c)^2
type j


listvars
;;;;;;;; END ideal ;;;;;;;;;;;;;

;;;;;;;; BEGIN idencoldegs ;;;;;;;;;;;
reset


<ring 2 ab r
ideal i
    2
    a
    a2
<idencoldegs
<idencoldegs i I
transpose i i'
<idencoldegs i' I'
col-degs i
col-degs i'
row-degs I
col-degs I
row-degs I'
col-degs I'


listvars
;;;;;;;; END idencoldegs ;;;;;;;;;;;;;

;;;;;;;; BEGIN idenrowdegs ;;;;;;;;;;;
reset


<ring 2 ab r
ideal i
    2
    a
    a2
<idenrowdegs
<idenrowdegs i I
transpose i i'
<idenrowdegs i' I'
row-degs i
row-degs i'
row-degs I
col-degs I
row-degs I'
col-degs I'


listvars
;;;;;;;; END idenrowdegs ;;;;;;;;;;;;;

;;;;;;;; BEGIN interchange ;;;;;;;;;;;
reset



<ring 8 a-z r

mat m
3
2
a
0
0
0
0
b

mat n
3
4
c
0
0
0
d
0
0
0
e
0
0
f

outer m n mtensorn
outer n m ntensorm

type m
type n

<interchange
<interchange m n u v

;compose v(mtensorn)u
mult mtensorn u temp
mult v temp prod

type prod
type ntensorm
subtract prod ntensorm test
type test
;test should be the zero matrix!


listvars
;;;;;;;; END interchange ;;;;;;;;;;;;;

;;;;;;;; BEGIN interchange_permutation ;;;;;;;;;;;
reset

<ring 1 a r

<interchange_permutation
<interchange_permutation 2 3 m
type m

;Test with the inverse:

<interchange_permutation 3 2 m1
mult m m1 test
type test


listvars
;;;;;;;; END interchange_permutation ;;;;;;;;;;;;;

;;;;;;;; BEGIN inverse ;;;;;;;;;;;
reset

random 10 10 m
<inverse
<inverse m n
;10 sec for 30x30, 44sec for 50x50, 5min33sec for 100x100
mult m n test
;22 seconds for a 30x30 !
type test



listvars
;;;;;;;; END inverse ;;;;;;;;;;;;;

;;;;;;;; BEGIN is_zero ;;;;;;;;;;;
reset

<ring 3 a-z r
<ideal i a b
<ideal j 1
<ideal k a b c
concat j i
dsum i j m
dsum j j m1


<is_zero i t
type t

<is_zero j t
type t

<is_zero k t
type t

<is_zero m t
type t

<is_zero m1 t
type t

listvars
;;;;;;;; END is_zero ;;;;;;;;;;;;;

;;;;;;;; BEGIN j_from_lambda ;;;;;;;;;;;
reset

<ring 1 x r
set char0 1
<j_from_lambda
<j_from_lambda -1 j
type j
;1728

listvars
;;;;;;;; END j_from_lambda ;;;;;;;;;;;;;

;;;;;;;; BEGIN k3carpet ;;;;;;;;;;;
reset

int a 2
int b 3
<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 4
res i ii 
betti ii

listvars
;;;;;;;; END k3carpet ;;;;;;;;;;;;;

;;;;;;;; BEGIN kernel ;;;;;;;;;;;
reset


;Torsion in the cotangent sheaf of a nodal curve:

;The nodal plane cubic:
<ring 3 x-z r
poly i y2z-x2(x-z)
type i

<cotan i Omega
type Omega
;The following line is necessary because of a bug (5/14/89)
std i i    
qring i rr
fetch Omega Omega
<double_dual Omega N f
<kernel
<kernel f Omega N torsion
<prune torsion torsion
type torsion
; y x 

;The cotangent sheaf has torsion at the origin!


listvars
;;;;;;;; END kernel ;;;;;;;;;;;;;

;;;;;;;; BEGIN kernel_and_map ;;;;;;;;;;;
reset


;Torsion in the cotangent sheaf of a nodal curve:

;The nodal plane cubic:
<ring 3 x-z r
poly i y2z-x2(x-z)
type i

<cotan i Omega
type Omega
;The following line is necessary because of a bug (5/14/89)
std i i    
qring i rr
fetch Omega Omega
<prune Omega Omega
<double_dual Omega N f
<kernel_and_map
<kernel_and_map f Omega N torsion g
;The cotangent sheaf has torsion at the origin!

type Omega
type torsion
type g

;Now get a minimal presentation:
<prune_and_map torsion torsion g1
mult g g1 g2
type torsion
; x y 

type g2
; -1/3xy       
; 0            
; -2/3xz+2/3z2 


listvars
;;;;;;;; END kernel_and_map ;;;;;;;;;;;;;

;;;;;;;; BEGIN kosz_hom1 ;;;;;;;;;;;
reset


<ring 3 a-z r
power r 2 i
res i i 2
setdegs i.2
;
;

<kosz_hom1
<kosz_hom1 2 i.2
; 3
;This means that the ideal i, presented by the matrix i.2,
;has 3 linear second syzygies, as shown by the following display:

res i.2 res
betti res
; total:      6     8     3 
; --------------------------
;     0:      6     8     3 


listvars
;;;;;;;; END kosz_hom1 ;;;;;;;;;;;;;

;;;;;;;; BEGIN kosz_hom2 ;;;;;;;;;;;
reset


<ring 4 a-z r
power r 2 i
res i ii 2
betti ii
; total:      1    10    20 
; --------------------------
;     0:      1     -     - 
;     1:      -    10    20 

<kosz_hom2
<kosz_hom2 2 i
; 20

listvars
;;;;;;;; END kosz_hom2 ;;;;;;;;;;;;;

;;;;;;;; BEGIN map_from_col ;;;;;;;;;;;
reset

;Map between factor rings
<ring 3 a-z r
<ideal i a2 b2
<ideal j b2 c2
<ideal h ab2
<map_from_col h i j k
type k

listvars
;;;;;;;; END map_from_col ;;;;;;;;;;;;;

;;;;;;;; BEGIN minpres ;;;;;;;;;;;
reset

<ring 4 a-z r
ideal i
2
a+b+c+d
a2+d2
poly p cd


<minpres
<minpres i u-z I f
ev f p p
type p
; vw 
type f
; -u-v-w u v w 


listvars
;;;;;;;; END minpres ;;;;;;;;;;;;;

;;;;;;;; BEGIN monomial_curve ;;;;;;;;;;;
reset

<ring 6 a-f r

<monomial_curve

<monomial_curve 6 7 8 9 11  i	; Two singular points g=7
nres i w
% betti w
; total:      1     9    16    10     2 
; --------------------------------------
;     0:      1     -     -     -     - 
;     1:      -     5     5     -     - 
;     2:      -     4    11    10     1 
;     3:      -     -     -     -     1 

% hilb w.1

;       1 t  0
;      -5 t  2
;       1 t  3
;      11 t  4
;     -10 t  5
;       1 t  6
;       1 t  7

;       1 t  0
;       4 t  1
;       5 t  2
;       1 t  3

; codimension = 4
; degree      = 11
; genus       = 7


listvars
;;;;;;;; END monomial_curve ;;;;;;;;;;;;;

;;;;;;;; BEGIN mult_ideals ;;;;;;;;;;;
reset

<ring 3 a-z r
<ideal m1 a b
<ideal m2 c
<ideal m3 b c
<mult_ideals m1 m2 m3 I
type I
; abc b2c ac2 bc2 

listvars
;;;;;;;; END mult_ideals ;;;;;;;;;;;;;

;;;;;;;; BEGIN nbyn_commuting ;;;;;;;;;;;
reset

;; make the commuting 3 by 3 matrices ;;
<nbyn_commuting
<nbyn_commuting 3 j a b
type a
type b
type j


listvars
;;;;;;;; END nbyn_commuting ;;;;;;;;;;;;;

;;;;;;;; BEGIN normal_sheaf ;;;;;;;;;;;
reset

<ring 4 a-z r
<monomial_curve 1 2 3 i ;the twisted cubic
<normal_sheaf i N Nbar
std N N ;
betti N
; total:      6    12 
; --------------------
;    -1:      6    12 

listvars
;;;;;;;; END normal_sheaf ;;;;;;;;;;;;;

;;;;;;;; BEGIN nres ;;;;;;;;;;;
reset

int a 2
int b 4
<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 m

nres m mm
betti mm
<nres m mm
betti mm

listvars
;;;;;;;; END nres ;;;;;;;;;;;

;;;;;;;; BEGIN nzd ;;;;;;;;;;;
reset
<ring 4 a-z s
<ring 3 a-z sbar

setring s
;The putative nonzerodivisor:
poly X a+2b+c+d

;An ideal n1 mod which it is a nonzerodivisor:
<ideal n1 ab ac ad bc bd cd

;An ideal n2 mod which it is not a nonzerodivisor:
transpose s s'
mult s' n1 n2
flatten n2 n2

setring sbar    ;TARGET RING MUST BE CURRENT RING
<nzd
<nzd X n1 n1_
type n1_
;nonzerodivisor

<nzd X n2 n2_
type n2_
;zerodivisor


listvars
;;;;;;;; END nzd ;;;;;;;;;;;;;

;;;;;;;; BEGIN orbit_equations ;;;;;;;;;;;
reset


;Orbits of binary cubics:

<ring 2 xy r
poly h1 x3  		;A perfect cube:
poly h2 x2y 		;Two distinct roots
poly h3 xy(x+y)	;Three distinct roots


;The ring of coefficients:
<ring 4 a-z s

;The tangent developable surface to the twisted cubic
;(A quartic surface)
<orbit_equations
<orbit_equations h2 I2
res I2 I2
betti I2
; total:      1     1 
; --------------------
;     0:      1     - 
;     1:      -     - 
;     2:      -     - 
;     3:      -     1 


listvars
;;;;;;;; END orbit_equations ;;;;;;;;;;;;;

;;;;;;;; BEGIN permutation ;;;;;;;;;;;
reset


<permutation
<permutation 3 x[2]x[1]x[3] q
type q


listvars
;;;;;;;; END permutation ;;;;;;;;;;;;;

;;;;;;;; BEGIN perp ;;;;;;;;;;;
reset

<ring 7 a-d r
cat a M
0 1
0 1 2
type M

<ring 3 xyt s
<perp M N
type N
; 0 -x 
; x -y 
; y 0  

listvars
;;;;;;;; END perp ;;;;;;;;;;;;;

;;;;;;;; BEGIN points ;;;;;;;;;;;
reset
<ring 3 a-z r

;A single point:
mat p1
3
1
1
0
0
<points p1 e
type e

<ideal mult 1
<points p1 e mult 
type e

<ideal mult a
<points p1 e mult 
type e

<ideal mult a2
<points p1 e mult 
type e
; 
listvars

;;;;;;;; END points ;;;;;;;;;;;;;

;;;;;;;; BEGIN powers ;;;;;;;;;;;
reset


<ring 6 a-z r
<powers
<powers r 3 j
type j


listvars
;;;;;;;; END powers ;;;;;;;;;;;;;

;;;;;;;; BEGIN project_from_product ;;;;;;;;;;;
reset

;Computing the dual of a plane curve f=0:
;The cuspidal cubic:

;The ring of P2xP2
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 a2c-b3
jacob f j a..z
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

;Remove the components coming from the singular locus
;Note that we get sing x (everything) in the graph,
;so that if we remove this step the resulting ideal k = 0.
<sat i j i

;and project
<project_from_product
<project_from_product i 3 k
type k
; b3+27/4a2c 
;The dual is again a cuspidal cubic.


listvars
;;;;;;;; END project_from_product ;;;;;;;;;;;;;

;;;;;;;; BEGIN prune ;;;;;;;;;;;
reset

;A typical case:

<ring 4 a-z r
poly i a

<ext 2 r i e
;ext generally produces a non-minimal presentation of 
;its result:
type e
; 0 1 0 0 0 0 0 0 0 0 
; 0 0 0 0 0 0 0 0 0 1 
; 0 0 0 0 0 0 0 1 0 0 
; 0 0 1 0 0 0 0 0 0 0 
; 0 0 0 0 1 0 0 0 0 0 
; 0 0 0 0 0 0 0 0 1 0 
; 0 0 0 0 0 1 0 0 0 0 
; 0 0 0 0 0 0 1 0 0 0 
; 0 0 0 1 0 0 0 0 0 0 
; 1 0 0 0 0 0 0 0 0 0 
<prune
<prune e f
type f

;e was an isomorphism

listvars
;;;;;;;; END prune ;;;;;;;;;;;;;

;;;;;;;; BEGIN prune_and_map ;;;;;;;;;;;
reset


;Torsion in the cotangent sheaf of a nodal curve:

;The nodal plane cubic:
<ring 3 x-z r
poly i y2z-x2(x-z)
type i

<cotan i Omega
type Omega
;The following line is necessary because of a bug (5/14/89)
std i i    
qring i rr
fetch Omega Omega
<prune Omega Omega
<double_dual Omega N f
<kernel_and_map f Omega N torsion g
;The cotangent sheaf has torsion at the origin!

type Omega
; -y x2+y2 1/3xy y2+2/3xz 
; x  0     1/3y2 2/3yz    
; z  2yz   x2-xz 2yz      

type torsion
; 1 0 0   0 0 0 
; 0 0 1/3 0 x y 
; 0 1 0   1 0 0 
; 0 1 0   0 0 0 
; 0 0 1   0 0 0 
type g
; -y xy      y2+2/3xz x2-2/3xz 0              
; x  0       2/3yz    -2/3yz   1/3y2          
; z  2xz-2z2 2yz      0        x2-5/3xz+2/3z2 

;But the minimal presentation is much simpler:
<prune_and_map
<prune_and_map torsion torsion g1
mult g g1 g2
type torsion
; x y 
type g2
; -1/3xy       
; 0            
; -2/3xz+2/3z2 


listvars
;;;;;;;; END prune_and_map ;;;;;;;;;;;;;

;;;;;;;; BEGIN push_forward ;;;;;;;;;;;
reset

;Illustration of the Auslander-Buchsbaum formula: pd M = depth R - depth M.
;If we push M forward by a map f such that M is finitely generated via f,
;then the depth of M does not change, so the projective dimension goes down:
;Also, if the projection is linear, the degree stays the same.  Of course
;the number of generators generally goes up.


<ring 6 a-z r6

;A module of projective dimension 2:
<generic_mat a 2 3 m
res m mm

<ring 5 a-z r5

<ring 4 a-z r4

;Amap from r5 to r6
imap g r5 r6
a a+b+c+d+e+f
	;
type g

;A generic projection map from r4 to r5
setring r5
<random_mat 1 4 r5 f
type f

setring r5
<push_forward
<push_forward g m p
<prune p p
res p pp

setring r4
<push_forward f p q
res q qq

type m
; a b c 
; d e f 

% betti mm
; total:      2     3     1 
; --------------------------
;     0:      2     3     - 
;     1:      -     -     1 

% degree mm.1
; codimension : 2
; degree      : 3

% type p
; b -ce               
; e bd-ae+be+ce+de+e2 

% betti pp
; total:      2     2 
; --------------------
;     0:      2     1 
;     1:      -     1 

% degree pp.1
; codimension : 1
; degree      : 3

% type q

% betti qq
; total:      3 
; --------------
;     0:      2 
;     1:      1 

% degree qq.1
; warning: no standard basis. Using initial terms of matrix
; codimension : 0
; degree      : 3



listvars
;;;;;;;; END push_forward ;;;;;;;;;;;;;

;;;;;;;; BEGIN push_forward1 ;;;;;;;;;;;
reset

;Sheaves on P1 x P1 (for an automated version of this,
;see the examples for the script from_bihomogeneous.)

ring r
;
4
x[1]-x[2]
y[1]-y[2];
;
;

cat x[1] xvars
0
0..1
cat y[1] yvars
0
0..1

transpose yvars yvars'
mult yvars' xvars zvars
flatten zvars f
type f

;The bihomogeneous ideal of a point:
ideal i
2
x[1]
y[1]

;Since 1 in r is of degree 0,0, we can take M0 = r/i
;and no modulo is necessary.

<ring 4 z[1,1]-z[2,2] s

<push_forward1
<push_forward1 f i N
nres N N
betti N ;the ideal of a point
; total:      1     3     3     1 
; --------------------------------
;     0:      1     3     3     1 


listvars
;;;;;;;; END push_forward1 ;;;;;;;;;;;;;

;;;;;;;; BEGIN radical ;;;;;;;;;;;
reset

<ring 4 a-z r
<ideal j a2 b2 c3 bc
<radical j i
type i
;b a c

listvars
;;;;;;;; END radical ;;;;;;;;;;;;;


;;;;;;;; BEGIN random_element ;;;;;;;;;;;
reset

<ring 3 a-z r
<ideal i a b2 c3
setdegs i
    2
    ;
<random_element i 4 x
type x
; -19/50a2+10113ab+12/19b2-14476ac 

betti x
; total:      1     1 
; --------------------
;     2:      1     - 
;     3:      -     1 

listvars
;;;;;;;; END random_element ;;;;;;;;;;;;;

;;;;;;;; BEGIN random_map ;;;;;;;;;;;
reset

<ring 3 a-z r
<powers r 3 i ;a Gorenstein ideal with socle a2b2c2
<random_map r i 5 f
type f
;0
<random_map r i 6 f
type f
; 12/19a2b2c2 

listvars
;;;;;;;; END random_map ;;;;;;;;;;;;;

;;;;;;;; BEGIN random_mat ;;;;;;;;;;;
reset

<ring 3 a-z r
power r 2 r2
setdegs r2
	4
	;

<random_mat
<random_mat 2 3 r2 m
type m
betti m


listvars
;;;;;;;; END random_mat ;;;;;;;;;;;;;

;;;;;;;; BEGIN rank_prob ;;;;;;;;;;;;;
reset
<ring 10 a-z r
koszul 3 2 m
type m
<rank_prob m n
type n
;2
listvars

;;;;;;;; End rank_prob ;;;;;;;;;;;

;;;;;;;; BEGIN rat_nor_curve ;;;;;;;;;;;;;
reset

<ring 4 a-z r
<column_vector P 1 2 4 5
type P

set prlevel 0

<rat_nor_curve P i m
type i
type m

listvars
;;;;;;;; End rat_nor_curve ;;;;;;;;;;;

;;;;;;;; BEGIN rat_nor_osc_locus ;;;;;;;;;;;;;
reset

<ring 4 a-z r
<rat_nor_osc_locus 1 3 I
betti I ;should give a quartic equation

listvars
;;;;;;;; End rat_nor_osc_locus ;;;;;;;;;;;

;;;;;;;; BEGIN regular_sequence ;;;;;;;;;;;
reset
<ring 4 a-z r
<ideal I a2b ac bc ad bd cd
<regular_sequence I F
type F
res F F
betti F

listvars
;;;;;;;; End regular_sequence ;;;;;;;;;;;

;;;;;;;; BEGIN regulariy ;;;;;;;;;;;
reset 

<powers r 3 r3
res r3 r3
<regularity r3 reg
type reg

listvars
;;;;;;;; End regularity ;;;;;;;;;;;

;;;;;;;; BEGIN remove_low_dim ;;;;;;;;;;;
reset

<ring 3 a-z r
<ideal i a2 b2
<ideal j a b c
power j 3 j
intersect i j i
type i
<remove_low_dim i ii
type ii
; a2 b2 

listvars
;;;;;;;; End remove_low_dim ;;;;;;;;;;;

;;;;;;;; BEGIN remove_lowest_dim ;;;;;;;;;;;
reset

<ring 3 a-z r
<ideal i a2 b2
<ideal j a b c
power j 3 j
intersect i j i
type i

<remove_lowest_dim i ii
type ii
; a2 b2 

listvars
;;;;;;;; End remove_lowest_dim ;;;;;;;;;;;

;;;;;;;; BEGIN representatives ;;;;;;;;;;;
reset

;An example where a does not contain b:

<ring 4 a-z r
<ideal i a+b+c+d a4+d4
<ideal j a+b c+d a3

<representatives
<representatives i j reps
type reps
; d4 


listvars
;;;;;;;; END representatives ;;;;;;;;;;;;;

;;;;;;;; BEGIN res_and_dim ;;;;;;;;;;;
reset
<ring 3 a-z r
<ideal i a2 ab ac
<res_and_dim i ir d
type d
;3
betti ir
; total:      1     3     3     1 
; --------------------------------
;     0:      1     -     -     - 
;     1:      -     3     3     1 
listvars
;;;;;;;; END res_and_dim ;;;;;;;;;;;

;;;;;;;; BEGIN res ;;;;;;;;;;;
reset

int a 2
int b 4
<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 m

res m mm
<res m mm 5 v
betti mm
; total:      1    10    25    25    10     1 
; --------------------------------------------
;     0:      1     -     -     -     -     - 
;     1:      -    10    16     9     -     - 
;     2:      -     -     9    16    10     - 
;     3:      -     -     -     -     -     1 

listvars
;;;;;;;; END res ;;;;;;;;;;;

;;;;;;;; BEGIN ribbon ;;;;;;;;;;;
reset


<ring 6 x[0]-x[8] r
<ideal ribbondata 1 2 0 ;genus 5  
<ribbon
<ribbon ribbondata test
res test w
betti w
; total:      1     5     5     1 
; --------------------------------
;     0:      1     -     -     - 
;     1:      -     3     2     - 
;     2:      -     2     3     - 

;     3:      -     -     -     1 
listvars
;;;;;;;; END ribbon ;;;;;;;;;;;;;

;;;;;;;; BEGIN ring ;;;;;;;;;;;
reset

<ring
<ring 9 ABCx[1,1]-x[2,3]a-z r  
pring
; current ring is r
; characteristic           : 31991
; number of variables      : 9
; variables                : ABCx[1,1]x[1,2]x[1,3]x[2,1]x[2,2]x[2,3]
; weights                  : 1 1 1 1 1 1 1 1 1 
; monomial order           : 9 c 
; top degree of a monomial : 43 

;ring only takes as many variables as it needs.
listvars
;;;;;;;; END ring ;;;;;;;;;;;;;

;;;;;;;; BEGIN sat ;;;;;;;;;;;
reset


<ring 3 a-z r
<ideal A a2 ab ac bc
<ideal f a+b+c

<sat
<sat A r L
type A
std L L
type L
; a bc 

listvars
;;;;;;;; END sat ;;;;;;;;;;;;;

;;;;;;;; BEGIN sat1 ;;;;;;;;;;;
reset

;; The normalization in A3 of the cuspidal cubic in A2
ring r
    ;
    3
    abx
    2 3 1
    ;
poly g a3-b2
qring g s

poly I ax-b
poly f a

<sat1
<sat1 I f J
type J
std J JJ
type JJ
; a-x2 b-x3     ;the affine twisted cubic


listvars
;;;;;;;; END sat1 ;;;;;;;;;;;;;

;;;;;;;; BEGIN scroll ;;;;;;;;;;;
reset

;The scrolls in P5:
<ring 6 a-z r

<scroll 1 3 i m ;S(1,3) = F_2
type m
type i

;check the error checking mechanism:
<ring 5 a-z r
<scroll 5 i m ;the rational normal curve

listvars
;;;;;;;; END scroll ;;;;;;;;;;;;;

;;;;;;;; BEGIN sort_by_degree ;;;;;;;;;;;
reset
<ring 3 a-z r
<ideal i a2 b c a3
col-degs i
;2 1 1 3

<sort_by_degree i j c

type j
; b c a2 a3 
col-degs j
;1 1 2 3

type c
; 0 0 1 0 
; 1 0 0 0 
; 0 1 0 0 
; 0 0 0 1 
col-degs c
row-degs c

mult i c test
type test
; b c a2 a3 
col-degs test
;1 1 2 3

betti i
; total:      1     4 
; --------------------
;     0:      1     2 
;     1:      -     1 
;     2:      -     1 
betti c
; total:      4     4 
; --------------------
;     0:      -     2 
;     1:      2     1 
;     2:      1     1 
;     3:      1     - 

listvars
;;;;;;;; END sort_by_degree ;;;;;;;;;;;;;

;;;;;;;; BEGIN stack ;;;;;;;;;;;

reset
<ring 3 a-z r
<ideal i1 0 b c2
<ideal i2 a2 b 0
<stack
<stack m
type m
betti m

<stack m i1 i2
type m
betti m

listvars
;;;;;;;; END stack ;;;;;;;;;;;;;

;;;;;;;; BEGIN submat_by_degs ;;;;;;;;;;;
reset

<ring 1 a r
iden 3 I

setdegs I
1 2 3
;
betti I

<submat_by_degs I 2 3 2 2 J rc cc
type J
betti J
; total:      2     1 
; --------------------
;     1:      -     1 
;     2:      1     - 
;     3:      1     - 

mult I cc J1
mult rc J1 J2
type J2
betti J2
; total:      2     1 
; --------------------
;     1:      -     1 
;     2:      1     - 
;     3:      1     - 

listvars
;;;;;;;; END submat_by_degs ;;;;;;;;;;;;;

;;;;;;;; BEGIN subring ;;;;;;;;;;;
reset

;The twisted cubic as 3-uple embedding:
<ring 2 st s
power s 3 F
type F

<ring 4 x[0]-x[3] r
set prlevel 0
setring r
<subring
<subring F k
type k
res k k
betti k
; total:      1     3     2 
; --------------------------
;     0:      1     -     - 
;     1:      -     3     2 


listvars
;;;;;;;; END subring ;;;;;;;;;;;;;

;;;;;;;; BEGIN to_div_powers ;;;;;;;;;;;
reset

<ring 3 xyz r
poly f x3+3x2y+3xy2+y3		;(x+y)^3
<to_div_powers
<to_div_powers f g
type g
; 6x3+6x2y+6xy2+6y3 		;3! (x+y)^(3)

<from_div_powers g h
type h
;Same as f

listvars
;;;;;;;; END to_div_powers ;;;;;;;;;;;;;

;;;;;;;; BEGIN tor ;;;;;;;;;;;
reset

;Intersection multiplicity according to Serre:
;The union of two planes in 4-space meeting another such
;(multiplicity must be 4 by obvious counting)

<ring 4 a-z r

<ideal i1 a b
<ideal i2 c d
intersect i1 i2 i

<random_mat 1 2 r j1   ;defines a random intersection of two planes
<random_mat 1 2 r j2
intersect j1 j2 j

<tor
<tor 0 i j e0
<tor 1 i j e1
<tor 2 i j e2
<tor 3 i j e3
<tor 4 i j e4

std e0 e0    ;tor 0 does not compute a standard basis itself
degree e0
degree e1
degree e2
degree e3
degree e4
% degree e0
; codimension : 4
; degree      : 7

% degree e1
; codimension : 4
; degree      : 4

% degree e2
; codimension : 4
; degree      : 1

% degree e3
; codimension : 4
; degree      : 0

;7-4+1 = 4 = the multiplicity!


listvars
;;;;;;;; END tor ;;;;;;;;;;;;;

;;;;;;;; BEGIN unmixed_radical ;;;;;;;;;;;
reset

<ring 3 a-z r
<ideal i a3 
<unmixed_radical i j verbose
type j
;a

listvars
;;;;;;;; END unmixed_radical ;;;;;;;;;;;;;

;;;;;;;; BEGIN wedge_cokernel ;;;;;;;;;;;
reset

<ring 3 a-z r
<ideal i a3 b5 c7
jacob i j
betti j
transpose j j
betti j
; total:      3     3 
; --------------------
;     1:      3     - 
;     2:      -     1 
;     3:      -     - 
;     4:      -     1 
;     5:      -     - 
;     6:      -     1 

<wedge_cokernel j 1 n
type n
; 3a2 0   0   
; 0   5b4 0   
; 0   0   7c6 

<wedge_cokernel j 2 n
betti n
; total:      3     9 
; --------------------
;     2:      3     - 
;     3:      -     3 
;     4:      -     - 
;     5:      -     3 
;     6:      -     - 
;     7:      -     3 

<wedge_cokernel j 4 n
type n
;nothing

listvars
;;;;;;;; END wedge_cokernel ;;;;;;;;;;;;;

;;;;;;;; BEGIN x_to_last ;;;;;;;;;;;
reset


<ring 8 a-h r

ideal y
1
a+b+c

ideal j
    2
    a-c+d
    b-e

<x_to_last
<x_to_last y ff gg
type ff
type gg
ev ff y z
type z
ev gg z y1
type y1
type ff
; -a-b a b+h c d e f g 

% type gg
; b -a-b d e f g h a+b+c 

% ev ff y z

% type z
; h 

% ev gg z y1

% type y1
; a+b+c 


listvars
;;;;;;;; END x_to_last ;;;;;;;;;;;;;

;;;;;;;; BEGIN zeromat ;;;;;;;;;;;
reset

<ring 4 a-d r
<zeromat
<zeromat 3 5 m
type m


listvars
;;;;;;;; END zeromat ;;;;;;;;;;;;;

