Artifact b18aa02e5010f3ce130e0e8e8a06cd2f1c985fe565945ad910a52ef2d81662ed:



Codemist Standard Lisp 3.54 for DEC Alpha: May 23 1994
Dump file created: Mon May 23 10:39:11 1994
REDUCE 3.5, 15-Oct-93 ...
Memory allocation: 6023424 bytes

+++ About to read file tstlib.red



CALI 2.1. Last update 22/10/93
% Author H.-G. Graebe | Univ. Leipzig | Version 20.10.93
% graebe@informatik.uni-leipzig.d400.de

COMMENT

This is an example session demonstrating and testing the facilities
offered by the commutative algebra package CALI.

END COMMENT;


algebraic;


on echo;



% Example 1 : Generating ideals of affine and projective points.


    vars:={t,x,y,z};


vars := {t,x,y,z}

    setring(vars,degreeorder vars,revlex);


{{t,x,y,z},{{1,1,1,1}},revlex,{1,1,1,1}}

    mm:=mat((1,1,1,1),(1,2,3,4),(2,1,4,3));


      [1  1  1  1]
      [          ]
mm := [1  2  3  4]
      [          ]
      [2  1  4  3]



  % The ideal with zero set at the point in A^4 with coordinates
  % equal to the row vectors of mm :

    setideal(m1,affine_points mm);


  2
{x  - 3*x + 2,

  2
 t  - 3*t + 2,

 t*x - x - t + 1,

 z - 3*x - 2*t + 4,

 y - 2*x - 3*t + 4}


  % All parameters are as they should be :

    gbasis m1$


    dim m1;


0

    degree m1;


3

    groebfactor m1;


{{z - 1,y - 1,x - 1,t - 1},

 {z - 3,y - 4,x - 1,t - 2},

 {z - 4,y - 3,x - 2,t - 1}}

    resolve m1$


    bettinumbers m1;


{1,5,9,7,2}


  % The ideal with zero set at the point in P^3 with homogeneous 
  % coordinates equal to the row vectors of mm :

    setideal(m2,proj_points mm);


    2                      2
{2*y  - 7*t*y - 2*t*x + 7*t ,

                              2
 4*x*y - 5*t*y - 10*t*x + 11*t ,

    2                        2
 8*x  - 3*t*y - 18*t*x + 13*t ,

 z - y - x + t}


  % All parameters as they should be ?

    gbasis m2$


    dim m2;


1

    degree m2;


3

    groebfactor m2;


     2                      2
{{7*t  - 2*t*x - 7*t*y + 2*y ,

      2
  11*t  - 10*t*x - 5*t*y + 4*x*y,

      2                       2
  13*t  - 18*t*x - 3*t*y + 8*x ,

  t - x - y + z}}


  % It seems to be prime ?

    isprime m2;


no


  % Not, of course, but it is known to be unmixed. Hence we can use

    easyprimarydecomposition m2;


{{{ - 3*t + 2*z, - 2*t + y, - t + 2*x},

  { - 3*t + 2*z, - 2*t + y, - t + 2*x}},

 {{ - t + z, - t + y, - t + x},

  { - t + z, - t + y, - t + x}},

 {{ - 4*t + z, - 3*t + y, - 2*t + x},

  { - 4*t + z, - 3*t + y, - 2*t + x}}}


  
% Example 2 : 
% An affine monomial curve with generic point (t^7,t^9,t^10).

    setideal(m,affine_monomial_curve({7,9,10},{x,y,z}));


     3    3
{ - z  + x *y,

     2      4
  - y *z + x ,

  3      2
 y  - x*z }


  % The base ring was changed as side effect :

    getring();


{{x,y,z},{{7,9,10}},revlex,{7,9,10}}
 
    vars:=first getring m;


vars := {x,y,z}


  % Some advanced commutative algebra .
  % The analytic spread of m.

    analytic_spread m;


3


  % The Rees ring Rees_R(vars) over R=S/m.
    
    blowup(m,vars,{u,v,w});


  2        3
{u *v*x - w ,

  3      2
 u *x - v *w,

      2    2
 u*v*x  - w *z,

  2  2
 u *x  - v*w*y,

    3      2
 v*x  - w*z ,

    3      2
 u*x  - w*y ,

  3      3
 x *y - z ,

  4    2
 x  - y *z,

       2    3
  - u*w  + v ,

  2      2
 v *y - w *x,

    2
 v*y  - w*x*z,

       2    3
  - x*z  + y ,

 v*z - w*y,

 u*z - w*x,

 u*y - v*x}
 

  % gr_R(vars), the associated graded ring of the irrelevant ideal
  % over R. The short way.

    interreduce sub(x=0,y=0,z=0,ws);


  3  2         2    3
{w ,v *w, - u*w  + v }
 

  % The long (and more general) way. Gives the result in another
  % embedding. 
  
    % Reste the base ring, since it was changed by blowup as a side
    % effect.  
    setring getring m$


    assgrad(m,vars,{u,v,w});


  3
{w ,

  2
 v *w,

 z,

 y,

 x,

       2    3
  - u*w  + v }
 

  % Comparing the Rees algebra and the symmetric algebra of M :
  
    setring getring m$


    setideal(rees,blowup({},m,{a,b,c}));


     2      2      3
{ - y *a + z *b + x *c,

  - x*a + y*b + z*c,

  2        4      3      3
 y *z*a - x *a - z *b + x *y*b}

    setring getring m$


    setideal(sym,sym(m,{a,b,c}));


  2      2      3
{y *a - z *b - x *c,

 x*a - y*b - z*c}

    gbasis rees$

 gbasis sym$


    modequalp(rees,sym);


yes


  % Symbolic powers :

    setring getring m$


    setideal(m2,idealpower(m,2));


  6      3    3    6  2
{z  - 2*x *y*z  + x *y ,

  4  2      4  2      8
 y *z  - 2*x *y *z + x ,

  6        3  2    2  4
 y  - 2*x*y *z  + x *z ,

  2  4    3  3      4  3    7
 y *z  - x *y *z - x *z  + x *y,

  3  3      5    3  4    4    2
 y *z  - x*z  - x *y  + x *y*z ,

  5        2  3    4  3    5  2
 y *z - x*y *z  - x *y  + x *z }


  % Let's compute a second symbolic power :

    setideal(m3,symbolic_power(m,2));


  6      3    3    6  2
{z  - 2*x *y*z  + x *y ,

  4  2      4  2      8
 y *z  - 2*x *y *z + x ,

  6        3  2    2  4
 y  - 2*x*y *z  + x *z ,

    5    2  5      3  2  2    7
 y*z  + x *y  - 3*x *y *z  + x *z,

  2  4    3  3      4  3    7
 y *z  - x *y *z - x *z  + x *y,

  3  3      5    3  4    4    2
 y *z  - x*z  - x *y  + x *y*z ,

  5        2  3    4  3    5  2
 y *z - x*y *z  - x *y  + x *z }


  % It is different from the ordinary second power.
  % Hence m2 has a trivial component.

    gbasis m2$

 gbasis m3$


    modequalp(m2,m3);


no


  % Here is the primary decomposition :

    pd:=primarydecomposition m2;


          6  2      3    3    6
pd := {{{x *y  - 2*x *y*z  + z ,

          8      4  2      4  2
         x  - 2*x *y *z + y *z ,

          2  4        3  2    6
         x *z  - 2*x*y *z  + y ,

          7        3  2  2    2  5      5
         x *z - 3*x *y *z  + x *y  + y*z ,

          7      4  3    3  3      2  4
         x *y - x *z  - x *y *z + y *z ,

          4    2    3  4      5    3  3
         x *y*z  - x *y  - x*z  + y *z ,

          5  2    4  3      2  3    5
         x *z  - x *y  - x*y *z  + y *z},

             3      3
        { - x *y + z ,

             4    2
          - x  + y *z,

               2    3
          - x*z  + y }},

          6
       {{z ,

          2  4
         y *z ,

          3  3
         y *z ,

          4  2
         y *z ,

          5
         y *z,

          6
         y ,

         x},

        {z,y,x}}}


  % Compare the result with m2 :

    setideal(m4,matintersect(first first pd, first second pd));


  6      3    3    6  2
{z  - 2*x *y*z  + x *y ,

  4  2      4  2      8
 y *z  - 2*x *y *z + x ,

  6        3  2    2  4
 y  - 2*x*y *z  + x *z ,

      5    3  5      4  2  2    8
 x*y*z  + x *y  - 3*x *y *z  + x *z,

  2  4    3  3      4  3    7
 y *z  - x *y *z - x *z  + x *y,

  3  3      5    3  4    4    2
 y *z  - x*z  - x *y  + x *y*z ,

  5        2  3    4  3    5  2
 y *z - x*y *z  - x *y  + x *z }

    gbasis m4$


    modequalp(m2,m4);


yes


  % Compare the result with m3 :

    setideal(m4,first first pd)$


    gbasis m4$


    modequalp(m3,m4);


yes


  % The trivial component can also be removed with a 
  % stable quotient computation :

    setideal(m5,matstabquot(m2,vars))$


    gbasis m5$


    modequalp(m3,m5);


yes



% Example 3 : The Macaulay curve.

    setideal(m,proj_monomial_curve({0,1,3,4},{w,x,y,z}));


  3      2
{y  - x*z ,

  2        2
 x *z - w*y ,

  3    2
 x  - w *y,

 x*y - w*z}

    vars:=first getring();


vars := {w,x,y,z}

    gbasis m;


  3      2
{y  - x*z ,

  2        2
 x *z - w*y ,

  3    2
 x  - w *y,

 x*y - w*z}

 
  % Test whether m is prime :

    isprime m;


yes


  % A resolution of m :
    
    resolve m;


{

 [  3      2 ]
 [ y  - x*z  ]
 [           ]
 [ 2        2]
 [x *z - w*y ]
 [           ]
 [  3    2   ]
 [ x  - w *y ]
 [           ]
 [ x*y - w*z ]

 ,


 [                2 ]
 [x  z   0     - y  ]
 [                  ]
 [w  y   0     - x*z]
 [                  ]
 [0  x   - z   w*y  ]
 [                  ]
 [               2  ]
 [0  w   - y    x   ]

 ,


 [w   - x  y   - z]

 ,


 [0]

 }


  % m has depth = 1 as can be seen from the 
    
    gradedbettinumbers m;


{{0},{2,3,3,3},{4,4,4,4},{5}}
 

  % Another way to see the non perfectness of m :
    
    hilbseries m;


     3      2
  - w  + 2*w  + 2*w + 1
------------------------
       2
      w  - 2*w + 1
 

  % Just a third approach. Divide out a parameter system :

    ps:=for i:=1:2 collect random_linear_form(vars,1000);


ps := {274*w + 842*x - 589*y - 453*z,2*(105*w + 27*x + 33*y + 170*z)}

    setideal(m1,matsum(m,ps))$

 gbasis m1$


 
    % dim should be zero and degree > degree m = 4.
    dim m1;


0
 
    degree m1;


5
 

  % The projections of m on the coord. hyperplanes.
 
    for each x in vars collect eliminate(m,{x});


        2    3
{{ - x*z  + y },

        3    4
 { - w*z  + y },

      3      4
 { - w *z + x },

      2      3
 { - w *y + x }}
 

% Example 4 : Two submodules of S^4.
  
  % Get the stored result of the earlier computation.

    r:=resolve m$



  % See whether cali!=degrees contains a relict from earlier
  % computations.  
  
    getdegrees();


{}


  % Introduce the 2nd and 3rd syzygy module as new modules.
  % Both are submodules in S^4.

    setmodule(m1,second r)$

 setmodule(m2,third r)$

 
    gbasis m1;


[                                            2 ]
[    - x           - z            0         y  ]
[                                              ]
[    - w           - y            0         x*z]
[                                              ]
[     0            x              - z       w*y]
[                                              ]
[                                            2 ]
[     0            w              - y       x  ]
[                                              ]
[    w*x       x*y + w*z         - y*z       0 ]
[                                              ]
[               3    2          2        2     ]
[     0        x  - w *y     - x *z + w*y    0 ]
[                                              ]
[    2         2        2            2         ]
[   w *y      x *z + w*y        - x*z        0 ]
[                                              ]
[     3        2        2           3          ]
[    x        x *z + w*y         - y         0 ]
[                                              ]
[ 2        2      3      2                     ]
[x *z - w*y    - y  + x*z         0          0 ]

 
 
  % The second is already a gbasis.

    setgbasis m2;


[w   - x  y   - z]

 
    getleadterms m1;


[              2 ]
[ 0    0   0  y  ]
[                ]
[ 0    0   0  x*z]
[                ]
[ 0    0   0  w*y]
[                ]
[              2 ]
[ 0    0   0  x  ]
[                ]
[w*x   0   0   0 ]
[                ]
[       3        ]
[ 0    x   0   0 ]
[                ]
[ 2              ]
[w *y  0   0   0 ]
[                ]
[  3             ]
[ x    0   0   0 ]
[                ]
[ 2              ]
[x *z  0   0   0 ]

 getleadterms m2;


[w  0  0  0]



  % Since rk(F/M)=rk(F/in(M)), they have ranks 1 resp. 3.

    dim m1;


4

    indepvarsets m1;


{{w,x,y,z}}


  % Its intersection is zero :

    matintersect(m1,m2);


[0  0  0  0]



  % Its sum :
 
    setmodule(m3,matsum(m1,m2));


[                         2   ]
[ - x     - z     0      y    ]
[                             ]
[                         2   ]
[ 0       w       - y    x    ]
[                             ]
[ 0       x       - z    w*y  ]
[                             ]
[ w       - x     y      - z  ]
[                             ]
[ 0     - y - x   y    x*z - z]


    gbasis m3;


                  2
mat(( - x, - z,0,y ),

               2
    (0,w, - y,x ),

    (0,x, - z,w*y),

    (w, - x,y, - z),

        3    2       2        2
    (0,x  - w *y, - x *z + w*y ,0),

    (0, - y - x,y,x*z - z),

          3      3        3        2        2    2  2              2
    (0,0,x *z - x *y - w*y  + w*x*z  - w*x*y  + w *y  + x*y*z - w*z ,

     0),

              2
    (0,x*y + x  + w*z + y + x, - y*z - x*y - y,z),

        2        2      2    2
    (0,x *z + w*y  - w*x  - w *z - x*z - w*y - w*x,

           2              2            2
      - x*z  + w*y*z - w*y  + w*x*y + z  + w*y, - w*z),

      3    2    2
    (x ,w*x  + w *z + x*z + w*y + w*x,

         3      2              2            2
      - y  + x*z  - w*y*z + w*y  - w*x*y - z  - w*y,w*z),

      2
    (x *z - x*z,

         3      2                    2      2    2    2
      - y  + x*z  + w*y*z - w*x*z - w *y - z  + y  - x  - y - x,

         2      3              2    2      2        2    2
      - y *z + y  + x*y*z - x*y  - x *z + x *y + w*y  - y  + x*y + y,

     y*z - z),

          3        2      2        2        3          2        2
    (0,w*y  - w*x*z  - 2*w *y*z + w *x*z + w *y + 2*w*z  - 2*w*y

             2    2                                     2  2    2
      + 2*w*x  + w *z + y*z + 3*x*z + 2*w*y + 2*w*x, - x *z  + x *y*z

             2        3                  2      2        2      2  2
      + 2*w*y *z - w*y  - w*x*y*z + w*x*y  + w*x *z - w*x *y - w *y

           2      2                        2                2
      - y*z  + x*z  - x*y*z - w*y*z + 2*w*y  - 2*w*x*y - 2*z  - y*z

               2
      - 2*w*y,z  + 2*w*z))


    dim m3;


3


  % Hence it has a nontrivial annihilator :

    annihilator m3;


  2  2        2        2      3      2    3      3
{w *y  - w*x*y  + w*x*z  - w*y  - w*z  - x *y + x *z + x*y*z}

 
  % To get a meaningful Hilbert series make m1 homogeneous :
 
    setdegrees {1,x,x,x};


{1,x,x,x}
 
 
  % Reevaluate m1 with the new column degrees. 

    setmodule(m1,m1)$


    gbasis m1;


[                                              2 ]
[      - x           - z            0         y  ]
[                                                ]
[      - w           - y            0         x*z]
[                                                ]
[      0              x             - z       w*y]
[                                                ]
[                                              2 ]
[      0              w             - y       x  ]
[                                                ]
[     w*x         x*y + w*z        - y*z       0 ]
[                                                ]
[                  3    2         2        2     ]
[      0          x  - w *y    - x *z + w*y    0 ]
[                                                ]
[      2          2        2           2         ]
[     w *y       x *z + w*y       - x*z        0 ]
[                                                ]
[     3    2                     3      2        ]
[  - x  + w *y        0         y  - x*z       0 ]
[                                                ]
[    2        2    3      2                      ]
[ - x *z + w*y    y  - x*z          0          0 ]


    hilbseries m1;


  7      6      5      4      3
 w  - 5*w  + 8*w  - 2*w  - 5*w  + 3*w + 1
------------------------------------------
         4      3      2
        w  - 4*w  + 6*w  - 4*w + 1


% Example 5 : From the MACAULAY manual (D.Bayer, M.Stillman).
% An elliptic curve on the Veronese in P^5.

    rvars:={x,y,z}$

 svars:={a,b,c,d,e,f}$


    r:=setring(rvars,degreeorder rvars,revlex)$


    s:=setring(svars,{for each x in svars collect 2},revlex)$


    map:={s,r,{a=x^2,b=x*y,c=x*z,d=y^2,e=y*z,f=z^2}};


map := {{{a,

          b,

          c,

          d,

          e,

          f},

         {{2,2,2,2,2,2}},

         revlex,

         {1,1,1,1,1,1}},

        {{x,y,z},

         {{1,1,1}},

         revlex,

         {1,1,1}},

            2
        {a=x ,

         b=x*y,

         c=x*z,

            2
         d=y ,

         e=y*z,

            2
         f=z }}

    preimage({y^2z-x^3-x*z^2},map);


{ - b*f + c*e,

           2
  - a*f + c ,

  - a*e + b*c,

           2
  - a*d + b ,

                 2
  - a*c - c*f + e ,

  - a*c - c*f + d*f,

  - a*b - b*f + d*e,

     2
  - a  - a*f + c*d,

     2
  - a  - a*f + b*e}


% Example 6 : The preimage under a rational map.

    r:=setring({x,y},{},lex)$

 s:=setring({t},{},lex)$


    map:={r,s,{x=2t/(t^2+1),y=(t^2-1)/(t^2+1)}};


map := {{{x,y},{},lex,{1,1}},

        {{t},{},lex,{1}},

                        2
             2*t       t  - 1
        {x=--------,y=--------}}
             2          2
            t  + 1     t  + 1

  
  % The preimage of (0) is the equation of the circle :

    ratpreimage({},map);


  2    2
{x  + y  - 1}


  % The preimage of the point (t=3/2) :

    ratpreimage({2t-3},map);


{13*y - 5,13*x - 12}



% Example 7 : A zerodimensional ideal.

    setring({x,y,z},{},lex)$


    setideal(n,{x**2 + y + z - 3,x + y**2 + z - 3,x + y + z**2 - 3});


  2                  2                  2
{x  + y + z - 3,x + y  + z - 3,x + y + z  - 3}


  % The groebner algorithm with factorization :

    groebfactor n;


                       2
{{x + z - 1,y + z - 1,z  - 2*z - 1},

         2
 {x - z,z  - 2,y + z - 1},

         2
 {y - z,z  - 2,x + z - 1},

 {x + 3,y + 3,z + 3},

 {x - 1,y - 1,z - 1}}


  % Change the term order and reevaluate n :

    setring({x,y,z},{{1,1,1}},revlex)$


    setideal(n,n);


  2              2              2
{x  + z + y - 3,y  + z + x - 3,z  + y + x - 3}

    gbasis n;


  2              2              2
{z  + y + x - 3,y  + z + x - 3,x  + z + y - 3}


  % its primes :
 
    zeroprimes n;


   2
{{x  - 2, - x + y,x + z - 1},

   2
 {x  - 2, - x + z,x + y - 1},

   2
 {x  - 2*x - 1,x + z - 1,x + y - 1},

 {z + 3,y + 3,x + 3},

 {z - 1,y - 1,x - 1}}


  % a vector space basis of S/n :

    getkbase n;


{1,x,x*y,x*y*z,x*z,y,y*z,z}


% Example 8 : A modular computation.

    on modular$


    setmod 181;


1
 setideal(n1,n);


  2                2                2
{x  + z + y + 178,y  + z + x + 178,z  + y + x + 178}
 zeroprimes n1;


   2
{{x  + 179,180*(x + 180*y),x + z + 180},

   2
 {x  + 179,180*(x + 180*z),x + y + 180},

   2
 {x  + 179*x + 180,x + z + 180,x + y + 180},

 {z + 180,y + 180,x + 180},

 {z + 3,y + 3,x + 3}}

    setmod 7;


181
 setideal(n1,n);


  2              2              2
{x  + z + y + 4,y  + z + x + 4,z  + y + x + 4}
 zeroprimes n1;


{{z + 6,y + 6,x + 6},

 {z + 4,y + 4,x + 2},

 {z + 4,y + 2,x + 4},

 {z + 2,y + 4,x + 4},

 {z + 3,y + 3,x + 3}}

 
  % Hence some of the primes glue together mod 7.

    zeroprimarydecomposition n1;


{{{z + 6,y + 6,x + 6},

  {z + 6,y + 6,x + 6}},

 {{z + 4,y + 4,x + 2},

  {z + 4,y + 4,x + 2}},

 {{z + 4,y + 2,x + 4},

  {z + 4,y + 2,x + 4}},

 {{z + 2,y + 4,x + 4},

  {z + 2,y + 4,x + 4}},

            2
 {{x + y + z  + 4,

        2
   x + y  + z + 4,

    2
   x  + y + z + 4,

   3*(x + 5*y*z + 2*y + 2*z + 5),

   x*z + 6*x + 3*y + 6*z + 1,

   x*y + 6*x + 6*y + 3*z + 1},

  {z + 3,y + 3,x + 3}}}

    off modular$



% Example 9 : Independent sets once more.
  
    n:=10$


    vars:=for i:=1:(2*n) collect mkid(x,i)$


    setring(vars,{},lex)$


    setideal(m,for j:=0:n collect 
            for i:=(j+1):(j+n) product mkid(x,i));


{x1*x2*x3*x4*x5*x6*x7*x8*x9*x10,

 x2*x3*x4*x5*x6*x7*x8*x9*x10*x11,

 x3*x4*x5*x6*x7*x8*x9*x10*x11*x12,

 x4*x5*x6*x7*x8*x9*x10*x11*x12*x13,

 x5*x6*x7*x8*x9*x10*x11*x12*x13*x14,

 x6*x7*x8*x9*x10*x11*x12*x13*x14*x15,

 x7*x8*x9*x10*x11*x12*x13*x14*x15*x16,

 x8*x9*x10*x11*x12*x13*x14*x15*x16*x17,

 x9*x10*x11*x12*x13*x14*x15*x16*x17*x18,

 x10*x11*x12*x13*x14*x15*x16*x17*x18*x19,

 x11*x12*x13*x14*x15*x16*x17*x18*x19*x20}

    setgbasis m$


    indepvarsets m;


{{x2,x3,x4,x5,x6,x7,x8,x9,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x3,x4,x5,x6,x7,x8,x9,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x4,x5,x6,x7,x8,x9,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x5,x6,x7,x8,x9,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x6,x7,x8,x9,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x7,x8,x9,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x8,x9,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x9,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x10,x12,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x9,x12,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x3,x4,x5,x6,x7,x8,x9,x10,x11,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x4,x5,x6,x7,x8,x9,x10,x11,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x5,x6,x7,x8,x9,x10,x11,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x6,x7,x8,x9,x10,x11,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x7,x8,x9,x10,x11,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x8,x9,x10,x11,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x9,x10,x11,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x10,x11,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x13,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x4,x5,x6,x7,x8,x9,x10,x11,x12,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x5,x6,x7,x8,x9,x10,x11,x12,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x6,x7,x8,x9,x10,x11,x12,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x7,x8,x9,x10,x11,x12,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x8,x9,x10,x11,x12,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x9,x10,x11,x12,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x10,x11,x12,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x12,x14,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x5,x6,x7,x8,x9,x10,x11,x12,x13,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x6,x7,x8,x9,x10,x11,x12,x13,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x7,x8,x9,x10,x11,x12,x13,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x8,x9,x10,x11,x12,x13,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x9,x10,x11,x12,x13,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x10,x11,x12,x13,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x12,x13,x15,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x6,x7,x8,x9,x10,x11,x12,x13,x14,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x7,x8,x9,x10,x11,x12,x13,x14,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x8,x9,x10,x11,x12,x13,x14,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x9,x10,x11,x12,x13,x14,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x10,x11,x12,x13,x14,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x12,x13,x14,x16,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x7,x8,x9,x10,x11,x12,x13,x14,x15,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x8,x9,x10,x11,x12,x13,x14,x15,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x9,x10,x11,x12,x13,x14,x15,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x10,x11,x12,x13,x14,x15,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x12,x13,x14,x15,x17,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x8,x9,x10,x11,x12,x13,x14,x15,x16,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x9,x10,x11,x12,x13,x14,x15,x16,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x10,x11,x12,x13,x14,x15,x16,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x12,x13,x14,x15,x16,x18,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x9,x10,x11,x12,x13,x14,x15,x16,x17,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x10,x11,x12,x13,x14,x15,x16,x17,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x12,x13,x14,x15,x16,x17,x19,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x10,x11,x12,x13,x14,x15,x16,x17,x18,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x12,x13,x14,x15,x16,x17,x18,x20},

 {x1,x2,x3,x4,x5,x6,x7,x8,x9,x11,x12,x13,x14,x15,x16,x17,x18,x19}}

    dim m;


18

    degree m;


55



% Example 10 : An example from [ Alonso, Mora, Raimondo ] 

    vars := {z,x,y}$


    r:=setring(vars,{},lex)$


    setideal(m,{x^3+(x^2-y^2)*z+z^4,y^3+(x^2-y^2)*z-z^4});


  4      2      2    3
{z  + z*x  - z*y  + x ,

     4      2      2    3
  - z  + z*x  - z*y  + y }

    gbasis m$


    dim m;


1

    degree m;


12


  % 2 = codim m is the codimension of the curve m. The defining 
  % equations of the singular locus with their nilpotent structure.

    singular_locus(m,2);


    4    3    3
{2*z  + x  - y ,

     3  2      3        2  2       4
 12*z *y  + 8*x *y + 3*x *y  - 11*y ,

      2        2    3    3
 2*z*x  - 2*z*y  + x  + y ,

        2        3    3        2  2    4
 2*z*x*y  - 2*z*y  + x *y + 3*x *y  + y ,

     2  3         4      5      4         4       3  2       3
 24*z *y  - 42*z*y  + 3*x  + 3*x *y + 22*x  + 18*x *y  + 16*x *y

        2  3        4         3       5       4
  + 21*x *y  + 3*x*y  - 16*x*y  + 18*y  - 22*y }
 
    groebfactor ws;


{{z,x,y},

 {27*z - 64,81*x + 256,81*y - 256}}
 

  % Hence this curve has two singular points : 
  % (x=y=z=0) and (y=-x=256/81,z=64/27)
  % Let's find the brances of the curve through the origin.
  % The first critical tropism is (-1,-1,-1).

    off noetherian$


    setring(vars,{{-1,-1,-1}},lex)$


    setideal(m,m);


    2      2    3    4
{z*x  - z*y  + x  + z ,

    2      2    3    4
 z*x  - z*y  + y  - z }

    % Let's test Lazard's approach.
    off lazy$


    gbasis m;


  3    3      4
{x  - y  + 2*z ,

    2      2    3    4
 z*x  - z*y  + y  - z ,

      2      3      3      5    4
 z*x*y  - z*y  - x*y  + 2*z  + z *x,

  2  3      4    5      5        5      4  2    4        4  2
 x *y  + x*y  + y  - 2*z *x - 2*z *y - z *x  - z *x*y - z *y ,

      5        5      6      6        6        5          5  2
 6*z*y  + 2*x*y  - 2*y  - 4*z *x - 4*z *y - 2*z *x*y - 8*z *y

     4  3      4    2      4  3
  + z *x  - 2*z *x*y  + 3*z *y }

    dim m;


1

    degree m;


9


  % Find the tangent directions not in z-direction :

    tangentcone m;


  3    3
{x  - y ,

    2      2    3
 z*x  - z*y  + y ,

      2      3      3
 z*x*y  - z*y  - x*y ,

  2  3      4    5
 x *y  + x*y  + y ,

      5        5      6
 6*z*y  + 2*x*y  - 2*y }
 
    setideal(n,sub(z=1,ws));


  3    3
{x  - y ,

  2    2    3
 x  - y  + y ,

    2    3      3
 x*y  - y  - x*y ,

  2  3      4    5
 x *y  + x*y  + y ,

    5        5      6
 6*y  + 2*x*y  - 2*y }

    setring r$

 on noetherian$

 setideal(n,n)$


    gbasis n;


  7      6      5
{y  - 3*y  + 3*y ,

  2    3    2
 x  + y  - y ,

    2    6      5    4    3
 x*y  - y  + 2*y  - y  - y }

    degree n;


9


  % The points of n outside the origin.

    matstabquot(n,{x,y});


            2
{x - y + 3,y  - 3*y + 3}
 

  % Hence there are two branches x=z'*(a-3+x'),y=z'*(a+y'),z=z'
  % with the algebraic number a : a^2-3a+3=0
  % and the new equations for (z',x',y') :

    setrules {a^2=>3a-3};


  2
{a  => 3*a - 3}

    sub(x=z*(a-3+x),y=z*(a+y),m);


  3   3      2        2        2                            3      2
{z *(a  + 3*a *x - 9*a  + 3*a*x  - 16*a*x - 2*a*y + 21*a + x  - 8*x

                2
      + 21*x - y  + z - 18),

  3   3      2                  2                  2          3    2
 z *(a  + 3*a *y + 2*a*x + 3*a*y  - 2*a*y - 6*a + x  - 6*x + y  - y

      - z + 9)}

    setideal(m1,matqquot(ws,z));


  3              2                  3              2
{x  + (3*a - 7)*x  - (5*a - 6)*x + y  + (3*a - 2)*y  + (5*a - 9)*y,

      2                  3              2
 z - x  - (2*a - 6)*x - y  - (3*a - 1)*y  - (7*a - 9)*y}


  % This defines a loc. smooth system at the origin, since the
  % jacobian at the origin of the gbasis is nonsingular :

    off noetherian$


    % Test Mora's approach.
    on lazy$


    setring getring m;


{{z,x,y},{{-1,-1,-1}},lex,{1,1,1}}

    setideal(m1,m1);


                                           2              2    3    3
{ - (5*a - 6)*x + (5*a - 9)*y + (3*a - 7)*x  + (3*a - 2)*y  + x  + y

 ,

                                  2              2    3
 z - (2*a - 6)*x - (7*a - 9)*y - x  - (3*a - 1)*y  - y }

    gbasis m1;


                                  2              2    3
{z - (2*a - 6)*x - (7*a - 9)*y - x  - (3*a - 1)*y  - y ,

                                           2              2    3    3
  - (5*a - 6)*x + (5*a - 9)*y + (3*a - 7)*x  + (3*a - 2)*y  + x  + y

 }


    % clear the rules previously set.
    setrules {};


{}
 


% Example 11 : The standard basis of another example. 
% Comparing Mora's and Lazard's approaches.

    vars:={x,y}$


    setring(vars,localorder vars,lex);


{{x,y},{{-1,-1}},lex,{1,1}}

    ff:=x^5+y^11+(x+x^3)*y^9;


       5    3  9      9    11
ff := x  + x *y  + x*y  + y

    setideal(p,flatten matjac({ff},vars));


    4    9      2  9
{5*x  + y  + 3*x *y ,

      8       10      3  8
 9*x*y  + 11*y   + 9*x *y }


  % Mora's approach : Only top reduction allowed.
  
    gbasis p;


      8       10      3  8
{9*x*y  + 11*y   + 9*x *y ,

    4    9      2  9
 5*x  + y  + 3*x *y ,

        16           7  10           3  14         17          10  8
 73205*y   - 120285*x *y   + 239580*x *y   + 6561*y   - 32805*x  *y

            6  12          2  17
  + 147015*x *y   + 19683*x *y  }


  % Lazard's approach : Total normal forms of homogenized polynomials
  % allowed. Hence the computation produces other normal forms.

    off lazy;


    setideal(p,p)$


    gbasis p;


    4    9      2  9
{5*x  + y  + 3*x *y ,

      8       10      3  8
 9*x*y  + 11*y   + 9*x *y ,

        16         17          10  8           6  12           2  16
 73205*y   + 6561*y   - 32805*x  *y  + 294030*x *y   - 292820*x *y

            9  10           5  14          2  17
  + 120285*x *y   - 239580*x *y   + 19683*x *y  }


    dim p;


0

    degree p;


40


% Example 12 : A local intersection.

    setring({x,y,z},{},revlex);


{{x,y,z},{},revlex,{1,1,1}}

    on lazy;


    m1:=matintersect({x-y^2,y-x^2},{x-z^2,z-x^2},{y-z^2,z-y^2});


              2  2    3        3  2  2
m1 := {y*z - y *z  - x *y*z + x *y *z ,

                2    4      4  2
       x*z - x*y  - x *z + x *y ,

                2      4      4  2
       x*y - x*y *z - x *y + x *y *z}

  
  % Delete polynomial units post factum :
  
    deleteunits ws;


         2
{y*z,x*(y  - z),x*y}

    interreduce ws;


{x*y,x*z,y*z}


  % Detecting polynomial units early :

    on detectunits;


    m1:=matintersect({x-y^2,y-x^2},{x-z^2,z-x^2},{y-z^2,z-y^2});


m1 := {x*y,x*z,y*z}

    off detectunits;



  % Return to a noetherian term order:
   
    vars:={x,y,z}$


    setring(vars,degreeorder vars,revlex);


{{x,y,z},{{1,1,1}},revlex,{1,1,1}}

    on noetherian;



% Example 13 : Use of "mod".

  % Polynomials modulo ideals :

    setideal(m,{2x^2+y+5,3y^2+z+7,7z^2+x+1});


    2            2            2
{2*x  + y + 5,3*y  + z + 7,7*z  + x + 1}

    x^2*y^2*z^2 mod m;


  - x*y*z - 7*x*y - 5*x*z - 35*x - y*z - 7*y - 5*z - 35
--------------------------------------------------------
                           42


  % Lists of polynomials modulo ideals :

    {x^3,y^3,z^3} mod gbasis m;


  x*( - y - 5)   y*( - z - 7)    - z*(x + 1)
{--------------,--------------,--------------}
       2              3              7


  % Matrices modulo modules :

    mm:=mat((x^4,y^4,z^4));


      [ 4   4   4]
mm := [x   y   z ]


    mm1:=tp<< ideal2mat m>>;


       [   2             2                 2    ]
mm1 := [2*x  + y + 5  3*y  + z + 7  x + 7*z  + 1]


    mm mod mm1;


       2
      y  + 10*y + 25         2  2      2         2      4      3
mat((----------------,( - 6*x *y  - 2*x *z - 14*x  + 4*y  + 3*y
            4

               2                                  3       2  2      2
         + 15*y  + y*z + 7*y + 5*z + 35)/4,( - 2*x  - 14*x *z  - 2*x

                            2          4       2
         + x*y + 5*x + 7*y*z  + y + 4*z  + 35*z  + 5)/4))



% Example 14 : Powersums through elementary symmetric functions.

    vars:={a,b,c,d,e1,e2,e3,e4}$


    setring(vars,{},lex)$


    m:=interreduce {a+b+c+d-e1,
        a*b+a*c+a*d+b*c+b*d+c*d-e2,
        a*b*c+a*b*d+a*c*d+b*c*d-e3,
        a*b*c*d-e4};


m := {a + b + c + d - e1,

       4    3       2
      d  - d *e1 + d *e2 - d*e3 + e4,

       2                       2                 2
      b  + b*c + b*d - b*e1 + c  + c*d - c*e1 + d  - d*e1 + e2,

       3    2      2         2                    3    2
      c  + c *d - c *e1 + c*d  - c*d*e1 + c*e2 + d  - d *e1 + d*e2

       - e3}

    
    for n:=1:5 collect a^n+b^n+c^n+d^n mod m;


{e1,

   2
 e1  - 2*e2,

   3
 e1  - 3*e1*e2 + 3*e3,

   4       2                    2
 e1  - 4*e1 *e2 + 4*e1*e3 + 2*e2  - 4*e4,

   5       3          2             2
 e1  - 5*e1 *e2 + 5*e1 *e3 + 5*e1*e2  - 5*e1*e4 - 5*e2*e3}
    

% Example 15 : The setrules mechanism. 

    setring({x,y,z},{},lex)$


    setrules {aa^3=>aa+1};


   3
{aa  => aa + 1}

    setideal(m,{x^2+y+z-aa,x+y^2+z-aa,x+y+z^2-aa});


  2                   2                   2
{x  + y + z - aa,x + y  + z - aa,x + y + z  - aa}

    gbasis m;


  2        2
{y  - y - z  + z,

  6               4      3        2              2
 z  - (3*aa + 1)*z  + 4*z  + (3*aa  - 2*aa - 2)*z  - (4*aa - 4)*z

         2
  + (3*aa  - 3*aa - 1),

          2
 x + y + z  - aa,

      2                   4               2      2
 2*y*z  - (2*aa - 2)*y + z  - (2*aa - 1)*z  + (aa  - aa)}

    
    % Clear the rules previously set.
    setrules {};


{}


% Example 16 : The same example with advanced coefficient domains.

    load arnum;


    defpoly aa^3-aa-1;


    setideal(m,{x^2+y+z-aa,x+y^2+z-aa,x+y+z^2-aa});


  2                   2                   2
{x  + y + z - aa,x + y  + z - aa,x + y + z  - aa}

    gbasis m;


  2        2
{y  - y - z  + z,

  6               4      3        2              2
 z  - (3*aa + 1)*z  + 4*z  + (3*aa  - 2*aa - 2)*z  - (4*aa - 4)*z

         2
  + (3*aa  - 3*aa - 1),

          2
 x + y + z  - aa,

    2                 1   4          1    2     1    2    1
 y*z  - (aa - 1)*y + ---*z  - (aa - ---)*z  + (---*aa  - ---*aa)}
                      2              2          2         2


  % The following needs some more time since factorization of arnum's
  % is not so easy :

    groebfactor m;


         2
{{x + (aa  - aa - 1),

         2
  y - (aa  - aa),

         2
  z + (aa  - aa - 1)},

         2
 {x - (aa  - aa - 1),

         2
  y - (aa  - aa - 1),

         2
  z + (aa  - aa - 2)},

         2
 {x - (aa  - aa - 1),

         2
  y + (aa  - aa - 2),

         2
  z - (aa  - aa - 1)},

         2
 {x + (aa  - aa - 1),

         2
  y + (aa  - aa - 1),

         2
  z - (aa  - aa)},

               2
 {x - z,y - z,z  + 2*z - aa},

         2
 {x - (aa  - aa),

         2
  y + (aa  - aa - 1),

         2
  z + (aa  - aa - 1)},

         2
 {x + (aa  - aa - 2),

         2
  y - (aa  - aa - 1),

         2
  z - (aa  - aa - 1)}}

    off arnum;


    off rational;



% Example 17 : The square of the 2-minors of a symmetric 3x3-matrix.

    vars:=for i:=1:6 collect mkid(x,i);


vars := {x1,

         x2,

         x3,

         x4,

         x5,

         x6}

    setring(vars,degreeorder vars,revlex);


{{x1,x2,x3,x4,x5,x6},{{1,1,1,1,1,1}},revlex,{1,1,1,1,1,1}}


  % Generating the ideal :

    mm:=mat((x1,x2,x3),(x2,x4,x5),(x3,x5,x6));


      [x1  x2  x3]
      [          ]
mm := [x2  x4  x5]
      [          ]
      [x3  x5  x6]


    m:=minors(mm,2);


                   2
m := { - x4*x6 + x5 ,

       - x2*x6 + x3*x5,

       - x2*x5 + x3*x4,

                   2
       - x1*x6 + x3 ,

       - x1*x5 + x2*x3,

                   2
       - x1*x4 + x2 }

    setideal(n,idealpower(m,2));


   4          2        2   2
{x5  - 2*x4*x5 *x6 + x4 *x6 ,

   2   2                     2   2
 x3 *x5  - 2*x2*x3*x5*x6 + x2 *x6 ,

   4          2        2   2
 x3  - 2*x1*x3 *x6 + x1 *x6 ,

   2   2                     2   2
 x2 *x3  - 2*x1*x2*x3*x5 + x1 *x5 ,

   4          2        2   2
 x2  - 2*x1*x2 *x4 + x1 *x4 ,

      3                      2              2
 x3*x5  - x3*x4*x5*x6 - x2*x5 *x6 + x2*x4*x6 ,

         2        2           3
 x3*x4*x5  - x3*x4 *x6 - x2*x5  + x2*x4*x5*x6,

   3           2                            2
 x3 *x5 - x2*x3 *x6 - x1*x3*x5*x6 + x1*x2*x6 ,

         2                      3
 x2*x3*x5  - x2*x3*x4*x6 - x1*x5  + x1*x4*x5*x6,

      2        2                 2
 x2*x3 *x5 - x2 *x3*x6 - x1*x3*x5  + x1*x2*x5*x6,

      3        2                      2
 x2*x3  - x1*x3 *x5 - x1*x2*x3*x6 + x1 *x5*x6,

   2   2     2                 2        2
 x2 *x5  - x2 *x4*x6 - x1*x4*x5  + x1*x4 *x6,

   2           3
 x2 *x3*x5 - x2 *x6 - x1*x3*x4*x5 + x1*x2*x4*x6,

   2           3              2
 x2 *x3*x4 - x2 *x5 - x1*x3*x4  + x1*x2*x4*x5,

   3                         2        2
 x2 *x3 - x1*x2*x3*x4 - x1*x2 *x5 + x1 *x4*x5,

   2                           2   2        2              2
 x3 *x4*x6 - 2*x2*x3*x5*x6 + x2 *x6  + x1*x5 *x6 - x1*x4*x6 ,

   2                           2              3
 x3 *x4*x5 - 2*x2*x3*x4*x6 + x2 *x5*x6 - x1*x5  + x1*x4*x5*x6,

   2   2                     2                 2        2
 x3 *x4  - 2*x2*x3*x4*x5 + x2 *x4*x6 + x1*x4*x5  - x1*x4 *x6,

   3        2                 2
 x3 *x4 - x2 *x3*x6 - x1*x3*x5  - x1*x3*x4*x6 + 2*x1*x2*x5*x6,

      2        3                              2
 x2*x3 *x4 - x2 *x6 - 2*x1*x3*x4*x5 + x1*x2*x5  + x1*x2*x4*x6,

      2                           2        2   2     2
 x1*x3 *x4 - 2*x1*x2*x3*x5 + x1*x2 *x6 + x1 *x5  - x1 *x4*x6}


  % The ideal itself :

    gbasis n;


   4          2        2   2
{x5  - 2*x4*x5 *x6 + x4 *x6 ,

   2   2                     2   2
 x3 *x5  - 2*x2*x3*x5*x6 + x2 *x6 ,

   4          2        2   2
 x3  - 2*x1*x3 *x6 + x1 *x6 ,

   2   2                     2   2
 x2 *x3  - 2*x1*x2*x3*x5 + x1 *x5 ,

   4          2        2   2
 x2  - 2*x1*x2 *x4 + x1 *x4 ,

      3                      2              2
 x3*x5  - x3*x4*x5*x6 - x2*x5 *x6 + x2*x4*x6 ,

         2        2           3
 x3*x4*x5  - x3*x4 *x6 - x2*x5  + x2*x4*x5*x6,

   3           2                            2
 x3 *x5 - x2*x3 *x6 - x1*x3*x5*x6 + x1*x2*x6 ,

         2                      3
 x2*x3*x5  - x2*x3*x4*x6 - x1*x5  + x1*x4*x5*x6,

      2        2                 2
 x2*x3 *x5 - x2 *x3*x6 - x1*x3*x5  + x1*x2*x5*x6,

      3        2                      2
 x2*x3  - x1*x3 *x5 - x1*x2*x3*x6 + x1 *x5*x6,

   2   2     2                 2        2
 x2 *x5  - x2 *x4*x6 - x1*x4*x5  + x1*x4 *x6,

   2           3
 x2 *x3*x5 - x2 *x6 - x1*x3*x4*x5 + x1*x2*x4*x6,

   2           3              2
 x2 *x3*x4 - x2 *x5 - x1*x3*x4  + x1*x2*x4*x5,

   3                         2        2
 x2 *x3 - x1*x2*x3*x4 - x1*x2 *x5 + x1 *x4*x5,

   2                           2   2        2              2
 x3 *x4*x6 - 2*x2*x3*x5*x6 + x2 *x6  + x1*x5 *x6 - x1*x4*x6 ,

   2                           2              3
 x3 *x4*x5 - 2*x2*x3*x4*x6 + x2 *x5*x6 - x1*x5  + x1*x4*x5*x6,

   2   2                     2                 2        2
 x3 *x4  - 2*x2*x3*x4*x5 + x2 *x4*x6 + x1*x4*x5  - x1*x4 *x6,

   3        2                 2
 x3 *x4 - x2 *x3*x6 - x1*x3*x5  - x1*x3*x4*x6 + 2*x1*x2*x5*x6,

      2        3                              2
 x2*x3 *x4 - x2 *x6 - 2*x1*x3*x4*x5 + x1*x2*x5  + x1*x2*x4*x6,

      2                           2        2   2     2
 x1*x3 *x4 - 2*x1*x2*x3*x5 + x1*x2 *x6 + x1 *x5  - x1 *x4*x6}

    length n;


21

    dim n;


3

    degree n;


16


  % Its unmixed radical.

    unmixedradical n;


              2
{ - x4*x6 + x5 ,

  - x2*x6 + x3*x5,

              2
  - x1*x6 + x3 ,

 x2*x5 - x3*x4,

  - x1*x5 + x2*x3,

              2
  - x1*x4 + x2 }


  % Its equidimensional hull. This needs some more time :

    n1:=eqhull n;


         2   2          2        4
n1 := {x4 *x6  - 2*x4*x5 *x6 + x5 ,

         2   2                     2   2
       x2 *x6  - 2*x2*x3*x5*x6 + x3 *x5 ,

         2   2          2        4
       x1 *x6  - 2*x1*x3 *x6 + x3 ,

         2   2                     2   2
       x1 *x5  - 2*x1*x2*x3*x5 + x2 *x3 ,

         2   2          2        4
       x1 *x4  - 2*x1*x2 *x4 + x2 ,

               2        2                         3
       x2*x4*x6  - x2*x5 *x6 - x3*x4*x5*x6 + x3*x5 ,

                          3        2              2
       x2*x4*x5*x6 - x2*x5  - x3*x4 *x6 + x3*x4*x5 ,

               2                      2        3
       x1*x2*x6  - x1*x3*x5*x6 - x2*x3 *x6 + x3 *x5,

                          3                         2
       x1*x4*x5*x6 - x1*x5  - x2*x3*x4*x6 + x2*x3*x5 ,

                             2     2              2
       x1*x2*x5*x6 - x1*x3*x5  - x2 *x3*x6 + x2*x3 *x5,

         2                            2           3
       x1 *x5*x6 - x1*x2*x3*x6 - x1*x3 *x5 + x2*x3 ,

            2              2     2           2   2
       x1*x4 *x6 - x1*x4*x5  - x2 *x4*x6 + x2 *x5 ,

                                     3        2
       x1*x2*x4*x6 - x1*x3*x4*x5 - x2 *x6 + x2 *x3*x5,

                             2     3        2
       x1*x2*x4*x5 - x1*x3*x4  - x2 *x5 + x2 *x3*x4,

         2              2                      3
       x1 *x4*x5 - x1*x2 *x5 - x1*x2*x3*x4 + x2 *x3,

                          2     2                     2
        - x1*x4*x6 + x1*x5  + x2 *x6 - 2*x2*x3*x5 + x3 *x4}

    length n1;


16

    setideal(n1,n1)$

 gbasis n1$


    submodulep(n,n1);


yes

    submodulep(n1,n);


no


  % Hence there is an embedded component. Let's find it making an
  % excursion to symbolic mode. Of course, this can be done also 
  % algebraically.

    symbolic;


nil

    n:=get('n,'basis);


(dpmat 21 0 ((1 ((((0 0 0 0 0 4) 4) . 1) (((0 0 0 0 1 2 1) 4) . -2) (((0 0 0 0 2
0 2) 4) . 1)) 3 0 nil) (2 ((((0 0 0 2 0 2) 4) . 1) (((0 0 1 1 0 1 1) 4) . -2) ((
(0 0 2 0 0 0 2) 4) . 1)) 3 0 nil) (3 ((((0 0 0 4) 4) . 1) (((0 1 0 2 0 0 1) 4) .
-2) (((0 2 0 0 0 0 2) 4) . 1)) 3 0 nil) (4 ((((0 0 2 2) 4) . 1) (((0 1 1 1 0 1)
4) . -2) (((0 2 0 0 0 2) 4) . 1)) 3 0 nil) (5 ((((0 0 4) 4) . 1) (((0 1 2 0 1) 4
) . -2) (((0 2 0 0 2) 4) . 1)) 3 0 nil) (6 ((((0 0 0 1 0 3) 4) . 1) (((0 0 0 1 1
1 1) 4) . -1) (((0 0 1 0 0 2 1) 4) . -1) (((0 0 1 0 1 0 2) 4) . 1)) 4 0 nil) (7
((((0 0 0 1 1 2) 4) . 1) (((0 0 0 1 2 0 1) 4) . -1) (((0 0 1 0 0 3) 4) . -1) (((
0 0 1 0 1 1 1) 4) . 1)) 4 0 nil) (8 ((((0 0 0 3 0 1) 4) . 1) (((0 0 1 2 0 0 1) 4
) . -1) (((0 1 0 1 0 1 1) 4) . -1) (((0 1 1 0 0 0 2) 4) . 1)) 4 0 nil) (9 ((((0
0 1 1 0 2) 4) . 1) (((0 0 1 1 1 0 1) 4) . -1) (((0 1 0 0 0 3) 4) . -1) (((0 1 0
0 1 1 1) 4) . 1)) 4 0 nil) (10 ((((0 0 1 2 0 1) 4) . 1) (((0 0 2 1 0 0 1) 4) .
-1) (((0 1 0 1 0 2) 4) . -1) (((0 1 1 0 0 1 1) 4) . 1)) 4 0 nil) (11 ((((0 0 1 3
) 4) . 1) (((0 1 0 2 0 1) 4) . -1) (((0 1 1 1 0 0 1) 4) . -1) (((0 2 0 0 0 1 1)
4) . 1)) 4 0 nil) (12 ((((0 0 2 0 0 2) 4) . 1) (((0 0 2 0 1 0 1) 4) . -1) (((0 1
0 0 1 2) 4) . -1) (((0 1 0 0 2 0 1) 4) . 1)) 4 0 nil) (13 ((((0 0 2 1 0 1) 4) .
1) (((0 0 3 0 0 0 1) 4) . -1) (((0 1 0 1 1 1) 4) . -1) (((0 1 1 0 1 0 1) 4) . 1)
) 4 0 nil) (14 ((((0 0 2 1 1) 4) . 1) (((0 0 3 0 0 1) 4) . -1) (((0 1 0 1 2) 4)
. -1) (((0 1 1 0 1 1) 4) . 1)) 4 0 nil) (15 ((((0 0 3 1) 4) . 1) (((0 1 1 1 1) 4
) . -1) (((0 1 2 0 0 1) 4) . -1) (((0 2 0 0 1 1) 4) . 1)) 4 0 nil) (16 ((((0 0 0
2 1 0 1) 4) . 1) (((0 0 1 1 0 1 1) 4) . -2) (((0 0 2 0 0 0 2) 4) . 1) (((0 1 0 0
0 2 1) 4) . 1) (((0 1 0 0 1 0 2) 4) . -1)) 5 0 nil) (17 ((((0 0 0 2 1 1) 4) . 1)
(((0 0 1 1 1 0 1) 4) . -2) (((0 0 2 0 0 1 1) 4) . 1) (((0 1 0 0 0 3) 4) . -1) ((
(0 1 0 0 1 1 1) 4) . 1)) 5 0 nil) (18 ((((0 0 0 2 2) 4) . 1) (((0 0 1 1 1 1) 4)
. -2) (((0 0 2 0 1 0 1) 4) . 1) (((0 1 0 0 1 2) 4) . 1) (((0 1 0 0 2 0 1) 4) .
-1)) 5 0 nil) (19 ((((0 0 0 3 1) 4) . 1) (((0 0 2 1 0 0 1) 4) . -1) (((0 1 0 1 0
2) 4) . -1) (((0 1 0 1 1 0 1) 4) . -1) (((0 1 1 0 0 1 1) 4) . 2)) 5 0 nil) (20 (
(((0 0 1 2 1) 4) . 1) (((0 0 3 0 0 0 1) 4) . -1) (((0 1 0 1 1 1) 4) . -2) (((0 1
1 0 0 2) 4) . 1) (((0 1 1 0 1 0 1) 4) . 1)) 5 0 nil) (21 ((((0 1 0 2 1) 4) . 1)
(((0 1 1 1 0 1) 4) . -2) (((0 1 2 0 0 0 1) 4) . 1) (((0 2 0 0 0 2) 4) . 1) (((0
2 0 0 1 0 1) 4) . -1)) 5 0 nil)) nil)


  % This needs even more time than the eqhull, of course.

    u:=primarydecomposition!* n;


(((dpmat 16 0 ((1 ((((0 0 0 0 0 4) 4) . 1) (((0 0 0 0 1 2 1) 4) . -2) (((0 0 0 0
2 0 2) 4) . 1)) 3 0 nil) (2 ((((0 0 0 4) 4) . 1) (((0 1 0 2 0 0 1) 4) . -2) (((0
2 0 0 0 0 2) 4) . 1)) 3 0 nil) (3 ((((0 0 4) 4) . 1) (((0 1 2 0 1) 4) . -2) (((0
2 0 0 2) 4) . 1)) 3 0 nil) (4 ((((0 0 0 2 0 2) 4) . 1) (((0 0 1 1 0 1 1) 4) . -2
) (((0 0 2 0 0 0 2) 4) . 1)) 3 0 nil) (5 ((((0 0 2 2) 4) . 1) (((0 1 1 1 0 1) 4)
. -2) (((0 2 0 0 0 2) 4) . 1)) 3 0 nil) (6 ((((0 0 0 1 0 3) 4) . 1) (((0 0 0 1 1
1 1) 4) . -1) (((0 0 1 0 0 2 1) 4) . -1) (((0 0 1 0 1 0 2) 4) . 1)) 4 0 nil) (7
((((0 0 0 3 0 1) 4) . 1) (((0 0 1 2 0 0 1) 4) . -1) (((0 1 0 1 0 1 1) 4) . -1) (
((0 1 1 0 0 0 2) 4) . 1)) 4 0 nil) (8 ((((0 0 0 1 1 2) 4) . 1) (((0 0 0 1 2 0 1)
4) . -1) (((0 0 1 0 0 3) 4) . -1) (((0 0 1 0 1 1 1) 4) . 1)) 4 0 nil) (9 ((((0 0
1 3) 4) . 1) (((0 1 0 2 0 1) 4) . -1) (((0 1 1 1 0 0 1) 4) . -1) (((0 2 0 0 0 1
1) 4) . 1)) 4 0 nil) (10 ((((0 0 2 0 0 2) 4) . 1) (((0 0 2 0 1 0 1) 4) . -1) (((
0 1 0 0 1 2) 4) . -1) (((0 1 0 0 2 0 1) 4) . 1)) 4 0 nil) (11 ((((0 0 2 1 1) 4)
. 1) (((0 0 3 0 0 1) 4) . -1) (((0 1 0 1 2) 4) . -1) (((0 1 1 0 1 1) 4) . 1)) 4
0 nil) (12 ((((0 0 3 1) 4) . 1) (((0 1 1 1 1) 4) . -1) (((0 1 2 0 0 1) 4) . -1)
(((0 2 0 0 1 1) 4) . 1)) 4 0 nil) (13 ((((0 0 2 1 0 1) 4) . 1) (((0 0 3 0 0 0 1)
4) . -1) (((0 1 0 1 1 1) 4) . -1) (((0 1 1 0 1 0 1) 4) . 1)) 4 0 nil) (14 ((((0
0 1 2 0 1) 4) . 1) (((0 0 2 1 0 0 1) 4) . -1) (((0 1 0 1 0 2) 4) . -1) (((0 1 1
0 0 1 1) 4) . 1)) 4 0 nil) (15 ((((0 0 1 1 0 2) 4) . 1) (((0 0 1 1 1 0 1) 4) .
-1) (((0 1 0 0 0 3) 4) . -1) (((0 1 0 0 1 1 1) 4) . 1)) 4 0 nil) (16 ((((0 0 0 2
1) 3) . 1) (((0 0 1 1 0 1) 3) . -2) (((0 0 2 0 0 0 1) 3) . 1) (((0 1 0 0 0 2) 3)
. 1) (((0 1 0 0 1 0 1) 3) . -1)) 5 0 nil)) nil) (dpmat 6 0 ((1 ((((0 0 0 0 0 2)
2) . 1) (((0 0 0 0 1 0 1) 2) . -1)) 2 0 nil) (2 ((((0 0 0 1 0 1) 2) . 1) (((0 0
1 0 0 0 1) 2) . -1)) 2 0 nil) (3 ((((0 0 0 2) 2) . 1) (((0 1 0 0 0 0 1) 2) . -1)
) 2 0 nil) (4 ((((0 0 0 1 1) 2) . -1) (((0 0 1 0 0 1) 2) . 1)) 2 0 nil) (5 ((((0
0 1 1) 2) . 1) (((0 1 0 0 0 1) 2) . -1)) 2 0 nil) (6 ((((0 0 2) 2) . 1) (((0 1 0
0 1) 2) . -1)) 2 0 nil)) nil)) ((dpmat 18 0 ((1 ((((0 0 0 0 0 4) 4) . 1)) 1 0
nil) (2 ((((0 0 0 1 0 3) 4) . 1)) 1 0 nil) (3 ((((0 0 0 2 0 2) 4) . 1)) 1 0 nil)
(4 ((((0 0 0 3 0 1) 4) . 1)) 1 0 nil) (5 ((((0 0 0 4) 4) . 1)) 1 0 nil) (6 ((((0
0 1 0 0 3) 4) . 1)) 1 0 nil) (7 ((((0 0 1 1 0 2) 4) . 1)) 1 0 nil) (8 ((((0 0 1
2 0 1) 4) . 1)) 1 0 nil) (9 ((((0 0 1 3) 4) . 1)) 1 0 nil) (10 ((((0 0 2 0 0 2)
4) . 1)) 1 0 nil) (11 ((((0 0 2 1 0 1) 4) . 1)) 1 0 nil) (12 ((((0 0 2 2) 4) . 1
)) 1 0 nil) (13 ((((0 0 3 0 0 1) 4) . 1)) 1 0 nil) (14 ((((0 0 3 1) 4) . 1)) 1 0
nil) (15 ((((0 0 4) 4) . 1)) 1 0 nil) (16 ((((0 0 0 0 0 0 1) 1) . 1)) 1 0 nil) (
17 ((((0 0 0 0 1) 1) . 1)) 1 0 nil) (18 ((((0 1) 1) . 1)) 1 0 nil)) nil) (dpmat
6 0 ((1 ((((0 0 0 0 0 0 1) 1) . 1)) 1 0 nil) (2 ((((0 0 0 0 0 1) 1) . 1)) 1 0
nil) (3 ((((0 0 0 0 1) 1) . 1)) 1 0 nil) (4 ((((0 0 0 1) 1) . 1)) 1 0 nil) (5 ((
((0 0 1) 1) . 1)) 1 0 nil) (6 ((((0 1) 1) . 1)) 1 0 nil)) nil)))

    for each x in u collect easydim!* second x;


(3 0)

    for each x in u collect degree!* first x;


(16 20)


  % Hence the embedded component is a trivial one. Let's divide it
  % out by a stable ideal quotient calculation :

    algebraic;


    setideal(n2,matstabquot(n,vars));


   4          2        2   2
{x5  - 2*x4*x5 *x6 + x4 *x6 ,

   2   2                     2   2
 x3 *x5  - 2*x2*x3*x5*x6 + x2 *x6 ,

   4          2        2   2
 x3  - 2*x1*x3 *x6 + x1 *x6 ,

   2   2                     2   2
 x2 *x3  - 2*x1*x2*x3*x5 + x1 *x5 ,

   4          2        2   2
 x2  - 2*x1*x2 *x4 + x1 *x4 ,

      3                      2              2
 x3*x5  - x3*x4*x5*x6 - x2*x5 *x6 + x2*x4*x6 ,

         2        2           3
 x3*x4*x5  - x3*x4 *x6 - x2*x5  + x2*x4*x5*x6,

   3           2                            2
 x3 *x5 - x2*x3 *x6 - x1*x3*x5*x6 + x1*x2*x6 ,

         2                      3
 x2*x3*x5  - x2*x3*x4*x6 - x1*x5  + x1*x4*x5*x6,

      2        2                 2
 x2*x3 *x5 - x2 *x3*x6 - x1*x3*x5  + x1*x2*x5*x6,

      3        2                      2
 x2*x3  - x1*x3 *x5 - x1*x2*x3*x6 + x1 *x5*x6,

   2   2     2                 2        2
 x2 *x5  - x2 *x4*x6 - x1*x4*x5  + x1*x4 *x6,

   2           3
 x2 *x3*x5 - x2 *x6 - x1*x3*x4*x5 + x1*x2*x4*x6,

   2           3              2
 x2 *x3*x4 - x2 *x5 - x1*x3*x4  + x1*x2*x4*x5,

   3                         2        2
 x2 *x3 - x1*x2*x3*x4 - x1*x2 *x5 + x1 *x4*x5,

   2                     2           2
 x3 *x4 - 2*x2*x3*x5 + x2 *x6 + x1*x5  - x1*x4*x6}

    gbasis n2$


    modequalp(n1,n2);


yes


end;
(cali 151861 4167)


End of Lisp run after 151.87+4.96 seconds


REDUCE Historical
REDUCE Sourceforge Project | Historical SVN Repository | GitHub Mirror | SourceHut Mirror | NotABug Mirror | Chisel Mirror | Chisel RSS ]