incr-set prlevel 1
if #0>=2 START 
incr-set prlevel -1
;;; Usage:
;;; 	<orbit_equations g J [maxdegree]
;;;
;;; computes the ideal J of equations defining the orbit of
;;; a homogeneous polynomial g under the general linear group.
;;;     If the argument maxdegree is present, it specifies the
;;; maximal total degree to which to carry the computation.  Thus if
;;; we wish to find a relation of degree n on the orbit of a d-ic
;;; polynomial, maxdegree should be set to dn.
;;;
;;; THE CURRENT RING MUST BE A RING
;;; WITH AT LEAST AS MANY VARIABLES AS 
;;; THE NUMBER OF COEFFICIENTS OF g.
incr-set prlevel 1
jump END
;;;
;;; Parameters:
;;;     g = 1x1 matrix containing the polynomial 
;;; (generally not over the current ring.)
;;;
;;;     maxdegree = maximum degree in which to look for 
;;;                 an equation.
;;;
;;; Output values:
;;;	    J = ideal in the current ring of polynomials
;;; vanishing on the closure of the orbit of g.
;;;
;;; The script applies a general 
;;;; change of variables to f and computes
;;; the equations satisfied by the new coefficients.
;;;
;;; Caveats:  
;;;     The polynomial must be homogeneous with all variables of
;;; degree 1.  The script runs quite slowly 
;;; in all but the smallest cases.
;;; Thus it is worth making sure that there are no extra variables in
;;; either the ring of f or the current ring, the ring representing
;;; the coefficients of the general form.
;
START:
; created May 3, 1989

;Get a handle to the current ring:
<getvars @curr

setring #1
nvars #1 @nvars
<copyring x @x
fetch #1 @g

;The space of @nvars x @nvars matrices
<ring @nvars*@nvars a[1,1]-a[@nvars,@nvars] @a

;The ring with the general translates
ring-sum @x @a @xa

;Make the general change of variable:
fetch @x @xvars
transpose @xvars @xvars
<generic_mat a[1,1] @nvars @nvars @M
mult @M @xvars @changedvars
transpose @changedvars @changedvars

;and apply it to g:
ev @changedvars @g @G

;Now extract the coefficient vector 
;with respect to the first block
;of variables, the variables in @g:
coef @G @monoms @coefs 

;and move them to a ring without the 
;extraneous x variables
;to make the computation more efficient:
setring @a
fetch @coefs @coefs 

;Compute the equations 
;by finding the relations on the coefficient vectors:
setring @curr

if #0=2 nobound
<subring @coefs #2 #3
jump cleanup
nobound:
<subring @coefs #2

cleanup:
kill @nvars @x'zero @x @g  @a'zero @a @xa'zero @xa 
kill @xvars @M  @changedvars @G @monoms @coefs @curr


END:
incr-set prlevel -1

$;;;;;;;; EXAMPLE SECTION ;;;;;;;;;;;;;;;;;;;;;;;;;

;Orbits of binary quadrics:

<ring 2 xy r
poly h1 x2  	;A perfect square:
poly h2 xy 		;Two distinct roots


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

;The conic as the variety of 
;perfect squares:
<orbit_equations
<orbit_equations h1 I1
type I1
;b2-4ac

<orbit_equations h1 J 4
type J


;The whole of P2
<orbit_equations h2 I2
type I2
;no equations
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;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 twisted cubic as the variety of 
;perfect cubes:
<orbit_equations h1 I1 6
res I1 I1
betti I1
degree I1.1

;The tangent developable surface to the twisted cubic
;(A quartic surface)
<orbit_equations h2 I2 12
res I2 I2
betti I2
degree I2.1

;The whole of 3-space:
<orbit_equations h3 I3
type I3

; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;Orbits of binary quartics:

;The twisted quartic as the variety of 
;perfect 4th powers:

;A quartic which is a perfect 4th power:
<ring 2 xy r
poly h x4
type h

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

setring s
<orbit_equations h I 
;Took 15 seconds (not any more! -- now about 2.5 secs)

res I I
betti I
; total:      1     6     8     3 
; --------------------------------
;     0:      1     -     -     - 
;     1:      -     6     8     3 

degree I.1
; codimension : 3
; degree      : 4


; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;The orbit of a quartic with 2 distinct roots (the tangent developable):

<ring 2 xy r
poly h x3y

<ring 5 a-z s
<orbit_equations h I
res I I
betti I
; total:      1     3     2 
; --------------------------
;     0:      1     -     - 
;     1:      -     1     - 
;     2:      -     1     1 
;     3:      -     1     1 

degree I.1
; codimension : 2
; degree      : 6

; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;The orbit of a quartic with 3 distinct roots (j = infinity):

<ring 2 xy r
poly h x2y(x+y)
type h

<ring 5 a-z s
set prlevel -3
<orbit_equations h Iinfty
% betti Iinfty
; total:      1     1 
; --------------------
;     0:      1     - 
;     1:      -     - 
;     2:      -     - 
;     3:      -     - 
;     4:      -     - 
;     5:      -     1 

type Iinfty
; b2c2d2-4ac3d2-4b3d3+18abcd3-27a2d4-4b2c3e+16ac4e+18b3cde-80abc2de-6ab2d2e \
;     +144a2cd2e-27b4e2+144ab2ce2-128a2c2e2-192a2bde2+9/125a3e3 

; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;The orbit of a quartic with 4 distinct roots, lambda = -1, j=1728:

<ring 2 xy r
poly h xy(x-y)(x+y)
type h

<ring 5 a-z s

set prlevel -3
<orbit_equations h I1728
betti I1728
; total:      1     1 
; --------------------
;     0:      1     - 
;     1:      -     - 
;     2:      -     1 

% type I1728
; c3-9/2bcd+27/2ad2+27/2b2e-36ace 

; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;The orbit of a quartic with 4 distinct roots, j = 0:

<ring 2 xy r
poly h (x3-y3)y
type h

<ring 5 a-z s

set prlevel -3
<orbit_equations h I0 
;this computation goes to degree 23, though only degree 8 is
;actually necessary.  Because of bad order??
betti I0
; total:      1     1 
; --------------------
;     0:      1     - 
;     1:      -     1 

type I0
% ; c2-3bd+12ae 

; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;Ternary cubics (elliptic curves)

<ring 3 xyz r
poly h0 x3+y3+z3      ; j = 0

<ring 10 a-z s

set prlevel -3
<orbit_equations h0 J0 12
betti J0
; total:      1     1 
; --------------------
;     0:      1     - 
;     1:      -     - 
;     2:      -     - 
;     3:      -     1 

type J0
; f4-8ef2g+16e2g2+24defh-8cf2h-16cegh+24bfgh-48ag2h+16c2h2-48bdh2-48de2i \
;     +24cefi-8bf2i-16begi+24afgi-16bchi+144adhi+16b2i2-48aci2-48c2ej+144bdej \
;     +24bcfj-216adfj-48b2gj+144acgj 

; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

<ring 3 xyz r
poly h1728 y2z-x3+xz2     ; j = 1728

<ring 10 a-z s

set prlevel -3
<orbit_equations h1728 J1728 18
;(got to 7170K, past degree 12, without finding the sextic)
;stop the calculation and try:
spairs @M ;to see how far you've got
space
elim @M t
type t
;If t is not empty, then save t in some readable format -- its the 
;answer! (It should be a sextic polynomial-- this will count as
;degree 18 in the big computation.)

betti J1728
type J1728
