source: git/Singular/LIB/noether.lib @ 2ab830

spielwiese
Last change on this file since 2ab830 was 66d68c, checked in by Hans Schoenemann <hannes@…>, 13 years ago
format git-svn-id: file:///usr/local/Singular/svn/trunk@13499 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 28.0 KB
Line 
1//////////////////////////////////////////////////////////////////////////////
2version = "$Id$";
3category="Commutative Algebra";
4info="
5LIBRARY: noether.lib   Noether normalization of an ideal (not nessecary
6                       homogeneous)
7AUTHORS: A. Hashemi,  Amir.Hashemi@lip6.fr
8
9
10OVERVIEW:
11A library for computing the Noether normalization of an ideal that DOES NOT
12require the computation of the dimension of the ideal.
13It checks whether an ideal is in Noether position.  A modular version of
14these algorithms is also provided.
15The procedures are based on a paper of Amir Hashemi 'Efficient Algorithms for
16Computing Noether Normalization' (presented in ASCM 2007)
17
18This library computes also Castelnuovo-Mumford regularity and satiety of an
19ideal.  A modular version of these algorithms is also provided.
20The procedures are based on a paper of Amir Hashemi 'Computation of
21Castelnuovo-Mumford regularity and satiety' (preprint 2008)
22
23
24PROCEDURES:
25 NPos_test(id);  checks whether monomial ideal id is in Noether position
26 modNpos_test(id); the same as above using modular methods
27 NPos(id);       Noether normalization of ideal id
28 modNPos(id);      Noether normalization of ideal id by modular methods
29 nsatiety(id); Satiety of ideal id
30 modsatiety(id)  Satiety of ideal id by modular methods
31 regCM(id);    Castelnuovo-Mumford regularity of ideal id
32 modregCM(id); Castelnuovo-Mumford regularity of ideal id by modular methods
33";
34LIB "elim.lib";
35LIB "algebra.lib";
36LIB "poly.lib";
37LIB "ring.lib";
38LIB "presolve.lib";
39
40///////////////////////////////////////////////////////////////////////////////
41
42proc NPos_test (ideal I)
43"
44USAGE:  NPos_test (I); I monomial ideal
45RETURN: A list whose first element is 1, if i is in Noether position,
46        0 otherwise. The second element of this list is a list of variables ordered
47        such that those variables are listed first, of which a power belongs to the
48        initial ideal of i. If i is in Noether position, the method returns furthermore
49        the dimension of i.
50ASSUME: i is a nonzero monomial ideal.
51"
52{
53//--------------------------- initialisation ---------------------------------
54   int  time,ii,j,k,l,d,t,jj;
55   intvec v;
56   def r0 = basering;
57   int n = nvars(r0)-1;
58   list L,Y,P1,P2,P3;
59   if (I[1]==1)
60   {
61     print("The ideal is 1");return(1);
62   }
63   for ( ii = 1; ii <= n+1; ii++ )
64   {
65     L[ii]=0;
66   }
67   for ( ii = 1; ii <= size(I); ii++ )
68   {
69     Y=findvars(I[ii],1)[1];
70     l=rvar(Y[1][1]);
71     if (size(Y[1])==1)
72     {
73       L[l]=1;
74       P1=insert(P1,Y[1][1]);
75     }
76     if (L[l]==0)
77     {
78       L[l]=-1;
79     }
80   }
81   t=size(P1);
82   if (t==0)
83   {
84     for ( jj = 1; jj <= n+1; jj++ )
85     {
86       P3=insert(P3,varstr(jj));
87     }
88   }
89   else
90   {
91     P2=findvars(ideal(P1[1..t]),1)[3];
92     for ( jj = 1; jj <= size(P2[1]); jj++ )
93     {
94       P3=insert(P3,P2[1][jj]);
95     }
96   }
97   if (L[n+1]==-1)
98   {
99     return(list(0,P1+P3));
100   }
101   for ( ii = 1; ii <= n; ii++ )
102   {
103     if (L[ii]==-1)
104     {
105       return(list(0,P1+P3));
106     }
107     if (L[ii]==0 and L[ii+1]==1)
108     {
109       return(list(0,P1+P3));
110     }
111   }
112   d=n+1-sum(L);
113   print("The dimension of the ideal is:");print(d);
114   return(list(1,P1+P3));
115}
116//////////////////////////////////////////
117proc modNpos_test (ideal i)
118"USAGE: modNpos_test(i); i an ideal
119RETURN: 1 if i is in Noether position 0  otherwise.
120NOTE:   This test is a probabilistic test, and it computes the initial of the ideal modulo the prime number 2147483647 (the biggest prime less than 2^31).
121"
122{
123  "// WARNING:
124// The procedure is probabilistic and  it computes the initial of the ideal modulo the prime number 2147483647";
125  int p;
126  def br=basering;
127  setring br;
128  ideal I;
129  list #;
130  option(redSB);
131  p=2147483647;
132  #=ringlist(br);
133  #[1]=p;
134  def oro=ring(#);
135  setring oro;
136  ideal sbi,lsbi;
137  sbi=fetch(br,i);
138  lsbi=lead(std(sbi));
139  setring br;
140  I=fetch(oro,lsbi);
141  I=simplify(I,1);
142  attrib(I,"isSB",1);
143  return(NPos_test(I));
144}
145
146
147///////////////////////////////////////////////////////////////////////////////
148proc NPos (ideal i)
149"USAGE:  NPos(i); i ideal
150RETURN:  A linear map phi such that  phi(i) is in Noether position
151"
152{
153//--------------------------- initialisation ---------------------------------
154  int ii,jj,d,time,n,nl;
155  intmat ran;
156  def r0 = basering;
157  ideal K,chcoord;
158  n = nvars(r0)-1;
159  string s = "ring r1 = ",charstr(r0),",x(0..n),dp;";
160  execute(s);
161  ideal i,sbi,I,K,chcoord,m,L;
162  list #;
163  poly P;
164  map phi;
165  i = fetch(r0,i);
166  time=rtimer;
167  system("--ticks-per-sec",10);
168  i=std(i);
169  sbi=sort(lead(i))[1];
170  #=NPos_test(sbi);
171  if ( #[1]== 1 )
172  {
173    return ("The ideal is in Noether position and the time of this computation is:",rtimer-time,"/10 sec.");
174  }
175  else
176  {
177    L=maxideal(1);
178    chcoord=maxideal(1);
179    for ( ii = 1; ii<=n+1; ii++ )
180    {
181      chcoord[rvar(#[2][ii])]=L[ii];
182    }
183    phi=r1,chcoord;
184    sbi=phi(sbi);
185    if ( NPos_test(sbi)[1] == 1 )
186    {
187      setring r0;
188      chcoord=fetch(r1,chcoord);
189      return (chcoord,"and the time of this computation is:",rtimer-time,"/10 sec.");
190    }
191  }
192  while ( nl < 30 )
193  {
194    nl=nl+1;
195    I=i;
196    L=maxideal(1);
197    for ( ii = n; ii>=0; ii-- )
198    {
199      chcoord=select1(maxideal(1),1..ii);
200      ran=random(100,1,ii);
201      ran=intmat(ran,1,ii+1);
202      ran[1,ii+1]=1;
203      m=select1(maxideal(1),1..(ii+1));
204      for ( jj = 1; jj<=ii+1; jj++ )
205      {
206        P=P+ran[1,jj]*m[jj];
207      }
208      chcoord[ii+1]=P;
209      L[ii+1]=P;
210      P=0;
211      phi=r1,chcoord;
212      I=phi(I);
213      if ( NPos_test(sort(lead(std(I)))[1])[1] == 1 )
214      {
215        K=x(ii..n);
216        setring r0;
217        K=fetch(r1,K);
218        ideal L=fetch(r1,L);
219        return (L,"and the time of this computation is:",rtimer-time,"/10 sec.");
220      }
221    }
222  }
223  "// WARNING:
224// The procedure has entered in more than 30 loops: in your example
225// the method may enter an infinite loop over a finite field!";
226  return (-1);
227}
228///////////////////////////////////////////////////////////////////////////////
229proc modNPos (ideal i)
230"USAGE:  modNPos(i); i ideal
231RETURN:  A linear map phi such that  phi(i) is in Noether position
232NOTE:    It uses the procedure  modNPos_test to test Noether position.
233"
234{
235//--------------------------- initialisation ---------------------------------
236   int ii,jj,d,time,n,nl;
237   intmat ran;
238   def r0 = basering;
239   ideal K,chcoord;
240   n = nvars(r0)-1;
241   string s = "ring r1 = ",charstr(r0),",x(0..n),dp;";
242   execute(s);
243   ideal i,sbi,I,K,chcoord,m,L;
244   poly P;
245   list #;
246   map phi;
247   i = fetch(r0,i);
248   time=rtimer;
249   system("--ticks-per-sec",10);
250   #=modNPos_test(i);
251   if ( #[1]== 1 )
252   {
253     return ("The ideal is in Noether position and the time of this computation is:",rtimer-time,"/10 sec.");
254   }
255   else
256   {
257     L=maxideal(1);
258     chcoord=maxideal(1);
259     for ( ii = 1; ii<=n+1; ii++ )
260     {
261       chcoord[rvar(#[2][ii])]=L[ii];
262     }
263     phi=r1,chcoord;
264     I=phi(i);
265     if ( modNPos_test(I)[1] == 1 )
266     {
267       setring r0;
268       chcoord=fetch(r1,chcoord);
269       return (chcoord,"and the time of this computation is:",rtimer-time,"/10 sec.");
270     }
271   }
272   while ( nl < 30 )
273   {
274     nl=nl+1;
275     I=i;
276     L=maxideal(1);
277     for ( ii = n; ii>=0; ii-- )
278     {
279       chcoord=select1(maxideal(1),1..ii);
280       ran=random(100,1,ii);
281       ran=intmat(ran,1,ii+1);
282       ran[1,ii+1]=1;
283       m=select1(maxideal(1),1..(ii+1));
284       for ( jj = 1; jj<=ii+1; jj++ )
285       {
286         P=P+ran[1,jj]*m[jj];
287       }
288       chcoord[ii+1]=P;
289       L[ii+1]=P;
290       P=0;
291       phi=r1,chcoord;
292       I=phi(I);
293       if ( modNPos_test(I)[1] == 1 )
294       {
295         K=x(ii..n);
296         setring r0;
297         K=fetch(r1,K);
298         ideal L=fetch(r1,L);
299         return (L,"and the time of this computation is:",rtimer-time,"/10 sec.");
300       }
301     }
302   }
303   "// WARNING:
304// The procedure has entered in more than 30 loops: in your example
305// the method may enter an infinite loop over a finite field!";
306   return (-1);
307}
308
309////////////////////////////////////////////////////////////////////////////////////
310proc Test (ideal i)
311"USAGE:   Test (i); i a monomial ideal,
312RETURN:  1 if the last variable is in generic position for i and 0 otherwise.
313THEORY:  The last variable is in generic position if the quotient of the ideal
314         with respect to this variable is equal to the quotient of the ideal with respect to the maximal ideal.
315"
316{
317//--------------------------- initialisation ---------------------------------
318  int n,ret;
319  def r0 = basering;
320  n = nvars(r0)-1;
321  string s = "ring r1 = ",charstr(r0),",x(0..n),dp;";
322  execute(s);
323  ideal I,i;
324  i = fetch(r0,i);
325  attrib(i,"isSB",1);
326  I=quotient(select(i,n+1),x(n));
327  I=I*maxideal(1);
328  ret=1;
329  if (size(reduce(I,i)) <> 0)
330  {
331    ret=0;
332  }
333  return(ret);
334}
335
336
337////////////////////////////////////////////////////////////////////////////////////
338proc nsatiety (ideal i)
339"USAGE:   nsatiety (i); i ideal,
340RETURN:  an integer, the satiety of i.
341         (returns -1 if i is not homogeneous)
342ASSUME:  i is a homogeneous ideal of the basering R=K[x(0)..x(n)].
343THEORY:  The satiety, or saturation index, of a homogeneous ideal i is the
344         least integer s such that, for all d>=s, the degree d part of the
345         ideals i and isat=sat(i,maxideal(1))[1] coincide.
346"
347{
348//--------------------------- initialisation ---------------------------------
349  int e,ii,jj,h,d,time,lastv,nl,ret;
350  intmat ran;
351  def r0 = basering;
352  int n = nvars(r0)-1;
353  string s = "ring r1 = ",charstr(r0),",x(0..n),dp;";
354  execute(s);
355  ideal i,sbi,I,K,chcoord,m,L;
356  poly P;
357  map phi;
358  i = fetch(r0,i);
359  time=rtimer;
360  system("--ticks-per-sec",100);
361  sbi=std(i);
362//----- Check ideal homogeneous
363  if ( homog(sbi) == 0 )
364  {
365    dbprint(2,"The ideal is not homogeneous, and time for this test is: " + string(rtimer-time) + "/100sec.");
366    return ();
367  }
368  I=simplify(lead(sbi),1);
369  attrib(I,"isSB",1);
370  K=select(I,n+1);
371  if (size(K) == 0)
372  {
373    dbprint(2,"sat(i)=0 and the time of this computation: " + string(rtimer-time) + "/100sec.");
374    return();
375  }
376  if (Test(I) == 1 )
377  {
378    dbprint(2,"sat(i)=" + string(maxdeg1(K)) + " and the time of this computation: " + string(rtimer-time) + "/100sec.");
379    return();
380  }
381  while ( nl < 5 )
382  {
383    nl=nl+1;
384    chcoord=select1(maxideal(1),1..n);
385    ran=random(100,1,n);
386    ran=intmat(ran,1,n+1);
387    ran[1,n+1]=1;
388    m=select1(maxideal(1),1..(n+1));
389    for ( jj = 1; jj<=n+1; jj++ )
390    {
391      P=P+ran[1,jj]*m[jj];
392    }
393    chcoord[n+1]=P;
394    P=0;
395    phi=r1,chcoord;
396    L=std(phi(i));
397    I=simplify(lead(L),1);
398    attrib(I,"isSB",1);
399    K=select(I,n+1);
400    if (size(K) == 0)
401    {
402      dbprint(2,"sat(i)=0 and the time of this computation: " + string(rtimer-time) + "/100sec.");
403      return();
404    }
405    if (Test(I) == 1 )
406    {
407      dbprint(2,"sat(i)=" + string(maxdeg1(K)) + " and the time of this computation: " + string(rtimer-time) + "/100sec.");
408      return();
409    }
410  }
411}
412
413
414//////////////////////////////////////////////////////////////////////////////
415proc modsatiety (ideal i)
416"USAGE:   modsatiety(i); i ideal,
417RETURN:  an integer, the satiety of i.
418         (returns -1 if i is not homogeneous)
419ASSUME:  i is a homogeneous ideal of the basering R=K[x(0)..x(n)].
420THEORY:  The satiety, or saturation index, of a homogeneous ideal i is the
421         least integer s such that, for all d>=s, the degree d part of the
422         ideals i and isat=sat(i,maxideal(1))[1] coincide.
423NOTE:    This is a probabilistic procedure, and it computes the initial of the ideal modulo the prime number 2147483647 (the biggest prime less than 2^31).
424"
425{
426//--------------------------- initialisation ---------------------------------
427  "// WARNING: The characteristic of base field must be zero.
428// The procedure is probabilistic and  it computes the
429//initial ideals modulo the prime number 2147483647.";
430  int e,ii,jj,h,d,time,lastv,nl,ret,s1,d1,siz,j,si,u,k,p;
431  intvec v1;
432  intmat ran;
433  def r0 = basering;
434  int n = nvars(r0)-1;
435  string s = "ring r1 = ",charstr(r0),",x(0..n),dp;";
436  execute(s);
437  ideal i,sbi,I,K,chcoord,m,L,sbi1,lsbi1,id1;
438  vector V1;
439  list #,LL,PL,Gb1,VGb1,Gb2,VGb2,Res1,Res2;
440  poly P;
441  map phi;
442  time=rtimer;
443  system("--ticks-per-sec",100);
444  i = fetch(r0,i);
445//----- Check ideal homogeneous
446  if ( homog(i) == 0 )
447  {
448    "// WARNING: The ideal is not homogeneous.";
449    dbprint(2,"Time for this test is: " + string(rtimer-time) + "/100sec.");
450    return ();
451  }
452  option(redSB);
453  p=2147483647;
454  list r2=ringlist(r1);
455  r2[1]=p;
456  def oro=ring(r2);
457  setring oro;
458  ideal sbi=fetch(r1,i);
459  sbi=std(sbi);
460  setring r1;
461  sbi=fetch(oro,sbi);
462  kill oro;
463  I=simplify(lead(sbi),1);
464  attrib(I,"isSB",1);
465  K=select(I,n+1);
466  if (size(K) == 0)
467  {
468    dbprint(2,"msat(i)=0 and the time of this computation: " + string(rtimer-time) + "/100sec.");
469    return();
470  }
471  if (Test(I) == 1 )
472  {
473    dbprint(2,"msat(i)=" + string(maxdeg1(K)) + " and the time of this computation: " + string(rtimer-time) + "/100sec.");
474    return();
475  }
476  while ( nl < 30 )
477  {
478    nl=nl+1;
479    chcoord=select1(maxideal(1),1..n);
480    ran=random(100,1,n);
481    ran=intmat(ran,1,n+1);
482    ran[1,n+1]=1;
483    m=select1(maxideal(1),1..(n+1));
484    for ( jj = 1; jj<=n+1; jj++ )
485    {
486      P=P+ran[1,jj]*m[jj];
487    }
488    chcoord[n+1]=P;
489    P=0;
490    phi=r1,chcoord;
491    sbi=phi(i);
492    list r2=ringlist(r1);
493    r2[1]=p;
494    def oro=ring(r2);
495    setring oro;
496    ideal sbi=fetch(r1,sbi);
497    sbi=std(sbi);
498    setring r1;
499    sbi=fetch(oro,sbi);
500    kill oro;
501    lsbi1=lead(sbi);
502    attrib(lsbi1,"isSB",1);
503    K=select(lsbi1,n+1);
504    if (size(K) == 0)
505    {
506      dbprint(2,"msat(i)=0 and the time of this computation: " + string(rtimer-time) + "/100sec.");
507      return();
508    }
509    if (Test(lsbi1) == 1 )
510    {
511      dbprint(2,"msat(i)=" + string(maxdeg1(K)) + " and the time of this computation: " + string(rtimer-time) + "/100sec.");
512      return();
513    }
514  }
515}
516
517//////////////////////////////////////////////////////////////////////////////
518//
519proc reg (ideal i)
520"USAGE:  reg (i); i ideal
521RETURN:  the Castelnuovo-Mumford regularity of i.
522         (returns -1 if i is not homogeneous)
523ASSUME:  i is a homogeneous ideal.
524"
525{
526//--------------------------- initialisation ---------------------------------
527  int e,ii,jj,H,h,d,time,nl;
528  def r0 = basering;
529  int n = nvars(r0)-1;
530  string s = "ring r1 = ",charstr(r0),",x(0..n),dp;";
531  execute(s);
532  ideal i,sbi,I,J,K,L;
533  list #;
534  poly P;
535  map phi;
536  i = fetch(r0,i);
537  time=rtimer;
538  system("--ticks-per-sec",100);
539  sbi=std(i);
540//----- Check ideal homogeneous
541  if ( homog(sbi) == 0 )
542  {
543    "// The ideal is not homogeneous!";
544    return (-1);
545  }
546  I=simplify(lead(sbi),1);
547  attrib(I,"isSB",1);
548  d=dim(I);
549  if (char(r1) > 0 and d == 0)
550  {
551    def r2=changechar("0",r1);
552    setring r2;
553    ideal sbi,I,i,K,T;
554    map phi;
555    I = fetch(r1,I);
556    i=I;
557    attrib(I,"isSB",1);
558  }
559  else
560  {
561    def r2=changechar(charstr(r1),r1);
562    setring r2;
563    ideal sbi,I,i,K,T,ic,Ic;
564    map phi;
565    I = imap(r1,I);
566    Ic=I;
567    attrib(I,"isSB",1);
568    i = imap(r1,i);
569    ic=i;
570  }
571  K=select(I,n+1);
572  if (size(K) == 0)
573  {
574    h=0;
575  }
576  else
577  {
578    if (Test(I) == 1)
579    {
580      h=maxdeg1(K);
581    }
582    else
583    {
584      while ( nl < 30 )
585      {
586        nl=nl+1;
587        phi=r2,randomLast(100);
588        T=phi(i);
589        I=simplify(lead(std(T)),1);
590        attrib(I,"isSB",1);
591        K=select(I,n+1);
592        if (size(K) == 0)
593        {
594          h=0;break;
595        }
596        if (Test(I) == 1 )
597        {
598          h=maxdeg1(K);break;
599        }
600      }
601      i=T;
602    }
603  }
604  for ( ii = n; ii>=n-d+1; ii-- )
605  {
606    i=subst(i,x(ii),0);
607    s = "ring mr = ",charstr(r1),",x(0..ii-1),dp;";
608    execute(s);
609    ideal i,sbi,I,J,K,L,T;
610    poly P;
611    map phi;
612    i=imap(r2,i);
613    I=simplify(lead(std(i)),1);
614    attrib(I,"isSB",1);
615    K=select(I,ii);
616    if (size(K) == 0)
617    {
618      H=0;
619    }
620    else
621    {
622      if (Test(I) == 1)
623      {
624        H=maxdeg1(K);
625      }
626      else
627      {
628        while ( nl < 30 )
629        {
630          nl=nl+1;
631          phi=mr,randomLast(100);
632          T=phi(i);
633          I=simplify(lead(std(T)),1);
634          attrib(I,"isSB",1);
635          K=select(I,ii);
636          if (size(K) == 0)
637          {
638            H=0;break;
639          }
640          if (Test(I) == 1 )
641          {
642            H=maxdeg1(K);break;
643          }
644        }
645        setring r2;
646        i=imap(mr,T);
647        kill mr;
648      }
649    }
650    if (H > h)
651    {
652      h=H;
653    }
654  }
655  if (nl < 30)
656  {
657    dbprint(2,"reg(i)=" + string(h) + " and the time of this computation: " + string(rtimer-time) + " sec./100");
658    return();
659  }
660  else
661  {
662    I=Ic;
663    attrib(I,"isSB",1);
664    i=ic;
665    K=subst(select(I,n+1),x(n),1);
666    K=K*maxideal(maxdeg1(I));
667    if (size(reduce(K,I)) <> 0)
668    {
669      nl=0;
670      while ( nl < 30 )
671      {
672        nl=nl+1;
673        phi=r1,randomLast(100);
674        sbi=phi(i);
675        I=simplify(lead(std(sbi)),1);
676        attrib(I,"isSB",1);
677        K=subst(select(I,n+1),x(n),1);
678        K=K*maxideal(maxdeg1(I));
679        if (size(reduce(K,I)) == 0)
680        {
681          break;
682        }
683      }
684    }
685    h=maxdeg1(simplify(reduce(quotient(I,maxideal(1)),I),2))+1;
686    for ( ii = n; ii> n-d+1; ii-- )
687    {
688      sbi=subst(sbi,x(ii),0);
689      s = "ring mr = ",charstr(r0),",x(0..ii-1),dp;";
690      execute(s);
691      ideal sbi,I,L,K,T;
692      map phi;
693      sbi=imap(r1,sbi);
694      I=simplify(lead(std(sbi)),1);
695      attrib(I,"isSB",1);
696      K=subst(select(I,ii),x(ii-1),1);
697      K=K*maxideal(maxdeg1(I));
698      if (size(reduce(K,I)) <> 0)
699      {
700        nl=0;
701        while ( nl < 30 )
702        {
703          nl=nl+1;
704          L=randomLast(100);
705          phi=mr,L;
706          T=phi(sbi);
707          I=simplify(lead(std(T)),1);
708          attrib(I,"isSB",1);
709          K=subst(select(I,ii),x(ii-1),1);
710          K=K*maxideal(maxdeg1(I));
711          if (size(reduce(K,I)) == 0)
712          {
713            sbi=T;
714            break;
715          }
716        }
717      }
718      H=maxdeg1(simplify(reduce(quotient(I,maxideal(1)),I),2))+1;
719      if (H > h)
720      {
721        h=H;
722      }
723      setring r1;
724      sbi=fetch(mr,sbi);
725      kill mr;
726    }
727    sbi=subst(sbi,x(n-d+1),0);
728    s = "ring mr = ",charstr(r0),",x(0..n-d),dp;";
729    execute(s);
730    ideal sbi,I,L,K,T;
731    map phi;
732    sbi=imap(r1,sbi);
733    I=simplify(lead(std(sbi)),1);
734    attrib(I,"isSB",1);
735    H=maxdeg1(simplify(reduce(quotient(I,maxideal(1)),I),2))+1;
736    if (H > h)
737    {
738      h=H;
739    }
740    dbprint(2,"reg(i)=" + string(h) + " and the time of this computation: " + string(rtimer-time) + " sec./100");
741    return();
742  }
743}
744
745//////////////////////////////////////////////////////////////////////////////
746//
747proc modregCM(ideal i)
748"USAGE:  modregCM(i); i ideal
749RETURN:  an integer, the Castelnuovo-Mumford regularity of i.
750         (returns -1 if i is not homogeneous)
751ASSUME:  i is a homogeneous ideal and the characteristic of base field is zero..
752NOTE:    This is a probabilistic procedure, and it computes the initial of the ideal modulo the prime number 2147483647 (the biggest prime less than 2^31).
753"
754{
755//--------------------------- initialisation ---------------------------------
756  "// WARNING: The characteristic of base field musr be zero.
757// This procedure is probabilistic and  it computes the initial
758//ideals modulo the prime number 2147483647";
759  int e,ii,jj,H,h,d,time,p,nl;
760  def r0 = basering;
761  int n = nvars(r0)-1;
762  string s = "ring r1 = ",charstr(r0),",x(0..n),dp;";
763  execute(s);
764  ideal i,sbi,I,J,K,L,lsbi1,lsbi2;
765  list #;
766  poly P;
767  map phi;
768  i = fetch(r0,i);
769  time=rtimer;
770  system("--ticks-per-sec",100);
771//----- Check ideal homogeneous
772  if ( homog(i) == 0 )
773  {
774    "// The ideal is not homogeneous!";
775    return (-1);
776  }
777  option(redSB);
778  p=2147483647;
779  #=ringlist(r1);
780  #[1]=p;
781  def oro=ring(#);
782  setring oro;
783  ideal sbi,lsbi;
784  sbi=fetch(r1,i);
785  lsbi=lead(std(sbi));
786  setring r1;
787  lsbi1=fetch(oro,lsbi);
788  lsbi1=simplify(lsbi1,1);
789  attrib(lsbi1,"isSB",1);
790  kill oro;
791  I=lsbi1;
792  d=dim(I);
793  K=select(I,n+1);
794  if (size(K) == 0)
795  {
796    h=0;
797  }
798  else
799  {
800    if (Test(I) == 1)
801    {
802      h=maxdeg1(K);
803    }
804    else
805    {
806      while ( nl < 30 )
807      {
808        nl=nl+1;
809        phi=r1,randomLast(100);
810        sbi=phi(i);
811        #=ringlist(r1);
812        #[1]=p;
813        def oro=ring(#);
814        setring oro;
815        ideal sbi,lsbi;
816        sbi=fetch(r1,sbi);
817        lsbi=lead(std(sbi));
818        setring r1;
819        lsbi1=fetch(oro,lsbi);
820        lsbi1=simplify(lsbi1,1);
821        attrib(lsbi1,"isSB",1);
822        kill oro;
823        I=lsbi1;
824        K=select(I,n+1);
825        if (size(K) == 0)
826        {
827          h=0;break;
828        }
829        if (Test(I) == 1 )
830        {
831          h=maxdeg1(K);break;
832        }
833      }
834      i=sbi;
835    }
836  }
837  for ( ii = n; ii>=n-d+1; ii-- )
838  {
839    i=subst(i,x(ii),0);
840    s = "ring mr = ","0",",x(0..ii-1),dp;";
841    execute(s);
842    ideal i,sbi,I,J,K,L,lsbi1;
843    poly P;
844    list #;
845    map phi;
846    i=imap(r1,i);
847    #=ringlist(mr);
848    #[1]=p;
849    def oro=ring(#);
850    setring oro;
851    ideal sbi,lsbi;
852    sbi=fetch(mr,i);
853    lsbi=lead(std(sbi));
854    setring mr;
855    lsbi1=fetch(oro,lsbi);
856    lsbi1=simplify(lsbi1,1);
857    attrib(lsbi1,"isSB",1);
858    kill oro;
859    I=lsbi1;
860    K=select(I,ii);
861    if (size(K) == 0)
862    {
863      H=0;
864    }
865    else
866    {
867      if (Test(I) == 1)
868      {
869        H=maxdeg1(K);
870      }
871      else
872      {
873        nl=0;
874        while ( nl < 30 )
875        {
876          nl=nl+1;
877          phi=mr,randomLast(100);
878          sbi=phi(i);
879          #=ringlist(mr);
880          #[1]=p;
881          def oro=ring(#);
882          setring oro;
883          ideal sbi,lsbi;
884          sbi=fetch(mr,sbi);
885          lsbi=lead(std(sbi));
886          setring mr;
887          lsbi1=fetch(oro,lsbi);
888          lsbi1=simplify(lsbi1,1);
889          kill oro;
890          I=lsbi1;
891          attrib(I,"isSB",1);
892          K=select(I,ii);
893          if (size(K) == 0)
894          {
895            H=0;break;
896          }
897          if (Test(I) == 1 )
898          {
899            H=maxdeg1(K);break;
900          }
901        }
902        setring r1;
903        i=imap(mr,sbi);
904        kill mr;
905      }
906    }
907    if (H > h)
908    {
909      h=H;
910    }
911  }
912  dbprint(2,"mreg(i)=" + string(h) + " and the time of this computation: " + string(rtimer-time) + "sec./100");
913  return();
914}
915/*
916//////////////////////////////////////////////////////////////
917example
918{ "EXAMPLE:"; echo = 2;
919ring r=0,(X,Y,a,b),dp;
920poly f=X^8+a*Y^4-Y;
921poly g=Y^8+b*X^4-X;
922poly h=diff(f,X)*diff(g,Y)-diff(f,Y)*diff(g,X);
923ideal i=f,g,h;
924}
925example
926{ "EXAMPLE:"; echo = 2;
927ring r=0,(x,y,z,a,b),dp;
928ideal i=2*y^2*(y^2+x^2)+(b^2-3*a^2)*y^2-2*b*y^2*(x+y)+2*a^2*b*(y+x)-a^2*x^2+a^2*(a^2-b^2),4*y^3+4*y*(y^2+x^2)-2*b*y^2-4*b*y*(y+x)+2*(b^2-3*a^2)*y+2*a^2*b,4*x*y^2-2*b*y^2-2*a^2*x+2*a^2*b;
929}
930example
931{ "EXAMPLE:"; echo = 2;
932ring r=0,(t,a,b,c,d),dp;
933ideal i=b4-a3d, ab3-a3c, bc4-ac3d-bcd3+ad4, c6-bc3d2-c3d3+bd5, ac5-b2c3d-ac2d3+b2d4, a2c4-a3d3+b3d3-a2cd3, b3c3-a3d3, ab2c3-a3cd2+b3cd2-ab2d3, a2bc3-a3c2d+b3c2d-a2bd3, a3c3-a3bd2, a4c2-a3b2d;
934}
935example
936{ "EXAMPLE:"; echo = 2;
937ring r=0,(a,b,c,d,e),dp;
938ideal i=6*b4*c3+21*b4*c2*d+15b4cd2+9b4d3-8b2c2e-28b2cde+36b2d2e-144b2c-648b2d-120, 9b4c4+30b4c3d+39b4c2d2+18b4cd3-24b2c3e-16b2c2de+16b2cd2e+24b2d3e-432b2c2-720b2cd-432b2d2+16c2e2-32cde2+16d2e2+576ce-576de-240c+5184,-15b2c3e+15b2c2de-81b2c2+216b2cd-162b2d2+40c2e2-80cde2+40d2e2+1008ce-1008de+5184, -4b2c2+4b2cd-3b2d2+22ce-22de+261;
939}
940example
941{ "EXAMPLE:"; echo = 2;
942ring r=0,(c,b,d,p,q),dp;
943ideal i=2*(b-1)^2+2*(q-p*q+p^2)+c^2*(q-1)^2-2*b*q+2*c*d*(1-q)*(q-p)+2*b*p*q*d*(d-c)+b^2*d^2*(1-2*p)+2*b*d^2*(p-q)+2*b*d*c*(p-1)+2*b*p*q*(c+1)+(b^2-2*b)*p^2*d^2+2*b^2*p^2+4*b*(1-b)*p+d^2*(p-q)^2,d*(2*p+1)*(q-p)+c*(p+2)*(1-q)+b*(b-2)*d+b*(1-2*b)*p*d+b*c*(q+p-p*q-1)+b*(b+1)*p^2*d, -b^2*(p-1)^2+2*p*(p-q)-2*(q-1),b^2+4*(p-q*q)+3*c^2*(q-1)*(q-1)-3*d^2*(p-q)^2+3*b^2*d^2*(p-1)^2+b^2*p*(p-2)+6*b*d*c*(p+q+q*p-1);
944}
945example
946{ "EXAMPLE:"; echo = 2;
947ring r=0,(a,b,c,d,e,f),dp;
948ideal i=2adef+3be2f-cef2,4ad2f+5bdef+cdf2,2abdf+3b2ef-bcf2,4a2df+5abef+acf2,4ad2e+3bde2+7cdef, 2acde+3bce2-c2ef, 4abde+3b2e2-4acdf+2bcef-c2f2, 4a2de+3abe2+7acef, 4acd2+5bcde+c2df, 4abd2+3b2de+7bcdf, 16a2d2-9b2e2+32acdf-18bcef+7c2f2, 2abcd+3b2ce-bc2f, 4a2cd+5abce+ac2f, 4a2bd+3ab2e+7abcf, abc2f-cdef2, ab2cf-bdef2, 2a2bcf+3be2f2-cef3, ab3f-3bdf3, 2a2b2f-4adf3+3bef3-cf4, a3bf+4aef3, 3ac3e-cde3, 3b2c2e-bc3f+2cd2ef, abc2e-cde2f, 6a2c2e-4ade3-3be4+ce3f, 3b3ce-b2c2f+2bd2ef, 2a2bce+3be3f-ce2f2, 3a3ce+4ae3f, 4bc3d+cd3e, 4ac3d-3bc3e-2cd2e2+c4f, 8b2c2d-4ad4-3bd3e-cd3f, 4b3cd+3bd3f, 4ab3d+3b4e-b3cf-6bd2f2, 4a4d+3a3be+a3cf-8ae2f2;
949}
950example
951{ "EXAMPLE:"; echo = 2;
952ring r=0,(x,y,z,t,u,v,w),dp;
953ideal i=2tw+2wy-wz,2uw2-10vw2+20w3-7tu+35tv-70tw, 6tw2+2w2y-2w2z-21t2-7ty+7tz, 2v3-4uvw-5v2w+6uw2+7vw2-15w3-42vy, 6tw+9wy+2vz-3wz-21x, 9uw3-45vw3+135w4+14tv2-70tuw+196tvw-602tw2-14v2z+28uwz+14vwz-28w2z+147ux-735vx+2205wx-294ty+98tz+294yz-98z2, 36tw3+6w3y-9w3z-168t2w-14v2x+28uwx+14vwx-28w2x-28twy+42twz+588tx+392xy-245xz, 2uvw-6v2w-uw2+13vw2-5w3-28tw+14wy, u2w-3uvw+5uw2-28tw+14wy, tuw+tvw-11tw2-2vwy+8w2y+uwz-3vwz+5w2z-21wx, 5tuw-17tvw+33tw2-7uwy+22vwy-39w2y-2uwz+6vwz-10w2z+63wx, 20t2w-12uwx+30vwx-15w2x-10twy-8twz+4wyz, 4t2w-6uwx+12vwx-6w2x+2twy-2wy2-2twz+wyz, 8twx+8wxy-4wxz;
954}
955example
956{ "EXAMPLE:"; echo = 2;
957ring r=0,(a,b,c,d,x,w,u,v),dp;
958ideal i=a+b+c+d,u+v+w+x, 3ab+3ac+3bc+3ad+3bd+3cd+2,bu+cu+du+av+cv+dv+aw+bw+dw+ax+bx+cx,bcu+bdu+cdu+acv+adv+cdv+abw+adw+bdw+abx+acx+bcx,abc+abd+acd+bcd,bcdu+acdv+abdw+abcx;
959}
960example
961{ "EXAMPLE:"; echo = 2;
962ring r=0,(b,x,y,z,s,t,u,v,w),dp;
963ideal i=su+bv, tu+bw,tv+sw,sx+by,tx+bz,ty+sz,vx+uy,wx+uz,wy+vz;
964}
965example
966{ "EXAMPLE:"; echo = 2;
967ring r=0,(t,a,b,c,d,e,f,g,h),dp;
968ideal i=a+c+d-e-h,2df+2cg+2eh-2h2-h-1,3df2+3cg2-3eh2+3h3+3h2-e+4h, 6bdg-6eh2+6h3-3eh+6h2-e+4h, 4df3+4cg3+4eh3-4h4-6h3+4eh-10h2-h-1, 8bdfg+8eh3-8h4+4eh2-12h3+4eh-14h2-3h-1, 12bdg2+12eh3-12h4+12eh2-18h3+8eh-14h2-h-1, -24eh3+24h4-24eh2+36h3-8eh+26h2+7h+1;
969}
970example
971{ "EXAMPLE:"; echo = 2;
972ring r=0,(a,b,c,d,e,f,g,h,k,l),dp;
973ideal i=f2h-1,ek2-1,g2l-1, 2ef2g2hk2+f2g2h2k2+2ef2g2k2l+2f2g2hk2l+f2g2k2l2+ck2, 2e2fg2hk2+2efg2h2k2+2e2fg2k2l+4efg2hk2l+2fg2h2k2l+2efg2k2l2+2fg2hk2l2+2bfh, 2e2f2ghk2+2ef2gh2k2+2e2f2gk2l+4ef2ghk2l+2f2gh2k2l+2ef2gk2l2+2f2ghk2l2+2dgl, e2f2g2k2+2ef2g2hk2+2ef2g2k2l+2f2g2hk2l+f2g2k2l2+bf2, 2e2f2g2hk+2ef2g2h2k+2e2f2g2kl+4ef2g2hkl+2f2g2h2kl+2ef2g2kl2+2f2g2hkl2+2cek, e2f2g2k2+2ef2g2hk2+f2g2h2k2+2ef2g2k2l+2f2g2hk2l+dg2, -e2f2g2hk2-ef2g2h2k2-e2f2g2k2l-2ef2g2hk2l-f2g2h2k2l-ef2g2k2l2-f2g2hk2l2+a2;
974}
975example
976{ "EXAMPLE:"; echo = 2;
977ring r=0,(b,c,d,e,f,g,h,j,k,l),dp;
978ideal i=-k9+9k8l-36k7l2+84k6l3-126k5l4+126k4l5-84k3l6+36k2l7-9kl8+l9, -bk8+8bk7l+k8l-28bk6l2-8k7l2+56bk5l3+28k6l3-70bk4l4-56k5l4+56bk3l5+70k4l5-28bk2l6-56k3l6+8bkl7+28k2l7-bl8-8kl8+l9, ck7-7ck6l-k7l+21ck5l2+7k6l2-35ck4l3-21k5l3+35ck3l4+35k4l4-21ck2l5-35k3l5+7ckl6+21k2l6-cl7-7kl7+l8, -dk6+6dk5l+k6l-15dk4l2-6k5l2+20dk3l3+15k4l3-15dk2l4-20k3l4+6dkl5+15k2l5-dl6-6kl6+l7, ek5-5ek4l-k5l+10ek3l2+5k4l2-10ek2l3-10k3l3+5ekl4+10k2l4-el5-5kl5+l6, -fk4+4fk3l+k4l-6fk2l2-4k3l2+4fkl3+6k2l3-fl4-4kl4+l5, gk3-3gk2l-k3l+3gkl2+3k2l2-gl3-3kl3+l4, -hk2+2hkl+k2l-hl2-2kl2+l3, jk-jl-kl+l2;
979}
980example
981{ "EXAMPLE:"; echo = 2;
982ring r=0,x(0..10),dp;
983ideal i=x(1)*x(0),x(1)*x(2),x(2)*x(3),x(3)*x(4),x(4)*x(5),x(5)*x(6),x(6)*x(7),x(7)*x(8),x(8)*x(9),x(9)*x(10),x(10)*x(0);
984}
985example
986{ "EXAMPLE:"; echo = 2;
987ring r=0,(a,b,c,d,e,f,g,h,j,k,l,m,n,o,p,q,s),dp;
988ideal i=ag,gj+am+np+q,bl,nq,bg+bk+al+lo+lp+b+c,ag+ak+jl+bm+bn+go+ko+gp+kp+lq+a+d+f+h+o+p,gj+jk+am+an+mo+no+mp+np+gq+kq+e+j+q+s-1,jm+jn+mq+nq,jn+mq+2nq,gj+am+2an+no+np+2gq+kq+q+s,2ag+ak+bn+go+gp+lq+a+d,bg+al, an+gq, 2jm+jn+mq, gj+jk+am+mo+2mp+np+e+2j+q, jl+bm+gp+kp+a+f+o+2p,lp+b,jn+mq,gp+a;
989}
990example
991{ "EXAMPLE:"; echo = 2;
992ring r=0,(a,b,c,d,e,f,g,h,v,w,k,l,m,n,o,p,q,s,t,u),dp;
993ideal i=af+bg+ch+dv+ew-1/2, a2f+b2g+c2h+d2v+e2w-1/3,tdw+agk+ahl+bhm+avn+bvo+cvp+awq+bwu+cws-1/6, a3f+b3g+c3h+d3v+e3w-1/4, tdew+abgk+achl+bchm+advn+bdvo+cdvp+aewq+bewu+cews-1/8, td2w+a2gk+a2hl+b2hm+a2vn+b2vo+c2vp+a2wq+b2wu+c2ws-1/12, ahkm+tawn+tbwo+avko+tcwp+avlp+bvmp+awku+awls+bwms-1/24, a4f+b4g+c4h+d4v+e4w-1/5, tde2w+ab2gk+ac2hl+bc2hm+ad2vn+bd2vo+cd2vp+ae2wq+be2wu+ce2ws-1/10, td2ew+a2bgk+a2chl+b2chm+a2dvn+b2dvo+c2dvp+a2ewq+b2ewu+c2ews-1/15,achkm+taewn+tbewo+advko+tcewp+advlp+bdvmp+aewku+aewls+bewms-1/30,t2d2w+a2gk2+a2hl2+2abhlm+b2hm2+a2vn2+2abvno+b2vo2+2acvnp+2bcvop+c2vp2+2tadwq+a2wq2+2tbdwu+2abwqu+b2wu2+2tcdws+2acwqs+2bcwus+c2ws2-1/20,td3w+a3gk+a3hl+b3hm+a3vn+b3vo+c3vp+a3wq+b3wu+c3ws-1/20,abhkm+tadwn+tbdwo+abvko+tcdwp+acvlp+bcvmp+abwku+acwls+bcwms-1/40,a2hkm+ta2wn+tb2wo+a2vko+tc2wp+a2vlp+b2vmp+a2wku+a2wls+b2wms-1/60,tawko+tawlp+tbwmp+avkmp+awkms-1/20;
994}
995*/
Note: See TracBrowser for help on using the repository browser.