source: git/Singular/LIB/teachstd.lib @ 4bde6b

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