source: git/Singular/LIB/ehv.lib @ 128379

spielwiese
Last change on this file since 128379 was 128379, checked in by Hans Schoenemann <hannes@…>, 10 years ago
chg: activate ehv.lib
  • Property mode set to 100644
File size: 39.4 KB
Line 
1////////////////////////////////////////////////////////////////////
2
3version="version ehv.lib 4.0.0.0 Jun_2013 "; // $Id$
4category="Commutative Algebra";
5
6info="
7LIBRARY: EHV.lib      PROCEDURES FOR PRIMARY DECOMPOSITION OF IDEALS
8AUTHORS: Kai Dehmann, dehmann@mathematik.uni-kl.de;
9
10OVERVIEW:
11  Algorithms for primary decomposition and radical-computation
12  based on the ideas of Eisenbud, Huneke, and Vasconcelos.
13
14PROCEDURES:
15  equiMaxEHV(I);                      equidimensional part of I
16  removeComponent(I,e);               intersection of the primary components
17                                      of I of dimension >= e
18  AssOfDim(I,e);                      an ideal such that the associated primes
19                                      are exactly the associated primes of I
20                                      having dimension e
21  equiRadEHV(I [,Strategy]);          equidimensional radical of I
22  radEHV(I [,Strategy]);              radical of I
23  IntAssOfDim1(I,e);                  intersection of the associated primes of I
24                                      having dimension e
25  IntAssOfDim2(I,e);                  another way of computing the intersection
26                                      of the associated primes of I
27                                      having dimension e
28  decompEHV(I);                       decomposition of a zero-dimensional
29                                      radical ideal I
30  AssEHV(I [,Strategy]);              associated primes of I
31  minAssEHV(I [,Strategy]);           minimal associated primes of I
32  localize(I,P,l);                    the contraction of the ideal generated by I
33                                      in the localization w.r.t P
34  componentEHV(I,P,L [,Strategy]);    a P-primary component for I
35  primdecEHV(I [,Strategy]);          a minimal primary decomposition of I
36  compareLists(L, K);                 procedure for comparing the output of
37                                      primary decomposition algorithms (checks
38                                      if the computed associated primes coincide)
39";
40
41LIB "ring.lib";
42LIB "general.lib";
43LIB "elim.lib";
44LIB "poly.lib";
45LIB "random.lib";
46LIB "inout.lib";
47LIB "matrix.lib";
48LIB "algebra.lib";
49LIB "normal.lib";
50
51
52/////////////////////////////////////////////////////////////////////
53//                                                                 //
54//             G E N E R A L   A L G O R I T H M S                 //
55//                                                                 //
56/////////////////////////////////////////////////////////////////////
57
58/////////////////////////////////////////////////////////////////////
59static proc AnnExtEHV(int n,list re)
60"USAGE:   AnnExtEHV(n,re); n integer, re resolution
61RETURN:  ideal, the annihilator of Ext^n(R/I,R) with given
62         resolution re of I"
63{
64  if(printlevel > 2){"Entering AnnExtEHV.";}
65
66  if(n < 0)
67    {
68      ideal ann = ideal(1);
69      if(printlevel > 2){"Leaving AnnExtEHV.";}
70      return(ann);
71    }
72  int l = size(re);
73
74  if(n < l)
75    {
76      matrix f = transpose(re[n+1]);
77      if(n == 0)
78        {
79          matrix g = 0*gen(ncols(f));
80        }
81      else
82        {
83          matrix g = transpose(re[n]);
84        }
85      module k = syz(f);
86      ideal ann = quotient1(g,k);
87      if(printlevel > 2){"Leaving AnnExtEHV.";}
88      return(ann);
89    }
90
91  if(n == l)
92    {
93      ideal ann = Ann(transpose(re[n]));
94      if(printlevel > 2){"Leaving AnnExtEHV.";}
95      return(ann);
96    }
97
98  ideal ann = ideal(1);
99  if(printlevel > 2){"Leaving AnnExtEHV.";}
100  return(ann);
101}
102
103
104/////////////////////////////////////////////////////////////////////
105//static
106proc isSubset(ideal I,ideal J)
107"USAGE:   isSubset(I,J); I, J ideals
108RETURN:  integer, 1 if I is a subset of J and 0 otherwise
109NOTE:    if J is not a standard basis the result may be wrong
110"
111{
112  int s = size(I);
113  for(int i=1; i<=s; i++)
114    {
115      if(reduce(I[i],J)!=0)
116        {
117          return(0);
118        }
119    }
120  return(1);
121}
122
123
124/////////////////////////////////////////////////////////////////////
125//                                                                 //
126//         T H E   E Q U I D I M E N S I O N A L   P A R T         //
127//                                                                 //
128/////////////////////////////////////////////////////////////////////
129
130/////////////////////////////////////////////////////////////////////
131proc equiMaxEHV(ideal I)
132"USAGE:   equiMaxEHV(I); I ideal
133RETURN:  ideal, the equidimensional part of I.
134NOTE:    Uses algorithm of Eisenbud, Huneke, and Vasconcelos.
135EXAMPLE: example equiMaxEHV; shows an example
136"
137{
138  if(printlevel > 2){"Entering equiMaxEHV.";}
139  if(attrib(basering,"global")==0)
140    {
141      ERROR("// Not implemented for this ordering, please change to global ordering.");
142    }
143  ideal J = groebner(I);
144  int cod = nvars(basering)-dim(J);
145
146  //If I is the entire ring...
147  if(cod > nvars(basering))
148    {
149      //...then return the ideal generated by 1.
150      return(ideal(1));
151    }
152
153  //Compute a resolution of I.
154  if(printlevel > 2){"Computing resolution.";}
155  if(homog(I)==1)
156    {
157      list re = sres(J,cod+1);
158      re = minres(re);
159    }
160  else
161    {
162      list re = mres(I,cod+1);
163    }
164  if(printlevel > 2){"Finished computing resolution.";}
165
166  //Compute the annihilator of the cod-th EXT-module.
167  ideal ann = AnnExtEHV(cod,re);
168  attrib(ann,"isEquidimensional",1);
169  if(printlevel > 2){"Leaving equiMaxEHV.";}
170  return(ann);
171}
172
173example
174{
175  "EXAMPLE:";
176  echo = 2;
177  ring  r = 0,(x,y,z),dp;
178  ideal I = intersect(ideal(z),ideal(x,y),ideal(x2,z2),ideal(x5,y5,z5));
179  equiMaxEHV(I);
180}
181
182
183/////////////////////////////////////////////////////////////////////
184proc removeComponent(ideal I, int e)
185"USAGE:   removeComponent(I,e); I ideal, e integer
186RETURN:  ideal, the intersection of the primary components
187         of I of dimension >= e
188EXAMPLE: example removeComponent; shows an example"
189{
190  if(attrib(basering,"global")==0)
191    {
192      ERROR("// Not implemented for this ordering, please change to global ordering.");
193    }
194
195  ideal J = groebner(I);
196
197  //Compute a resolution of I
198  if(homog(I)==1)
199    {
200      list re = sres(J,0);
201      re = minres(re);
202    }
203  else
204    {
205      list re = mres(I,0);
206    }
207
208  int f = nvars(basering);
209  int cod;
210  ideal ann;
211  int g = nvars(basering) - e;
212  while(f > g)
213    {
214      ann = AnnExtEHV(f,re);
215      cod = nvars(basering) - dim(groebner(ann));
216      if( cod == f )
217        {
218          I = quotient(I,ann);
219        }
220      f = f-1;
221    }
222  return(I);
223}
224
225example
226{
227  "EXAMPLE:";
228  echo = 2;
229  ring  r = 0,(x,y,z),dp;
230  ideal I = intersect(ideal(z),ideal(x,y),ideal(x2,z2),ideal(x5,y5,z5));
231  removeComponent(I,1);
232}
233
234
235/////////////////////////////////////////////////////////////////////
236proc AssOfDim(ideal I, int e)
237"USAGE:   AssOfDim(I,e); I ideal, e integer
238RETURN:  ideal, such that the associated primes are exactly
239         the associated primes of I having dimension e
240EXAMPLE: example AssOfDim; shows an example"
241{
242  if(attrib(basering,"global")==0)
243    {
244      ERROR("// Not implemented for this ordering, please change to global ordering.");
245    }
246  int g = nvars(basering) - e;
247
248  //Compute a resolution of I.
249  ideal J = std(I);
250  if(homog(I)==1)
251    {
252      list re = sres(J,g+1);
253      re = minres(re);
254    }
255  else
256    {
257      list re = mres(I,g+1);
258    }
259
260  ideal ann = AnnExtEHV(g,re);
261  int cod = nvars(basering) - dim(std(ann));
262
263  //If the codimension of I_g:=Ann(Ext^g(R/I,R)) equals g...
264  if(cod == g)
265    {
266      //...then return the equidimensional part of I_g...
267      ann = equiMaxEHV(ann);
268      attrib(ann,"isEquidimensional",1);
269      return(ann);
270    }
271  //...otherwise...
272  else
273    {
274      //...I has no associated primes of dimension e.
275      return(ideal(1));
276    }
277}
278
279example
280{
281  "EXAMPLE:";
282  echo = 2;
283  ring  r = 0,(x,y,z),dp;
284  ideal I = intersect(ideal(z),ideal(x,y),ideal(x2,z2),ideal(x5,y5,z5));
285  AssOfDim(I,1);
286}
287
288/////////////////////////////////////////////////////////////////////
289//                                                                 //
290//                      T H E   R A D I C A L                      //
291//                                                                 //
292/////////////////////////////////////////////////////////////////////
293
294/////////////////////////////////////////////////////////////////////
295static proc aJacob(ideal I, int a)
296"USAGE:   aJacob(I,a); I ideal, a integer
297RETURN:  ideal, the ath-Jacobian ideal of I"
298{
299  matrix M = jacob(I);
300  int n = nvars(basering);
301  if(n-a <= 0)
302    {
303      return(ideal(1));
304    }
305  if(n-a > nrows(M) or n-a > ncols(M))
306    {
307      return(ideal(0));
308    }
309  ideal J = minor(M,n-a);
310  return(J);
311}
312
313
314/////////////////////////////////////////////////////////////////////
315proc equiRadEHV(ideal I, list #)
316"USAGE:   equiRadEHV(I [,Strategy]); I ideal, Strategy list
317RETURN:  ideal, the equidimensional radical of I,
318         i.e. the intersection of the minimal associated primes of I
319         having the same dimension as I
320NOTE:    Uses the algorithm of Eisenbud/Huneke/Vasconcelos,
321         Works only in characteristic 0 or p large.
322         The (optional) second argument determines the strategy used:
323         Strategy[1]        > strategy for the equidimensional part
324                     = 0    : uses equiMaxEHV
325                     = 1    : uses equidimMax
326         Strategy[2]        > strategy for the radical
327                     = 0    : combination of strategy 1 and 2
328                     = 1    : computation of the radical just with the
329                              help of regular sequences
330                     = 2    : does not try to find a regular sequence
331         If no second argument is given then Strategy=(0,0,0) is used.
332EXAMPLE: example equiRadEHV; shows an example"
333{
334  if(printlevel > 2){"Entering equiRadEHV.";}
335  if(attrib(basering,"global")==0)
336    {
337      ERROR("// Not implemented for this ordering, please change to global ordering.");
338    }
339  if((char(basering)<100)&&(char(basering)!=0))
340    {
341      "WARNING: The characteristic is too small, the result may be wrong";
342    }
343
344  //Define the Strategy to be used.
345  if(size(#) > 0)
346    {
347      if(#[1]!=1)
348        {
349          int equStr = 0;
350        }
351      else
352        {
353          int equStr = 1;
354        }
355      if(size(#) > 1)
356        {
357          if(#[2]!=1 and #[2]!=2)
358            {
359              int strategy = 0;
360            }
361          else
362            {
363              int strategy = #[2];
364            }
365        }
366      else
367        {
368          int strategy = 0;
369        }
370    }
371  else
372    {
373      int equStr = 0;
374      int strategy = 0;
375    }
376
377  ideal J,I0,radI0,L,radI1,I2,radI2;
378  int l,n;
379  intvec op = option(get);
380  matrix M;
381
382  option(redSB);
383  list m = mstd(I);
384  option(set,op);
385
386  int d = dim(m[1]);
387  if(d==-1)
388    {
389      return(ideal(1));
390    }
391
392  if(strategy != 2)
393    {
394      /////////////////////////////////////////////
395      // Computing the equidimensional radical   //
396      // via regular sequenves                   //
397      /////////////////////////////////////////////
398
399      if(printlevel > 2){"Trying to find a regular sequence.";}
400      int cod = nvars(basering)-d;
401
402      //Complete intersection case:
403      if(cod==size(m[2]))
404        {
405          J = aJacob(m[2],d);
406          if(printlevel > 2){"Leaving equiRadEHV.";}
407          return(quotient(m[2],J));
408        }
409
410      //First codim elements of I are a complete intersection:
411      for(l=1; l<=cod; l++)
412        {
413          I0[l] = m[2][l];
414        }
415      n = dim(groebner(I0))+cod-nvars(basering);
416
417      //Last codim elements of I are a complete intersection:
418      if(n!=0)
419              {
420          for(l=1; l<=cod; l++)
421            {
422              I0[l] = m[2][size(m[2])-l+1];
423            }
424          n = dim(groebner(I0))+cod-nvars(basering);
425        }
426
427      //Taking a generic linear combination of the input:
428      if(n!=0)
429              {
430          M = transpose(sparsetriag(size(m[2]),cod,95,1));
431          I0 = ideal(M*transpose(m[2]));
432          n = dim(groebner(I0))+cod-nvars(basering);
433        }
434
435      //Taking a more generic linear combination of the input:
436      if(n!=0)
437        {
438          while(strategy == 1 and n!=0)
439            {
440              M = transpose(sparsetriag(size(m[2]),cod,0,100));
441              I0 = ideal(M*transpose(m[2]));
442              n = dim(groebner(I0))+cod-nvars(basering);
443            }
444        }
445
446      if(n==0)
447        {
448          J = aJacob(I0,d);
449          if(printlevel > 2){"1st quotient.";}
450          radI0 = quotient(I0,J);
451          if(printlevel > 2){"2nd quotient.";}
452          L = quotient(radI0,m[2]);
453          if(printlevel > 2){"3rd quotient.";}
454          radI1 = quotient(radI0,L);
455          attrib(radI1,"isEquidimensional",1);
456          attrib(radI1,"isRadical",1);
457          if(printlevel > 2){"Leaving equiRadEHV.";}
458          return(radI1);
459        }
460    }
461
462  ////////////////////////////////////////////////////
463  // Computing the equidimensional radical directly //
464  ////////////////////////////////////////////////////
465
466  if(printlevel > 2){"Computing the equidimensional radical directly";}
467
468  //Compute the equidimensional part depending on the chosen strategy
469  if(equStr == 0)
470    {
471      I = equiMaxEHV(I);
472    }
473  if(equStr == 1)
474    {
475      I = equidimMax(I);
476    }
477  int a = nvars(basering)-1;
478
479  while(a > d)
480    {
481      if(printlevel > 2){"While-Loop: "+string(a);}
482      J = aJacob(I,a);
483      while(dim(groebner(J+I))==d)
484        {
485          if(printlevel > 2){"Quotient-Computation.";}
486          I = quotient(I,J);
487          if(printlevel > 2){"Computing the a-th Jacobian";}
488            J = aJacob(I,a);
489        }
490      a = a-1;
491    }
492  if(printlevel > 2){"We left While-Loop.";}
493  if(printlevel > 2){"Computing the a-th Jacobian";}
494  J = aJacob(I,d);
495  if(printlevel > 2){"Quotient-Computation.";}
496  I = quotient(I,J);
497  attrib(I,"isEquidimensional",1);
498  attrib(I,"isRadical",1);
499  if(printlevel > 2){"Leaving equiRadEHV.";}
500  return(I);
501}
502
503example
504{
505  "EXAMPLE:";
506  echo = 2;
507  ring  r = 0,(x,y,z),dp;
508  poly  p = z2+1;
509  poly  q = z3+2;
510  ideal i = p*q^2,y-z2;
511  ideal pr= equiRadEHV(i);
512  pr;
513}
514
515/////////////////////////////////////////////////////////////////////
516proc radEHV(ideal I, list #)
517"USAGE:   radEHV(I [,Strategy]); ideal I, Strategy list
518RETURN:  ideal, the radical of I
519NOTE:    uses the algorithm of Eisenbud/Huneke/Vasconcelos
520         Works only in characteristic 0 or p large.
521         The (optional) second argument determines the strategy used:
522         Strategy[1]        > strategy for the equidimensional part
523                     = 0    : uses equiMaxEHV
524                     = 1    : uses equidimMax
525         Strategy[2]        > strategy for the radical
526                     = 0    : combination of strategy 1 and 2
527                     = 1    : computation of the radical just with the
528                              help of regular sequences
529                     = 2    : does not try to find a regular sequence
530         Strategy[3]        > strategy for the computation of ideal quotients
531                     = n    : uses quot(.,.,n) for the ideal quotient computations
532         If no second argument is given then Strategy=(0,0,0) is used.
533EXAMPLE: example radEHV; shows an example"
534{
535  if(printlevel > 2){"Entering radEHV.";}
536  if(attrib(basering,"global")==0)
537    {
538      ERROR("// Not implemented for this ordering, please change to global ordering.");
539    }
540
541  //Compute the equidimensional radical J of I.
542  ideal J = equiRadEHV(I,#);
543
544  //If I is the entire ring...
545  if(deg(J[1]) <= 0)
546    {
547      //...then return the ideal generated by 1...
548      return(ideal(1));
549    }
550
551  //...else remove the maximal dimensional components and
552  //compute the radical K of the lower dimensional components ...
553  ideal K = radEHV(sat(I,J)[1],#);
554
555  //..and intersect it with J.
556  K = intersect(J,K);
557  attrib(K,"isRadical",1);
558  return(K);
559}
560
561example
562{
563  "EXAMPLE:";
564  echo = 2;
565  ring  r = 0,(x,y,z),dp;
566  poly  p = z2+1;
567  poly  q = z3+2;
568  ideal i = p*q^2,y-z2;
569  ideal pr= radical(i);
570  pr;
571}
572
573/////////////////////////////////////////////////////////////////////
574proc IntAssOfDim1(ideal I, int e)
575"USAGE:   IntAssOfDim1(I,e); I idea, e integer
576RETURN:  ideal, the intersection of the associated primes of I having dimension e
577EXAMPLE: example IntAssOfDim1; shows an example"
578{
579  if(attrib(basering,"global")==0)
580    {
581      ERROR("// Not implemented for this ordering, please change to global ordering.");
582    }
583  int g = nvars(basering) - e;
584
585  //Compute a resolution of I.
586  ideal J = groebner(I);
587  if(homog(I)==1)
588    {
589      list re = sres(J,g+1);
590      re = minres(re);
591    }
592  else
593    {
594      list re = mres(I,g+1);
595    }
596
597  ideal ann = AnnExtEHV(g,re);
598  int cod = nvars(basering) - dim(groebner(ann));
599  //If the codimension of I_g:=Ann(Ext^g(R/I,I)) equals g...
600  if(cod == g)
601    {
602      //...then return the equidimensional radical of I_g...
603      ann = equiRadEHV(ann);
604      attrib(ann,"isEquidimensional",1);
605      attrib(ann,"isRadical",1);
606      return(ann);
607    }
608  else
609    {
610      //...else I has no associated primes of dimension e.
611      return(ideal(1));
612    }
613}
614
615example
616{
617  "EXAMPLE:";
618  echo = 2;
619  ring  r = 0,(x,y,z),dp;
620  ideal I = intersect(ideal(z),ideal(x,y),ideal(x2,z2),ideal(x5,y5,z5));
621  IntAssOfDim1(I,1);
622}
623
624/////////////////////////////////////////////////////////////////////
625proc IntAssOfDim2(ideal I, int e)
626"USAGE:   IntAssOfDim2(I,e); I ideal, e integer
627RETURN:  ideal, the intersection of the associated primes of I having dimension e
628EXAMPLE: example IntAssOfDim2; shows an example"
629{
630  if(attrib(basering,"global")==0)
631    {
632      ERROR("// Not implemented for this ordering, please change to global ordering.");
633    }
634  ideal I1 = removeComponent(I,e);
635  ideal I2 = removeComponent(I,e+1);
636  ideal b = quotient(I1,I2);
637  b = equiRadEHV(b);
638  return(b);
639}
640
641example
642{
643  "EXAMPLE:";
644  echo = 2;
645  ring  r = 0,(x,y,z),dp;
646  ideal I = intersect(ideal(z),ideal(x,y),ideal(x2,z2),ideal(x5,y5,z5));
647  IntAssOfDim2(I,1);
648}
649
650
651/////////////////////////////////////////////////////////////////////
652//                                                                 //
653//   Z E R O - D I M E N S I O N A L   D E C O M P O S I T I O N   //
654//                                                                 //
655/////////////////////////////////////////////////////////////////////
656
657/////////////////////////////////////////////////////////////////////
658proc decompEHV(ideal I)
659"USAGE:   decompEHV(I); I zero-dimensional radical ideal
660RETURN:  list, the associated primes of I
661EXAMPLE: example decompEHV; shows an example"
662{
663  if(printlevel > 2){"Entering decompEHV.";}
664  if(attrib(basering,"global")==0)
665    {
666      ERROR("// Not implemented for this ordering, please change to global ordering.");
667    }
668
669  int e,m,vd,nfact;
670  list l,k,L;
671  poly f,h;
672  ideal J;
673  def base = basering;
674
675  if( attrib(I,"isSB")!=1 )
676    {
677      I = groebner(I);
678    }
679
680  while(1)
681    {
682      //Choose a random polynomial f from R.
683      e = random(0,100);
684      f = sparsepoly(e);
685
686      //Check if f lies not in I.
687      if(reduce(f,I)!=0)
688        {
689          J = quotient1(I,f);
690
691          //If f is a zerodivisor modulo I...
692          if( isSubset(J,I) == 0 )
693            {
694              //...then use recursion...
695              if(printlevel > 2){"We found a zerodivisor -- recursion";}
696              l = decompEHV(J) + decompEHV(I+f);
697              return(l);
698            }
699          if(printlevel > 2){"We found a non-zero-divisor.";}
700
701          //...else compute the vectorspace dimension vd of I and...
702          vd = vdim(I);
703
704          //...compute m minimal such that 1,f,f^2,...,f^m are linearly dependent.
705          qring Q = I;
706          poly g = fetch(base,f);
707          k = algDependent(g);
708          def R = k[2];
709          setring R;
710          if(size(ker)!=1)
711            {
712              //Calculate a generator for ker.
713              ker = mstd(ker)[2];
714            }
715          poly g = ker[1];
716          m = deg(g);
717
718          //If m and vd coincide...
719          if(m==vd)
720            {
721              if(printlevel > 2){"We have a good candidate.";}
722              //...then factorize g.
723              if(printlevel > 2){"Factorizing.";}
724              L = factorize(g,2);    //returns non-constant factors and multiplicities
725              nfact = size(L[1]);
726
727              //If g is irreducible...
728              if(nfact==1 and L[2][1]==1)
729                {
730                  if(printlevel > 2){"The element is irreducible.";}
731                  setring base;
732                  //..then I is a maximal ideal...
733                  l[1] = I;
734                  kill R,Q;
735                  return(l);
736                }
737              //...else...
738              else
739                {
740
741                  if(printlevel > 2){"The element is not irreducible -- recursion.";}
742                  //...take a non-trivial factor g1 of g ...
743                  poly g1 = L[1][1];
744                  //..and insert f in g1...
745                  execute("ring newR = (" + charstr(R) + "),(y(1)),(" + ordstr(R) + ");");
746                  poly g2 = imap(R,g1);
747                  setring base;
748                  h = fetch(newR,g2);
749                  h = subst(h,var(1),f);
750                  //...and use recursion...
751                  kill R,Q,newR;
752                  l = l + decompEHV(quotient1(I,h));
753                  l = l + decompEHV(I+h);
754                  return(l);
755                }
756            }
757          setring base;
758          kill R,Q;
759          }
760    }
761}
762
763example
764{
765  "EXAMPLE:";
766  echo = 2;
767  ring r = 32003,(x,y),dp;
768  ideal i = x2+y2-10,x2+xy+2y2-16;
769  decompEHV(i);
770}
771
772
773/////////////////////////////////////////////////////////////////////
774//                                                                 //
775//           A S S O C I A T E D   P R I M E S                     //
776//                                                                 //
777/////////////////////////////////////////////////////////////////////
778
779
780/////////////////////////////////////////////////////////////////////
781static proc idempotent(ideal I)
782"USAGE:   idempotent(I); ideal I (weighted) homogeneous radical ideal,
783         I intersected K[x(1),...,x(k)] zero-dimensional
784         where deg(x(i))=0 for all i <= k and deg(x(i))>0 for all i>k.
785RETURN:  a list of ideals I(1),...,I(t) such that
786         K[x]/I = K[x]/I(1) x ... x K[x]/I(t)"
787{
788  if(printlevel > 2){"Entering idempotent.";}
789  if(attrib(basering,"global")==0)
790    {
791      ERROR("// Not implemented for this ordering, please change to global ordering.");
792    }
793  int n = nvars(basering);
794  poly f,g;
795  string j;
796  int i,k,splits;
797  list l;
798
799  //Collect all variables of degree 0.
800  for(i=1; i<=n; i++)
801    {
802      if(deg(var(i)) > 0)
803        {
804          f = f*var(i);
805        }
806      else
807        {
808          splits = 1;
809          j = j +  string(var(i)) + "," ;
810        }
811    }
812  //If there are no variables of degree 0
813  //then there are no idempotents and we are done...
814  if(splits == 0)
815    {
816      l[1]=I;
817      return(l);
818    }
819
820  //...else compute J = I intersected K[x(1),...,x(k)]...
821  ideal J = eliminate(I,f);
822  def base = basering;
823  j = j[1,size(j)-1];
824  j = "ring @r = (" + charstr(basering) + "),(" + j + "),(" + ordstr(basering) + ");";
825  execute(j);
826  ideal J = imap(base,J);
827
828  //...and compute the associated primes of the zero-dimensional ideal J.
829  list L = decompEHV(J);
830  int s = size(L);
831  ideal K,Z;
832  poly g;
833  //For each associated prime ideal P_i of J...
834  for(i=1; i<=s; i++)
835    {
836      K = ideal(1);
837      //...comnpute the intersection K of the other associated prime ideals...
838      for(k=1; k<=s; k++)
839        {
840          if(i!=k)
841            {
842              K = intersect(K,L[k]);
843            }
844        }
845
846      //...and find an element that lies in K but not in P_i...
847      g = randomid(K,1)[1];
848      Z = L[i];
849      Z = std(Z);
850      while(reduce(g,Z)==0)
851        {
852          g = randomid(K,1)[1];
853        }
854      setring base;
855      g = imap(@r,g);
856      //...and compute the corresponding ideal I(i)
857      l[i] = quotient(I,g);
858      setring @r;
859
860    }
861  setring base;
862  return(l);
863}
864
865
866/////////////////////////////////////////////////////////////////////
867static proc equiAssEHV(ideal I)
868"USAGE:   equiAssEHV(I); I equidimensional, radical, and homogeneous ideal
869RETURN:  a list, the associated prime ideals of I"
870{
871  if(printlevel > 2){"Entering equiAssEHV.";}
872  if(attrib(basering,"global")==0)
873    {
874      ERROR("// Not implemented for this ordering, please change to global ordering.");
875    }
876  list L;
877  def base = basering;
878  int n = nvars(basering);
879  int i,j;
880
881  //Compute the normalization of I.
882  if(printlevel > 2){"Entering Normalization.";}
883  list norOut = normal(I, "noDeco");
884  list K = norOut[1];
885  if(printlevel > 2){"Leaving Normalisation.";}
886
887  //The normalization algorithm returns k factors.
888  int k = size(K);
889  if(printlevel > 1){"Normalization algorithm splits ideal in " + string(k) + " factors.";}
890
891  //Examine each factor of the normalization.
892  def P;
893  for(i=1; i<=k; i++)
894    {
895      P = K[i];
896      setring P;
897
898      //Use procedure idempotent to split the i-th factor of
899      //the normalization in a product of integral domains.
900      if(printlevel > 1){"Examining " + string(i) +". factor.";}
901      list l = idempotent(norid);
902      int leng = size(l);
903      if(printlevel > 1){"Idempotent algorithm splits factor " + string(i) + " in " + string(leng) + " factors.";}
904
905      //Intersect the minimal primes corresponding to the
906      //integral domains obtained from idempotent with the groundring,
907      //i.e. compute the preimages w.r.t. the corresponding normalization map
908      ideal J;
909      for(j=1; j<=leng; j++)
910        {
911          J = l[j];
912          setring base;
913          L[size(L)+1] = preimage(P,normap,J);
914          setring P;
915        }
916      kill l, leng, J;
917      setring base;
918    }
919
920  return(L);
921}
922
923
924/////////////////////////////////////////////////////////////////////
925proc AssEHV(ideal I, list #)
926"USAGE:  AssEHV(I [,Strategy]); I Ideal, Strategy list
927RETURN:  a list, the associated prime ideals of I
928NOTE:    Uses the algorithm of Eisenbud/Huneke/Vasconcelos.
929         The (optional) second argument determines the strategy used:
930         Strategy[1]        > strategy for the equidimensional part
931                     = 0    : uses equiMaxEHV
932                     = 1    : uses equidimMax
933         Strategy[2]        > strategy for the equidimensional radical
934                     = 0    : uses equiRadEHV
935                     = 1    : uses equiRadical
936         Strategy[3]        > strategy for equiRadEHV
937                     = 0    : combination of strategy 1 and 2
938                     = 1    : computation of the radical just with the
939                              help of regular sequences
940                     = 2    : does not try to find a regular sequence
941         Strategy[4]        > strategy for the computation of ideal quotients
942                     = n    : uses quot(.,.,n) for the ideal quotient computations
943         If no second argument is given, Strategy=(0,0,0,0) is used.
944EXAMPLE: example AssEHV; shows an example"
945{
946  if(attrib(basering,"global")==0)
947    {
948      ERROR("// Not implemented for this ordering, please change to global ordering.");
949    }
950  if(printlevel > 2){"Entering AssEHV";}
951
952  //Specify the strategy to be used.
953  if(size(#)==0)
954    {
955      # = 0,0,0,0;
956    }
957  if(size(#)==1)
958    {
959      # = #[1],0,0,0;
960    }
961  if(size(#)==2)
962    {
963      # = #[1],#[2],0,0;
964    }
965  if(size(#)==3)
966    {
967      # = #[1],#[2],#[3],0;
968    }
969
970  list L;
971  ideal K;
972  def base = basering;
973  int m,j;
974  ideal J = groebner(I);
975  int n = nvars(basering);
976  int d = dim(J);
977
978  //Compute a resolution of I.
979  if(printlevel > 2){"Computing resolution.";}
980  if(homog(I)==1)
981    {
982      list re = sres(J,0);
983      re = minres(re);
984    }
985  else
986    {
987      list re = mres(I,0);
988    }
989  ideal ann;
990  int cod;
991
992  //For 0<=i<= dim(I) compute the intersection of the i-dimensional associated primes of I
993  for(int i=0; i<=d; i++)
994    {
995      if(printlevel > 1){"Are there components of dimension " + string(i) + "?";}
996      ann = AnnExtEHV(n-i,re);
997      cod = n - dim(groebner(ann));
998
999      //If there are associated primes of dimension i...
1000      if(cod == n-i)
1001        {
1002          if(printlevel > 1){"Yes. There are components of dimension " + string(i) + ".";}
1003          //...then compute the intersection K of all associated primes of I of dimension i
1004          if(#[2]==0)
1005            {
1006              if(size(#) > 3)
1007                {
1008                  K = equiRadEHV(ann,#[1],#[3],#[4]);
1009                }
1010              if(size(#) > 2)
1011                {
1012                  K = equiRadEHV(ann,#[1],#[3]);
1013                }
1014              else
1015                {
1016                  K = equiRadEHV(ann,#[1]);
1017                }
1018            }
1019          if(#[2]==1)
1020            {
1021              K = equiRadical(ann);
1022            }
1023          attrib(K,"isEquidimensional",1);
1024          attrib(K,"isRadical",1);
1025
1026          //If K is already homogeneous then use equiAssEHV to recover the associated primes of K...
1027           if(homog(K)==1)
1028            {
1029              if(printlevel > 2){"Input already homogeneous.";}
1030              L = L + equiAssEHV(K);
1031            }
1032
1033          //...else...
1034          else
1035            {
1036              //...homogenize K w.r.t. t,...
1037              if(printlevel > 2){"Input not homogeneous; must homogenize.";}
1038              def homoR=changeord(list(list("dp",1:nvars(basering))));
1039              setring homoR;
1040              ideal homoJ = fetch(base,K);
1041              homoJ = groebner(homoJ);
1042              execute("ring newR = (" + charstr(base) + "),(x(1..n),t),dp;");
1043              ideal homoK = fetch(homoR,homoJ);
1044              homoK = homog(homoK,t);
1045              attrib(homoK,"isEquidimensional",1);
1046              attrib(homoK,"isRadical",1);
1047
1048              //...compute the associated primes of the homogenization using equiAssEHV,...
1049              list l = equiAssEHV(homoK);
1050
1051              //...and set t=1 in the generators of the associated primes just computed.
1052              ideal Z;
1053              for(j=1; j<=size(l); j++)
1054                {
1055                  Z = subst(l[j],t,1);
1056                  setring base;
1057                  L[size(L)+1] = fetch(newR,Z);
1058                  setring newR;
1059                }
1060              setring base;
1061              kill homoR;
1062              kill newR;
1063            }
1064        }
1065      else
1066        {
1067          if(printlevel > 1){"No. There are no components of dimension " + string(i) + ".";}
1068        }
1069    }
1070  return(L);
1071}
1072
1073example
1074{
1075  "EXAMPLE:";
1076  echo = 2;
1077  ring  r = 0,(x,y,z),dp;
1078  poly  p = z2+1;
1079  poly  q = z3+2;
1080  ideal i = p*q^2,y-z2;
1081  list pr = AssEHV(i);
1082  pr;
1083}
1084
1085/////////////////////////////////////////////////////////////////////
1086proc minAssEHV(ideal I, list #)
1087"USAGE:  minAssEHV(I [,Strategy]); I ideal, Strategy list
1088RETURN:  a list, the minimal associated prime ideals of I
1089NOTE:    Uses the algorithm of Eisenbud/Huneke/Vasconcelos.
1090         The (optional) second argument determines the strategy used:
1091         Strategy[1]        > strategy for the equidimensional part
1092                     = 0    : uses equiMaxEHV
1093                     = 1    : uses equidimMax
1094         Strategy[2]        > strategy for the equidimensional radical
1095                     = 0    : uses equiRadEHV, resp. radicalEHV
1096                     = 1    : uses equiRadical, resp. radical
1097         Strategy[3]        > strategy for equiRadEHV
1098                     = 0    : combination of strategy 1 and 2
1099                     = 1    : computation of the radical just with the
1100                              help of regular sequences
1101                     = 2    : does not try to find a regular sequence
1102         Strategy[4]        > strategy for the computation of ideal quotients
1103                     = n    : uses quot(.,.,n) for the ideal quotient computations
1104         If no second argument is given, Strategy=(0,0,0,0) is used.
1105EXAMPLE: example minAssEHV; shows an example"
1106{
1107  if(attrib(basering,"global")==0)
1108    {ERROR("// Not implemented for this ordering, please change to global ordering.");}
1109
1110  //Specify the strategy to be used.
1111  if(size(#)==0)
1112    {
1113      # = 0,0,0,0;
1114    }
1115  if(size(#)==1)
1116    {
1117      # = #[1],0,0,0;
1118    }
1119  if(size(#)==2)
1120    {
1121      # = #[1],#[2],0,0;
1122    }
1123  if(size(#)==3)
1124    {
1125      # = #[1],#[2],#[3],0;
1126    }
1127
1128  //Compute the radical of I.
1129  if(#[2]==0)
1130    {
1131      I = radEHV(I,#);
1132    }
1133  if(#[2]==1)
1134    {
1135      I = radical(I);
1136    }
1137
1138  //Compute the associated primes of the radical.
1139  return(AssEHV(I,#));
1140}
1141
1142example
1143{
1144  "EXAMPLE:";
1145  echo = 2;
1146  ring  r = 0,(x,y,z),dp;
1147  poly  p = z2+1;
1148  poly  q = z3+2;
1149  ideal i = p*q^2,y-z2;
1150  list pr = minAssEHV(i);
1151  pr;
1152}
1153
1154
1155/////////////////////////////////////////////////////////////////////
1156//                                                                 //
1157//        P R I M A R Y   D E C O M P O S I T I O N                //
1158//                                                                 //
1159/////////////////////////////////////////////////////////////////////
1160
1161
1162/////////////////////////////////////////////////////////////////////
1163proc localize(ideal I, ideal P, list l)
1164"USAGE:   localize(I,P,l); I ideal, P an associated prime ideal of I,
1165         l list of all associated primes of I
1166RETURN:  ideal,  the contraction of the ideal generated by I
1167         in the localization w.r.t P
1168EXAMPLE: example localize; shows an example"
1169{
1170  if(attrib(basering,"global")==0)
1171    {
1172      ERROR("// Not implemented for this ordering, please change to global ordering.");
1173    }
1174
1175  ideal Intersection = ideal(1);
1176  int s = size(l);
1177  if(attrib(P,"isSB")!=1)
1178    {
1179      P = groebner(P);
1180    }
1181
1182  //Compute the intersection of all associated primes of I that are not contained in P.
1183  for(int i=1; i<=s; i++)
1184    {
1185      if(isSubset(l[i],P)!=1)
1186        {
1187          Intersection = intersect(Intersection,l[i]);
1188        }
1189    }
1190  Intersection = groebner(Intersection);
1191
1192  //If the intersection is the entire ring...
1193  if(reduce(1,Intersection)==0)
1194    {
1195      //...then return I...
1196      return(I);
1197    }
1198  //...else try to find an element f that lies in the intersection but outside P...
1199  poly f = 0;
1200  while(reduce(f,P) == 0)
1201    {
1202      f = randomid(Intersection,1)[1];
1203    }
1204
1205  //...and saturate I w.r.t. f.
1206  I = sat(I,f)[1];
1207  return(I);
1208}
1209
1210/////////////////////////////////////////////////////////////////////
1211proc componentEHV(ideal I, ideal P, list L, list #)
1212"USAGE:   componentEHV(I,P,L [,Strategy]);
1213         I ideal, P associated prime of I,
1214         L list of all associated primes of I, Strategy list
1215RETURN:  ideal, a P-primary component Q for I
1216NOTE:    The (optional) second argument determines the strategy used:
1217         Strategy[1]        > strategy for equidimensional part
1218                     = 0    : uses equiMaxEHV
1219                     = 1    : uses equidimMax
1220         If no second argument is given then Strategy=0 is used.
1221EXAMPLE: example componentEHV; shows an example"
1222{
1223  if(printlevel > 2){"Entering componentEHV.";}
1224  if(attrib(basering,"global")==0)
1225    {
1226      ERROR("// Not implemented for this ordering, please change to global ordering.");
1227    }
1228
1229  //If no strategy is specified use standard strategy.
1230  if(size(#)==0)
1231    {
1232      # = 0;
1233    }
1234
1235  ideal T = P;
1236  ideal Q;
1237
1238  //Compute the localization of I at P...
1239  ideal IP = groebner(localize(I,P,L));
1240
1241  //...and compute the saturation of the localization w.r.t. P.
1242  ideal IP2 = sat(IP,P)[1];
1243
1244  //As long as we have not found a primary component...
1245  int isPrimaryComponent = 0;
1246  while(isPrimaryComponent!=1)
1247    {
1248      //...compute the equidimensional part Q of I+P^n...
1249      if(#[1]==0)
1250        {
1251          Q = equiMaxEHV(I+T);
1252        }
1253      if(#[1]==1)
1254        {
1255          Q = equidimMax(I+T);
1256        }
1257      //...and check if it is a primary component for P.
1258      if(isSubset(intersect(IP2,Q),IP)==1)
1259        {
1260          isPrimaryComponent = 1;
1261        }
1262      else
1263        {
1264          T = T*P;
1265        }
1266    }
1267  if(printlevel > 2){"Leaving componentEHV.";}
1268  return(Q);
1269}
1270
1271example
1272{
1273  "EXAMPLE:";
1274  echo = 2;
1275  ring  r = 0,(x,y,z),dp;
1276  poly  p = z2+1;
1277  poly  q = z3+2;
1278  ideal i = p*q^2,y-z2;
1279  list pr = AssEHV(i);
1280  componentEHV(i,pr[1],pr);
1281}
1282
1283
1284/////////////////////////////////////////////////////////////////////
1285proc primdecEHV(ideal I, list #)
1286"USAGE:   primdecEHV(I [,Strategy]); I ideal, Strategy list
1287RETURN:  a list pr of primary ideals and their associated primes:
1288                pr[i][1]   the i-th primary component,
1289                pr[i][2]   the i-th prime component.
1290NOTE:    Algorithm of Eisenbud/Huneke/Vasconcelos.
1291         The (optional) second argument determines the strategy used:
1292         Strategy[1]        > strategy for equidimensional part
1293                     = 0    : uses equiMaxEHV
1294                     = 1    : uses equidimMax
1295         Strategy[2]        > strategy for equidimensional radical
1296                     = 0    : uses equiRadEHV, resp. radicalEHV
1297                     = 1    : uses equiRadical, resp. radical
1298         Strategy[3]        > strategy for equiRadEHV
1299                     = 0    : combination of strategy 1 and 2
1300                     = 1    : computation of the radical just with the
1301                              help of regular sequences
1302                     = 2    : does not try to find a regular sequence
1303         Strategy[4]        > strategy for the computation of ideal quotients
1304                     = n    : uses quot(.,.,n) for the ideal quotient computations
1305         If no second argument is given then Strategy=(0,0,0,0) is used.
1306EXAMPLE: example primdecEHV; shows an example"
1307{
1308  if(printlevel > 2){"Entering primdecEHV.";}
1309  if(attrib(basering,"global")==0)
1310    {
1311      ERROR("// Not implemented for this ordering, please change to global ordering.");
1312    }
1313  list L,K;
1314
1315  //Specify the strategy to be used.
1316  if(size(#)==0)
1317    {
1318      # = 0,0,0,0;
1319    }
1320  if(size(#)==1)
1321    {
1322      # = #[1],0,0,0;
1323    }
1324  if(size(#)==2)
1325    {
1326      # = #[1],#[2],0,0;
1327    }
1328  if(size(#)==3)
1329    {
1330      # = #[1],#[2],#[3],0;
1331    }
1332
1333  //Compute the associated primes of I...
1334  L = AssEHV(I,#);
1335  if(printlevel > 0){"We have " + string(size(L)) + " prime components.";}
1336
1337  //...and compute for each associated prime of I a corresponding primary component.
1338  int l = size(L);
1339  for(int i=1; i<=l; i++)
1340    {
1341      K[i] = list();
1342      K[i][2] = L[i];
1343      K[i][1] = componentEHV(I,L[i],L,#[1]);
1344    }
1345  if(printlevel > 2){"Leaving primdecEHV.";}
1346  return(K);
1347
1348}
1349
1350example
1351{
1352  "EXAMPLE:";
1353  echo = 2;
1354  ring  r = 0,(x,y,z),dp;
1355  poly  p = z2+1;
1356  poly  q = z3+2;
1357  ideal i = p*q^2,y-z2;
1358  list pr = primdecEHV(i);
1359  pr;
1360}
1361
1362
1363/////////////////////////////////////////////////////////////////////
1364//                                                                 //
1365//        A L G O R I T H M S   F O R   T E S T I N G              //
1366//                                                                 //
1367/////////////////////////////////////////////////////////////////////
1368
1369
1370/////////////////////////////////////////////////////////////////////
1371proc compareLists(list L, list K)
1372"USAGE:   checkLists(L,K); L,K list of ideals
1373RETURN:  integer, 1 if the lists are the same up to ordering and 0 otherwise
1374EXAMPLE: example checkLists; shows an example"
1375{
1376  int s1 = size(L);
1377  int s2 = size(K);
1378  if(s1!=s2)
1379    {
1380      return(0);
1381    }
1382  list L1, K1;
1383  int i,j,t;
1384  list N;
1385  for(i=1; i<=s1; i++)
1386    {
1387      L1[i]=std(L[i][2]);
1388      K1[i]=std(K[i][2]);
1389    }
1390  for(i=1; i<=s1; i++)
1391    {
1392      for(j=1; j<=s1; j++)
1393        {
1394          if(isSubset(L1[i],K1[j]))
1395            {
1396              if(isSubset(K1[j],L1[i]))
1397                {
1398                  for(t=1; t<=size(N); t++)
1399                    {
1400                      if(N[t]==j)
1401                        {
1402                          return(0);
1403                        }
1404                    }
1405                  N[size(N)+1]=j;
1406                }
1407
1408            }
1409        }
1410    }
1411  return(1);
1412}
1413
1414example
1415{
1416  "EXAMPLE:";
1417  echo = 2;
1418  ring  r = 0,(x,y),dp;
1419  ideal i = x2,xy;
1420  list L1 = primdecGTZ(i);
1421  list L2 = primdecEHV(i);
1422  compareLists(L1,L2);
1423}
1424
Note: See TracBrowser for help on using the repository browser.