source: git/Singular/LIB/teachstd.lib @ 592906

spielwiese
Last change on this file since 592906 was 7f3ad4, checked in by Hans Schönemann <hannes@…>, 15 years ago
*hannes: format git-svn-id: file:///usr/local/Singular/svn/trunk@11306 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 22.9 KB
Line 
1// $Id:
2//GMG, last modified 28.9.01
3///////////////////////////////////////////////////////////////////////////////
4version="$Id: teachstd.lib,v 1.9 2009-01-14 16:07:05 Singular Exp $";
5category="Teaching";
6info="
7LIBRARY:  teachstd.lib   Procedures for teaching standard bases
8AUTHOR:                  G.-M. Greuel, greuel@mathematik.uni-kl.de
9
10NOTE: The library is intended to be used for teaching purposes, but not
11      for serious computations. Sufficiently high printlevel allows to
12      control each step, thus illustrating the algorithms at work.
13      The procedures are implemented exactly as described in the book
14      'A SINGULAR Introduction to Commutative Algebra' by G.-M. Greuel and
15      G. Pfister (Springer 2002).
16
17PROCEDURES:
18 ecart(f);              ecart of f
19 tail(f);               tail of f
20 sameComponent(f,g);    test for same module component of lead(f) and lead(g)
21 leadmonomial(f);       leading monomial as poly (also for vectors)
22 monomialLcm(m,n);      lcm of monomials m and n as poly (also for vectors)
23 spoly(f[,1]);          s-polynomial of f [symmetric form]
24 minEcart(T,h);         element g from T of minimal ecart s.t. LM(g)|LM(h)
25 NFMora(i);             normal form of i w.r.t Mora algorithm
26 prodcrit(f,g);         test for product criterion
27 chaincrit(f,g,h);      test for chain criterion
28 pairset(G);            pairs form G neither satifying prodcrit nor chaincrit
29 updatePairs(P,S,h);    pairset P enlarded by not useless pairs (h,f), f in S
30 standard(id);          standard basis of ideal/module
31 localstd(id);          local standard basis of id using Lazard's method
32
33              [parameters in square brackets are optional]
34";
35
36LIB "poly.lib";
37
38///////////////////////////////////////////////////////////////////////////////
39proc ecart(f)
40"USAGE:   ecart(f); f poly or vector
41RETURN:  the ecart e of f of type int
42EXAMPLE: example ecart; shows an example
43"
44{
45  int e = maxdeg1(f)-maxdeg1(lead(f));
46  return(e);
47}
48example
49{ "EXAMPLE:"; echo = 2;
50   ring r=0,(x,y,z),ls;
51   ecart((y+z+x+xyz)**2);
52   ring s=0,(x,y,z),dp;
53   ecart((y+z+x+xyz)**2);
54}
55///////////////////////////////////////////////////////////////////////////////
56proc leadmonomial(f)
57"USAGE:   leadmonomial(f); f poly or vector
58RETURN:  the leading monomial of f of type poly
59NOTE:    if f is of type poly, leadmonomial(f)=leadmonom(f), if f is of type
60         vector and if leadmonom(f)=m*gen(i) then leadmonomial(f)=m
61EXAMPLE: example leadmonomial; shows an example
62"
63{
64  int e;
65  poly m;
66  if(typeof(f) == "vector")
67  {
68    e=leadexp(f)[nvars(basering)+1];
69    m=leadmonom(f)[e,1];
70  }
71  if(typeof(f) == "poly")
72  {
73    m=leadmonom(f);
74  }
75  return(m);
76}
77example
78{ "EXAMPLE:"; echo = 2;
79   ring s=0,(x,y,z),(c,dp);
80   leadmonomial((y+z+x+xyz)**2);
81   leadmonomial([(y+z+x+xyz)**2,xyz5]);
82}
83///////////////////////////////////////////////////////////////////////////////
84proc tail(f)
85"USAGE:   tail(f); f poly or vector
86RETURN:  f-lead(f), the tail of f of type poly
87EXAMPLE: example tail; shows an example
88"
89{
90  def t = f-lead(f);
91  return(t);
92}
93example
94{ "EXAMPLE:"; echo = 2;
95   ring r=0,(x,y,z),ls;
96   tail((y+z+x+xyz)**2);
97   ring s=0,(x,y,z),dp;
98   tail((y+z+x+xyz)**2);
99}
100///////////////////////////////////////////////////////////////////////////////
101proc sameComponent(f,g)
102"USAGE:   sameComponent(f,g); f,g poly or vector
103RETURN:  1 if f and g are of type poly or if f and g are of type vector and
104         their leading monomials involve the same module component,
105         0 if not
106EXAMPLE: example sameComponent; shows an example
107"
108{
109  if(typeof(f) != typeof(g))
110  {
111    ERROR("** arguments must be of same type");
112  }
113  if(typeof(f) == "vector")
114  {
115     if( leadexp(f)[nvars(basering)+1] !=  leadexp(g)[nvars(basering)+1] )
116     {
117       return(0);
118     }
119  }
120  return(1);
121}
122example
123{ "EXAMPLE:"; echo = 2;
124   ring r=0,(x,y,z),dp;
125   sameComponent([y+z+x,xyz],[z2,xyz]);
126   sameComponent([y+z+x,xyz],[z4,xyz]);
127   sameComponent(y+z+x+xyz, xy+z5);
128}
129///////////////////////////////////////////////////////////////////////////////
130proc monomialLcm(m,n)
131"USAGE:   monomialLcm(m,n); m,n of type poly or vector
132RETURN:  least common multiple of leading monomials of m and n, of type poly
133NOTE:    if m = (x1...xr)^(a1,...,ar)*gen(i) (gen(i)=1 if m is of type poly)
134         and n = (x1...xr)^(b1,...,br)*gen(j), then the proc returns
135         (x1,...,xr)^(max(a1,b1),...,max(ar,br)) if i=j and 0 if i!=j.
136EXAMPLE: example monomialLcm; shows an example
137"
138{
139  if(typeof(n) != typeof(m))
140  {
141    ERROR("** arguments must be of same type");
142  }
143
144  poly u ;
145  if(sameComponent(m,n) == 0)   //leading term of vectors involve
146  {                             //different module components
147     return(u);
148  }
149
150  intvec v = leadexp(m);        //now start to compute lcm
151  intvec w = leadexp(n);
152  u=1;
153  int i;
154  for (i=1; i<=nvars(basering); i++)
155  {
156      if(v[i]>=w[i])
157      {
158         u = u*var(i)**v[i];
159      }
160      else
161      {
162         u = u*var(i)**w[i];
163      }
164   }
165   return(u);
166}
167example
168{ "EXAMPLE:"; echo = 2;
169   ring r=0,(x,y,z),ds;
170   monomialLcm(xy2,yz3);
171   monomialLcm([xy2,xz],[yz3]);
172   monomialLcm([xy2,xz3],[yz3]);
173}
174///////////////////////////////////////////////////////////////////////////////
175proc spoly(f,g,list #)
176"USAGE:   spoly(f,g[,s]); f,g poly or vector, s int
177RETURN:  the s-polynomial of f and g, of type poly or vector
178         if s!=0 the symmetric s-polynomial (without division) is returned
179EXAMPLE: example spoly; shows an example
180"
181{
182  if(typeof(f) != typeof(g))
183  {
184    ERROR("** arguments must be of same type");
185  }
186  if(size(#) == 0)
187  {
188     #[1]=0;
189  }
190
191  int e;
192  poly o = monomialLcm(f,g);
193
194  if( o == 0)                    //can only happen, if vectors f and g involve
195  {                              //different module components
196    vector sp;
197    return(sp);
198  }
199
200  poly m=(o/leadmonomial(f));         //compute the leading monomial as poly
201  poly n=(o/leadmonomial(g));
202
203  f = m * f;
204  g = n * g; // now they have the same LM!
205
206  if (#[1]==0)                    //the asymmetric s-poly
207  {
208    def sp = f - (leadcoef(f)/leadcoef(g))*g;
209  }
210  else                            //the symmetric s-poly, avoiding division
211  {
212    def sp = leadcoef(g)*f - leadcoef(f)*g;
213  }
214  return(sp);
215}
216example
217{ "EXAMPLE:"; echo = 2;
218   ring r=0,(x,y,z),ls;
219   spoly(2x2+x2y,3y3+xyz);
220   ring s=0,(x,y,z),(c,dp);
221   spoly(2x2+x2y,3y3+xyz);
222   spoly(2x2+x2y,3y3+xyz,1);             //symmetric s-poly without division
223   spoly([5x2+x2y,z5],[x2,y3,y4]);       //s-poly for vectors
224}
225///////////////////////////////////////////////////////////////////////////////
226proc minEcart(T,h)
227"USAGE:   minEcart(T,h); T ideal or module, h poly or vector
228RETURN:  element g from T such that leadmonom(g) divides leadmonom(h)
229         ecart(g) is minimal with this property (if T != 0);
230         return 0 if T is 0 or h = 0
231EXAMPLE: example minEcart; shows an example
232"
233{
234  int i,k,e;
235  if (size(T)==0 or h==0 )       //trivial cases
236  {
237     h = 0;
238     return(h);
239  }
240//---- check whether some element in T has the same module component as h ----
241  int v;
242  intvec w;
243  T = simplify(T,2);
244
245  if (typeof(h) == "vector")
246  {
247     e=1;
248     v = leadexp(h)[nvars(basering)+1];
249     for( i=1; i<=size(T); i++)
250     {
251       w[i]=leadexp(T[i])[nvars(basering)+1];
252       if(v == w[i])
253       {
254         e=0;         //some element in T involves the same component as h
255       }
256     }
257  }
258  if ( e == 1 )       //no element in T involves the same component as h
259  {
260     h = 0;
261     return(h);
262  }
263
264  if (typeof(h) == "poly")   //for polys v=w[i] for all i
265  {
266    v = 1;
267    w[size(T)]=0;
268    w=w+1;
269  }
270
271//------ check whether for some g in T leadmonom(g) divides leadmonom(h) -----
272  def g = T[1];
273  poly f = leadmonomial(h);
274
275  for( i=1; i<=size(T); i++)
276  {
277    if( f/leadmonomial(T[i]) != 0 and v==w[i] )
278    {
279       g=T[i];
280       k=i;
281       break;
282    }
283  }
284  if (k == 0)        //no leadmonom(g) divides leadmonom(h)
285  {
286     g = 0;
287     return(g);
288  }
289//--look for T[i] with minimal ecart s.t.leadmonom(T[i]) divides leadmonom(h)--
290
291  for( i=k+1; i<=size(T); i++)
292  {
293    if( f/leadmonomial(T[i]) != 0 and v==w[i] )
294    {
295       if (ecart(T[i]) < ecart(g))
296       {
297         g=T[i];
298        }
299     }
300  }
301  return(g);
302}
303example
304{ "EXAMPLE:"; echo = 2;
305   ring R=0,(x,y,z),dp;
306   ideal T = x2y+x2,y3+xyz,xyz2+z4;
307   poly h = x2y2z2+x5+yx3+z6;
308   minEcart(T,h);"";
309   ring S=0,(x,y,z),(c,ds);
310   module T = [x2+x2y,y2],[y3+xyz,x3-z3],[x3y+z4,0,x2];
311   vector h = [x3y+x5+x2y2z2+z6,x3];
312   minEcart(T,h);
313}
314///////////////////////////////////////////////////////////////////////////////
315proc NFMora(f,G,list #)
316"USAGE:   NFMora(f,G[,s]); f poly or vector,G ideal or module, s int
317RETURN:  the Mora normal form of f w.r.t. G, same type as f
318         if s!=0 the symmetric s-polynomial (without division) is used
319NOTE:    Show comments if printlevel > 0, pauses computation if printlevel > 1
320EXAMPLE: example NFMora; shows an example
321"
322{
323  if(size(#) == 0)
324  {
325     #[1]=0;
326  }
327
328  int y = printlevel - voice + 2;
329  if( f==0 or size(G) ==0 )
330  {
331     if (y>0)
332     {
333        "// 1st or 2nd argument 0";
334     }
335     return(f);
336  }
337
338  int i,e;
339  def h = f;
340  def T = G;
341// -------------------- start with f to be reduced by G --------------------
342  if (y>0)
343  {"";
344   "// Input for NFMora is (f,T):";
345   "// f:"; f;
346   "// T:"; T;
347   "// Reduce f with T, eventually enlarging T for local ordering";
348  }
349
350// ----------------------- enter the reduction loop ------------------------
351  def g = minEcart(T,h);
352  while (h!=0 and g!=0)
353  {
354     if (y>0)
355     {  "";
356        "//                Reduction-step in NFMora:",i;
357        "// h = (f after",i,"reductions) reduction with g from T:";
358        "// g = element of minimal ecart in T s.t. LM(g)|LM(h):";
359        "// h:";h;
360        "// g:";g;
361     }
362     if (y>1)
363     {
364        pause("press <return> to continue");
365        "// T, set used for reduction:"; T;
366        pause("press <return> to continue");
367     }
368     e=0;
369     if( ecart(g) > ecart(h) )
370     {
371        T=T,h;  e=1;
372     }
373     if (y>0 )
374     {
375        "// T-set enlarged for next reduction? (yes/no = 1/0):  ", e;
376        if( e==1 )
377        {
378          "// T-set for next reduction got enlarged by h:";
379          "// h:";h;
380          if (y>1)
381          {
382             pause("press <return> to continue");
383          }
384        }
385     }
386     h = spoly(h,g,#[1]);
387     g = minEcart(T,h);
388     i=i+1;
389  }
390  if(y>0)
391  { "";
392    "// normal form is:";
393  }
394  return(h);
395}
396example
397{ "EXAMPLE:"; echo = 2;
398   ring r=0,(x,y,z),dp;
399   poly f = x2y2z2+x5+yx3+z6-3y3;
400   ideal G = x2y+x2,y3+xyz,xyz2+z6;
401   NFMora(f,G);"";
402   ring s=0,(x,y,z),ds;
403   poly f = x3y+x5+x2y2z2+z6;
404   ideal G = x2+x2y,y3+xyz,x3y2+z4;
405   NFMora(f,G);"";
406   vector v = [f,x2+x2y];
407   module M = [x2+x2y,f],[y3+xyz,y3],[x3y2+z4,z2];
408   NFMora(v,M);
409}
410///////////////////////////////////////////////////////////////////////////////
411proc prodcrit(f,g)
412"USAGE:   prodcrit(f,g); f,g poly or vector
413RETURN:  1 if product criterion applies in the same module component,
414         2 if lead(f) and lead(g) involve different components, 0 else
415NOTE:    if product criterion applies we can delete (f,g) from pairset
416EXAMPLE: example prodcrit; shows an example
417"
418{
419  if( defined(@@@NOPC) )
420  {
421    if( @@@NOPC == 1) { return(0); }
422  }
423
424  if(typeof(f)=="poly")    //product criterion for polynomials
425  {
426    if( monomialLcm(f,g)==leadmonom(f)*leadmonom(g))
427    {
428      return(1);
429    }
430    return(0);
431  }
432// ------------------- product criterion for modules ---------------------
433  if(sameComponent(f,g)==1)
434  {
435     if( monomialLcm(f,g)==leadmonomial(f)*leadmonomial(g) )
436     {
437         int c = leadexp(f)[nvars(basering)+1];  //component involving lead(f)
438         if((f-f[c]*gen(c))-(g-g[c]*gen(c))==0)  //other components are 0
439         {
440           return(1);
441         }
442     }
443     return(0);
444  }
445  return(2);
446}
447example
448{ "EXAMPLE:"; echo = 2;
449   ring r=0,(x,y,z),dp;
450   poly f = y3z3+x5+yx3+z6;
451   poly g = x5+yx3;
452   prodcrit(f,g);
453   vector v = x3z2*gen(1)+x3y*gen(1)+x2y*gen(2);
454   vector w = y4*gen(1)+y3*gen(2)+xyz*gen(1);
455   prodcrit(v,w);
456}
457///////////////////////////////////////////////////////////////////////////////
458proc chaincrit(f,g,h)
459"USAGE:   chaincrit(f,g,h); f,g,h poly or module
460RETURN:  1 if chain criterion applies, 0 else
461NOTE:    if chain criterion applies to f,g,h we can delete (g,h) from pairset
462EXAMPLE: example chaincrit; shows an example
463"
464{
465  if(sameComponent(f,g) and sameComponent(f,h))
466  {
467    if( monomialLcm(g,h)/leadmonomial(f) !=0 )
468    {
469      return(1);
470    }
471  }
472  return(0);
473}
474example
475{ "EXAMPLE:"; echo = 2;
476   ring r=0,(x,y,z),dp;
477   poly f = x2y2z2+x5+yx3+z6;
478   poly g = x5+yx3;
479   poly h = y2z5+x5+yx3;
480   chaincrit(f,g,h);
481   vector u = [x2y3-z2,x2y];
482   vector v = [x2y2+z2,x2-y2];
483   vector w = [x2y4+z3,x2+y2];
484   chaincrit(u,v,w);
485}
486///////////////////////////////////////////////////////////////////////////////
487proc pairset(G)
488"USAGE:   pairset(G); G ideal or module
489RETURN:  list L,
490         L[1] = the pairset of G as list (not containing pairs for
491         which the product or the chain criterion applies)
492         L[2] = intvec v, v[1]= # product criterion, v[2]= # chain criterion
493EXAMPLE: example pairset; shows an example
494"
495{
496   int i,j,k,s,c,ccrit,pcrit,pr;
497   int y = printlevel - voice + 2;
498   G = simplify(G,10);
499   def g = G;
500   ideal pair;
501   list P,I;      //P=pairlist of G, I=list of corresponding indices of pairs
502   for (i=1; i<=size(G); i++)
503   {
504      for(j = i+1; j<=size(G); j++)
505      {
506         pr = prodcrit(G[i],G[j]);       //check first product criterion
507         if( pr != 0 )
508         {
509            pcrit=pcrit+(pr==1);
510         }
511         else
512         {
513            s = size(P);                //now check chain criterion
514            for(k=1; k<=s; k++)
515            {
516              if( i==I[k][2] )
517              {
518                if ( chaincrit(P[k][1],P[k][2],G[j]) )
519                {                     //need not include (G[i],G[j]) in P
520                  c=1; ccrit=ccrit+1;
521                  break;
522                }
523              }
524              if( j==I[k][1] and c==0 )
525              {
526                "########### enter pairset2 #############";
527                if ( chaincrit(G[i],P[k][1],P[k][2]) )
528                {                     //can delete P[k]=(P[k][1],P[k][2])
529                  ccrit=ccrit+1;
530                  P = delete(P,k);
531                  s = s-1;
532                }
533              }
534            }
535            if ( c==0 )
536            {
537               g = G[i],G[j];
538               P[s+1]=g;
539               I[s+1]=intvec(i,j);
540            }
541            c=0;
542         }
543      }
544   }
545   if (y>0)
546   {  "";
547      "// product criterion:",pcrit," chain criterion:",ccrit;
548   }
549   intvec v = pcrit,ccrit;
550   P=P,v;
551   return(P);
552}
553example
554{ "EXAMPLE:"; echo = 2;
555   ring r=0,(x,y,z),dp;
556   ideal G = x2y+x2,y3+xyz,xyz2+z4;
557   pairset(G);"";
558   module T = [x2y3-z2,x2y],[x2y2+z2,x2-y2],[x2y4+z3,x2+y2];
559   pairset(T);
560}
561///////////////////////////////////////////////////////////////////////////////
562proc updatePairs(P,S,h)
563"USAGE:   updatePairs(P,S,h); P list, S ideal or module, h poly or vector
564         P a list of pairs of polys or vectors (obtained from pairset)
565RETURN:  list Q,
566         Q[1] = the pairset P enlarged  by all pairs (f,h), f from S,
567         without pairs for which the product or the chain criterion applies
568         Q[2] = intvec v, v[1]= # product criterion, v[2]= # chain criterion
569EXAMPLE: example updatePairs; shows an example
570"
571{
572   int i,j,k,s,r,c,ccrit,pcrit,pr;
573   int y = printlevel - voice + 2;
574   ideal pair;
575   list Q = P;           //Q will become enlarged pairset
576   s = size(P);
577   r = size(Q);          //r will grow with Q
578   list R;
579   def g = S;            //give g the correct type ideal/module
580   for (i=1; i<=size(S); i++)
581   {
582      pr =  prodcrit(h,S[i]);
583      if( pr != 0 )     //check product criterion
584      {
585        pcrit=pcrit+(pr==1);       //count product criterion in same component
586      }
587      else
588      {                 //prodcrit did not apply, check for chaincrit
589         r=size(Q);
590         for(k=1; k<=r; k++)
591         {
592           if( Q[k][2]==S[i] )    //S[i]=Q[k][2]
593           {
594             if( chaincrit(Q[k][1],S[i],h) )
595             {                   //can forget (S[i],h)
596                c=1; ccrit=ccrit+1;
597                break;
598             }
599           }
600         }
601         if ( c==0 )
602         {
603            g = S[i],h;        //add pair (S[i],h)
604            Q[r+1] = g;
605         }
606         c=0;
607      }
608   }
609   if (y>0)
610   {  "";;
611      "// product criterion:",pcrit," chain criterion:",ccrit;
612   }
613   intvec v = pcrit,ccrit;
614   Q = Q,v;
615   return(Q);
616}
617example
618{ "EXAMPLE:"; echo = 2;
619   ring R1=0,(x,y,z),(c,dp);
620   ideal S = x2y+x2,y3+xyz;
621   poly h = x2y+xyz;
622   list P = pairset(S)[1];
623   P;"";
624   updatePairs(P,S,h);"";
625   module T = [x2y3-z2,x2y],[x2y4+z3,x2+y2];
626   P = pairset(T)[1];
627   P;"";
628   updatePairs(P,T,[x2+x2y,y3+xyz]);
629}
630///////////////////////////////////////////////////////////////////////////////
631proc standard(id, list #)
632"USAGE:   standard(i[,s]); id ideal or module, s int
633RETURN:  a standard basis of id, using generalized Mora's algorithm
634         which is Buchberger's algorithm for global monomial orderings.
635         If s!=0 the symmetric s-polynomial (without division) is used
636NOTE:    Show comments if printlevel > 0, pauses computation if printlevel > 1
637EXAMPLE: example standard; shows an example
638"
639{
640  if(size(#) == 0)
641  {
642     #[1]=0;
643  }
644
645   def S = id;                 //S will become the standard basis of id
646   def h = S[1];
647   int i,z;
648   int y = printlevel - voice + 2;
649   if(y>0)
650   {  "";
651      "// the set S, to become a standard basis:"; S;
652      if(y>1)
653      {
654         "// create pairset, i.e. pairs from S,";
655         "// after application of product and chain criterion";
656      }
657   }
658   list P = pairset(S);        //create pairset of S=id
659   intvec v = P[2];
660   P = P[1];
661//-------------------------- Main loop in SB lgorithm ----------------------
662   while (size(P) !=0)
663   {  z=z+1;
664      if(y>0)
665      {  "";
666         "//              Enter NFMora for next pair, count",z;
667         "// size of partial standard basis S:    (",size(S),")";
668         "// number of pairs of S after updating: (",size(P),")";
669         if(y>1)
670         {
671            "// 1st pair of new pairset:"; P[1];
672            "// set T=S used for reduction:";S;
673            "// apply NFMora to (spoly,S), spoly = spoly(1st pair)";
674         }
675      }
676      //-------------------- apply NFMora = Mora's normal form -------------
677      h = spoly(P[1][1],P[1][2],#[1]);
678      if(y>1)
679      {
680         "// spoly:";h;
681      }
682      h = NFMora(h,S,#[1]);
683      if(h==0)           //normal form is 0
684      {
685         if(y==1)
686         {
687            "// pair has reduced to 0";
688         }
689          if(y>1)
690         { h;"";
691           pause("press <return> to continue");
692         }
693     }
694      P = delete(P,1);   //spoly of pair reduced to 0, pair can be deleted
695      //--- spoly of pair did not reduce to 0, update S and paiset of S ----
696      if( h != 0)
697      {
698         if(y==1)
699         {
700            "// ** new spoly in degree **:", deg(h);
701         }
702         if(y>1)
703         { h;"";
704           pause("press <return> to continue");
705           "// update pairset";
706         }
707        P=updatePairs(P,S,h);    //update P (=paisert of S)
708        v=v+P[2];                //with useful pairs (g,h), g from S
709         P=P[1];
710         S=S,h;                  //update S, will become the standard basis
711      }
712   }
713//------------------------------ finished ---------------------------------
714   if( find(option(),"prot") or y>0 )
715   {  "";                //show how often prodcrit and chaincrit applied
716      "// product criterion:",v[1]," chain criterion:",v[2];
717      "";
718      "// Final standard basis:";
719   }
720   return(S);
721}
722example
723{ "EXAMPLE:"; echo = 2;
724   ring r=0,(x,y,z),dp;
725   ideal G = x2y+x2,y3+xyz,xyz2+z4;
726   standard(G);"";
727   ring s=0,(x,y,z),(c,ds);
728   ideal G = 2x2+x2y,y3+xyz,3x3y+z4;
729   standard(G);"";
730   standard(G,1);"";           //use symmetric s-poly without division
731   module M = [2x2,x3y+z4],[3y3+xyz,y3],[5z4,z2];
732   standard(M);
733}
734///////////////////////////////////////////////////////////////////////////////
735proc localstd (id)
736"USAGE:   localstd (id); id = ideal
737RETURN:  A standard basis for a local degree ordering, using Lazard's method.
738NOTE:    The procedure homogenizes id w.r.t. a new 1st variable local@t,
739         computes a SB w.r.t. (dp(1),dp) and substitutes local@t by 1.
740         Hence the result is a SB with respect to an ordering which sorts
741         first w.r.t. the subdegree of the original variables and then refines
742         it with dp. This is the local degree ordering ds.
743         localstd may be used in order to avoid cancellation of units and thus
744         to be able to use option(contentSB) also for local orderings.
745EXAMPLE: example localstd; shows an example
746"
747{
748  int ii;
749  def bas = basering;
750  execute("ring  @r_locstd
751     =("+charstr(bas)+"),(local@t,"+varstr(bas)+"),(dp(1),dp);");
752  ideal id = imap(bas,id);
753  ideal hid = homog(id,local@t);
754  hid = std(hid);
755  hid = subst(hid,local@t,1);
756  setring bas;
757  def hid = imap(@r_locstd,hid);
758  attrib(hid,"isSB",1);
759  kill @r_locstd;
760  return(hid);
761}
762example
763{ "EXAMPLE:"; echo = 2;
764   ring R = 0,(x,y,z),ds;
765   ideal i  = xyz+z5,2x2+y3+z7,3z5+y5;
766   localstd(i);
767}
768///////////////////////////////////////////////////////////////////////////////
769
770/*
771// some examples:
772LIB"teachstd.lib";
773option(prot); printlevel=3;
774ring r0 = 0,(t,x,y),lp;
775ideal i = x-t2,y-t3;
776standard(i);
777
778printlevel=1;
779standard(i);
780
781option(prot); printlevel =1;
782ring r1 = (0,a,b),(x,y,z),(c,ds);
783module M = [ax2,bx3y+z4],[a3y3+xyz,by3],[5az4,(a+b)*z2];
784module N1= std(M);
785module N2 = standard(M,1);
786NF(lead(N2),lead(N1));
787NF(lead(N1),lead(N2));rom T
788ring r2 = 0,(x,y,z),dp;
789ideal I = x2y+x2,y3+xyz,xyz2+z4;
790option(prot);
791int tt = timer;
792ideal J = standard(I);
793timer -tt;                 //4sec, product criterion: 9  chain criterion: 6
794ideal J1 = std(I);
795NF(lead(J),lead(J1));
796NF(lead(J1),lead(J));
797
798ring r3 = 0,(x,y,z),ds;
799poly f = x3*y4+z5+xyz;
800ideal I = f,jacob(f);
801option(prot);
802int tt = timer;
803ideal J = standard(I);
804timer -tt;                 //3sec, product criterion: 1  chain criterion: 3
805ideal J1 = std(I);
806NF(lead(J),lead(J1));
807NF(lead(J1),lead(J));
808
809//Becker:
810ring r4 = 32003,(x,y,z),lp;
811ideal I = x3-1, y3-1,
812-27x3-243x2y+27x2z-729xy2+162xyz-9xz2-729y3+243y2z-27yz2+z3-27;
813option(prot);
814int tt = timer;
815ideal J = standard(I);
816timer -tt;                 //201sec, product criterion: 42  chain criterion: 33
817ideal J1 = std(I);
818NF(lead(J),lead(J1));
819NF(lead(J1),lead(J));
820
821//Alex
822ring r5 = 32003,(x,y,z,t),dp;
823ideal I =
8242t3xy2z+x2ty+2x2y,
8252tz+y3x2t+z2t3y2x;
826option(prot); printlevel =1;
827ideal J1 = std(I);
828int tt = timer;
829ideal J = standard(I);
830timer -tt;                 //15sec product criterion: 0  chain criterion: 12
831NF(lead(J),lead(J1));
832NF(lead(J1),lead(J));
833
834ring r6 = 32003,(x,y,z,t),dp; //is already SB for ds, for dp too long
835ideal I=
8369x8+y7t3z4+5x4y2t2+2xy2z3t2,
8379y8+7xy6t+2x5y4t2+2x2yz3t2,
8389z8+3x2y3z2t4;
839option(prot);
840int tt = timer;
841ideal J = standard(I);
842timer -tt;                 //0sec, product criterion: 3  chain criterion: 0
843ideal J1 = std(I);
844NF(lead(J),lead(J1));
845NF(lead(J1),lead(J));
846
847
848*/
849
Note: See TracBrowser for help on using the repository browser.