incr-set prlevel 1
if #0=3 START
incr-set prlevel -1
;;; Usage:
;;;     <l_to_dual I d I'
;;;
;;; Compute the dual socle of a zero dimensional ideal I over the localization
;;; of the base ring of I at the homogeneous maximal ideal.
incr-set prlevel 1
jump END
;;; Parameters:
;;;   I = 1xn matrix of (inhomogeneous) polynomials
;;;   d = integer such that xi^d is in I, for each variable xi.
;;;
;;; Output values:
;;;   I' = 1xr matrix whose entries generate the inverse system (dual socle)
;;;        of I.
;;;
;;; See the script "l_from_dual" for definitions and notation.
;;; The inverse system is defined to be
;;;    I' = Hom_R(R/I, E).
;;; Let A = R/(x1^d, ..., xn^d), where x1, ..., xn are the variables of R.
;;; Then I' = Hom_A(A/I, E) = Hom_A(A/I, E1),
;;; where  E1 is the A-submodule of E generated by 1/(x1^(d-1)...xn^(d-1)),
;;; which is isomorphic to A.
;;;
;;; We compute the inverse system by first computing
;;;     Hom_A(A/I, A) = Ann_A(A/I),
;;; and then mapping the answer back into E, by "contracting" with the
;;; element 1/(x1^(d-1)...xn^(d-1)).
;;;
;;; Caveats:  The integer d must be correctly given, otherwise one
;;; may get only a "part" of the inverse system. On the other hand, this
;;; computes a filtration (by "d") of the inverse system, for any ideal I,
;;; not just zero dimensional ideals.
;;;
; last modified 5/23/89 MES
START:
     
; create the ideal J = (x1^d, ..., xn^d),
; and the "dual" element x1^(d-1)...xn^(d-1).
     
int @d #2
setring #1
<l_dual0 @d @J @dual
     
; homogenize for Macaulay, and work modulo the ideal "J":
     
qring @J @A
fetch #1 @I
<l_homog0 @I t[-100] @I  ; can be left out in the homogeneous case
     
; compute the annihilator of I in the ring A = R/J: (i.e. @quot.2)
     
transpose @I @I
res @I @quot 2
     
; find a minimal set of generators for @quot.2, where
; t[-100] has been set to 1.  Note that if the original ideal was
; homogeneous, then @quot.2 is already minimally generated,
; and these commands could be omitted.
     
stdpart @quot.2 @q ! t[-100]
<l_minimal0 @q @qmin
imap @f @qmin @A
    t[-100] 1
    ;
ev @f @qmin @qmin
     
; map the answer back into the module E, obtaining the "dual
; polynomials" generating the inverse system.
     
contract @qmin @dual #3
     
; the following cleans up somewhat
     
setdegs #3
    ;
    ;
     
kill @f @qmin @dual @q @quot @I @A @A'zero @J @d
     
END:
incr-set prlevel -1
     
$;;;;;;;; EXAMPLE SECTION ;;;;;;;;;;;;;;;;;;;;;;;;;
<ring 3 xyz r
ideal j
    3
    xz+y3
    yz+x3
    xz+yz-z2
<l_to_dual j 7 j'
putmat j'
listvars
<l_from_dual j' k
type k
     
;; test ;;;
<l_to_dual
<ring 3 xyz r
ideal j
    3
    x2
    y2
    z2
<l_to_dual j 4 j'
putmat j'
listvars
