source: git/kernel/gr_kstd2.cc @ 6909cfb

spielwiese
Last change on this file since 6909cfb was 6909cfb, checked in by Yue Ren <ren@…>, 11 years ago
fix: -Wunused-variable warnings
  • Property mode set to 100644
File size: 30.9 KB
RevLine 
[35aab3]1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5*  ABSTRACT -  Kernel: noncomm. alg. of Buchberger
6*/
[1f637e]7#define PLURAL_INTERNAL_DECLARATIONS
[35aab3]8
[762407]9#include "config.h"
[1f637e]10#include "mod2.h"
[5a9e7b]11
[f2f460]12#ifdef HAVE_PLURAL
[5a9e7b]13
14
[76cfef]15#include <omalloc/omalloc.h>
[1f637e]16#include <misc/options.h>
17#include <misc/intvec.h>
18
19#include <polys/weight.h>
[737a68]20#include <kernel/polys.h>
[77bb59]21#include <polys/monomials/ring.h>
[1f637e]22
[80ca3c]23#include <polys/nc/gb_hack.h>
[1f637e]24#include <polys/nc/nc.h>
25#include <polys/nc/sca.h>
26
27
[599326]28#include <kernel/febase.h>
[1f637e]29#include <kernel/ideals.h>
[599326]30#include <kernel/kstd1.h>
31#include <kernel/khstd.h>
[35aab3]32//#include "spolys.h"
[f599636]33//#include "cntrlc.h"
[599326]34#include <kernel/ratgring.h>
[1f637e]35#include <kernel/kutil.h>
36
[80ca3c]37#include <kernel/nc.h>
38
[5a9e7b]39#if 0
40/*3
41* reduction of p2 with p1
42* do not destroy p1 and p2
43* p1 divides p2 -> for use in NF algorithm
[35aab3]44*/
[5a9e7b]45poly gnc_ReduceSpolyNew(const poly p1, poly p2/*,poly spNoether*/, const ring r)
[35aab3]46{
[5a9e7b]47  return(nc_ReduceSPoly(p1,p_Copy(p2,r)/*,spNoether*/,r));
[35aab3]48}
[5a9e7b]49#endif
[35aab3]50
51/*2
52*reduces h with elements from T choosing  the first possible
53* element in t with respect to the given pDivisibleBy
54*/
55int redGrFirst (LObject* h,kStrategy strat)
56{
57  int at,reddeg,d,i;
58  int pass = 0;
59  int j = 0;
60
[1558d5]61  d = currRing->pFDeg((*h).p,currRing)+(*h).ecart;
[35aab3]62  reddeg = strat->LazyDegree+d;
63  loop
64  {
65    if (j > strat->sl)
66    {
[d42b51]67#ifdef KDEBUG
[35aab3]68      if (TEST_OPT_DEBUG) PrintLn();
[d42b51]69#endif
[35aab3]70      return 0;
71    }
[d42b51]72#ifdef KDEBUG
[35aab3]73    if (TEST_OPT_DEBUG) Print("%d",j);
[d42b51]74#endif
[35aab3]75    if (pDivisibleBy(strat->S[j],(*h).p))
76    {
[d42b51]77#ifdef KDEBUG
[35aab3]78      if (TEST_OPT_DEBUG) PrintS("+\n");
[d42b51]79#endif
[35aab3]80      /*
81      * the polynomial to reduce with is;
82      * T[j].p
83      */
84      if (!TEST_OPT_INTSTRATEGY)
85        pNorm(strat->S[j]);
[d42b51]86#ifdef KDEBUG
[35aab3]87      if (TEST_OPT_DEBUG)
88      {
89        wrp(h->p);
90        PrintS(" with ");
91        wrp(strat->S[j]);
92      }
[d42b51]93#endif
[19370c]94      (*h).p = nc_ReduceSpoly(strat->S[j],(*h).p, currRing);
[35aab3]95      //spSpolyRed(strat->T[j].p,(*h).p,strat->kNoether);
96
[d42b51]97#ifdef KDEBUG
[35aab3]98      if (TEST_OPT_DEBUG)
99      {
100        PrintS(" to ");
101        wrp(h->p);
102      }
[d42b51]103#endif
[35aab3]104      if ((*h).p == NULL)
105      {
106        if (h->lcm!=NULL) p_LmFree((*h).lcm, currRing);
107        return 0;
108      }
109      if (TEST_OPT_INTSTRATEGY)
110      {
[1558d5]111        if (rField_is_Zp_a(currRing)) p_Content(h->p,currRing);
[a0d9be]112        else h->pCleardenom();// also does a p_Content
[35aab3]113      }
114      /*computes the ecart*/
[1558d5]115      d = currRing->pLDeg((*h).p,&((*h).length),currRing);
116      (*h).FDeg=currRing->pFDeg((*h).p,currRing);
[35aab3]117      (*h).ecart = d-(*h).FDeg; /*pFDeg((*h).p);*/
118      if ((strat->syzComp!=0) && !strat->honey)
119      {
120        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
121        {
[d42b51]122#ifdef KDEBUG
[35aab3]123          if (TEST_OPT_DEBUG) PrintS(" > sysComp\n");
[d42b51]124#endif
[35aab3]125          return 0;
126        }
127      }
128      /*- try to reduce the s-polynomial -*/
129      pass++;
130      /*
131      *test whether the polynomial should go to the lazyset L
132      *-if the degree jumps
133      *-if the number of pre-defined reductions jumps
134      */
135      if ((strat->Ll >= 0)
136      && ((d >= reddeg) || (pass > strat->LazyPass))
137      && !strat->homog)
138      {
139        at = strat->posInL(strat->L,strat->Ll,h,strat);
140        if (at <= strat->Ll)
141        {
142          i=strat->sl+1;
143          do
144          {
145            i--;
146            if (i<0) return 0;
147          } while (!pDivisibleBy(strat->S[i],(*h).p));
148          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
[d42b51]149#ifdef KDEBUG
[35aab3]150          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
[d42b51]151#endif
[35aab3]152          (*h).p = NULL;
153          return 0;
154        }
155      }
156      if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
157      {
158        reddeg = d+1;
159        Print(".%d",d);mflush();
160      }
161      j = 0;
[d42b51]162#ifdef KDEBUG
[35aab3]163      if TEST_OPT_DEBUG PrintLn();
[d42b51]164#endif
[35aab3]165    }
166    else
167    {
[d42b51]168#ifdef KDEBUG
[35aab3]169      if (TEST_OPT_DEBUG) PrintS("-");
[d42b51]170#endif
[35aab3]171      j++;
172    }
173  }
174}
[737e25]175void ratGB_divide_out(poly p)
176{
[ec4a2c]177  /* extracts monomial content from localized expression  */
[b172c3]178  /* searches for an m (monomial in var 1.. real_var_start-1)
179   * such that m divides p and divides p by this m if it exist*/
[737e25]180  if (p==NULL) return;
181  poly root=p;
[0b4ec2]182  assume(rIsRatGRing(currRing));
[737e25]183  poly f=pHead(p);
184  int i;
185  for (i=currRing->real_var_start;i<=currRing->real_var_end;i++)
186  {
187    pSetExp(f,i,0);
188  }
189  loop
190  {
191    pIter(p);
192    if (p==NULL) { pSetm(f); break;}
193    for (i=1;i<=rVar(currRing);i++)
194    {
195      pSetExp(f,i,si_min(pGetExp(f,i),pGetExp(p,i)));
196    }
197  }
198  if (!pIsConstant(f))
199  {
[d42b51]200#ifdef KDEBUG
[737e25]201    if (TEST_OPT_DEBUG)
202    {
203      PrintS("divide out:");p_wrp(f,currRing);
204      PrintS(" from ");pWrite(root);
205    }
[d42b51]206#endif
[737e25]207    p=root;
208    loop
209    {
210      if (p==NULL) break;
211      for (i=1;i<=rVar(currRing);i++)
212      {
213        pSetExp(p,i,pGetExp(p,i)-pGetExp(f,i));
214      }
215      pSetm(p);
216      pIter(p);
217    }
218  }
219  pDelete(&f);
220}
[c7aad0]221
[83f8aff]222#ifdef HAVE_RATGRING
[737e25]223/*2
224*reduces h with elements from T choosing  the first possible
225* element in t with respect to the given pDivisibleBy
226* for use in ratGB
227*/
228int redGrRatGB (LObject* h,kStrategy strat)
229{
230  int at,reddeg,d,i;
231  int pass = 0;
232  int j = 0;
[0047ec]233  int c_j=-1, c_e=-2;
[737e25]234  poly c_p=NULL;
235  assume(strat->tailRing==currRing);
236
237  ratGB_divide_out((*h).p);
[1558d5]238  d = currRing->pFDeg((*h).p,currRing)+(*h).ecart;
[737e25]239  reddeg = strat->LazyDegree+d;
240  if (!TEST_OPT_INTSTRATEGY)
241  {
[1558d5]242    if (rField_is_Zp_a(currRing)) p_Content(h->p,currRing);
[c0e2c36]243    else h->pCleardenom();// also does a pContentRat
[737e25]244  }
245  loop
246  {
247    if (j > strat->sl)
248    {
249      if (c_j>=0)
250      {
251        /*
252        * the polynomial to reduce with is;
253        * S[c_j]
254        */
255        if (!TEST_OPT_INTSTRATEGY)
256          pNorm(strat->S[c_j]);
[d42b51]257#ifdef KDEBUG
258    if (TEST_OPT_DEBUG)
[737e25]259        if (TEST_OPT_DEBUG)
260        {
261          wrp(h->p);
[c7a127]262          Print(" with S[%d]= ",c_j);
[737e25]263          wrp(strat->S[c_j]);
264        }
[d42b51]265#endif
[a93f7b0]266    //poly hh = nc_CreateSpoly(strat->S[c_j],(*h).p, currRing);
267    //        Print("vor nc_rat_ReduceSpolyNew (ce:%d) ",c_e);wrp(h->p);PrintLn();
268    //if(c_e==-1)
269    //  c_p = nc_CreateSpoly(pCopy(strat->S[c_j]),pCopy((*h).p), currRing);
270    //else
271    //          c_p=nc_rat_ReduceSpolyNew(strat->S[c_j],pCopy((*h).p), currRing->real_var_start-1,currRing);
272    //        Print("nach nc_rat_ReduceSpolyNew ");wrp(c_p);PrintLn();
273    //        pDelete(&((*h).p));
274   
275        c_p=nc_rat_ReduceSpolyNew(strat->S[c_j],(*h).p, currRing->real_var_start-1,currRing);
[36b9ef]276        (*h).p=c_p;
[737e25]277        if (!TEST_OPT_INTSTRATEGY)
278        {
[1558d5]279          if (rField_is_Zp_a(currRing)) p_Content(h->p,currRing);
[a0d9be]280          else h->pCleardenom();// also does a p_Content
[737e25]281        }
282
[d42b51]283#ifdef KDEBUG
[737e25]284        if (TEST_OPT_DEBUG)
285        {
286          PrintS(" to ");
[9a001d]287          wrp(h->p);
[c7a127]288          PrintLn();
[737e25]289        }
[d42b51]290#endif
[737e25]291        if ((*h).p == NULL)
292        {
293          if (h->lcm!=NULL) p_LmFree((*h).lcm, currRing);
294          return 0;
295        }
296        ratGB_divide_out((*h).p);
[1558d5]297        d = currRing->pLDeg((*h).p,&((*h).length),currRing);
298        (*h).FDeg=currRing->pFDeg((*h).p,currRing);
[737e25]299        (*h).ecart = d-(*h).FDeg; /*pFDeg((*h).p);*/
300        /*- try to reduce the s-polynomial again -*/
301        pass++;
[a13cae]302        j=0;
[36b9ef]303        c_j=-1; c_e=-2; c_p=NULL;
[737e25]304      }
305      else
306      { // nothing found
307        return 0;
308      }
309    }
[0047ec]310    // first try usal division
311    if (p_LmDivisibleBy(strat->S[j],(*h).p,currRing))
312    {
[d42b51]313#ifdef KDEBUG
[0047ec]314      if(TEST_OPT_DEBUG)
315      {
[094f80]316        p_wrp(h->p,currRing); Print(" divisible by S[%d]=",j);
[0047ec]317        p_wrp(strat->S[j],currRing); PrintS(" e=-1\n");
318      }
[d42b51]319#endif
[342c80]320      if ((c_j<0)||(c_e>=0))
[0047ec]321      {
322        c_e=-1; c_j=j;
323      }
324    }
325    else
[737e25]326    if (p_LmDivisibleByPart(strat->S[j],(*h).p,currRing,
327        currRing->real_var_start,currRing->real_var_end))
328    {
[1558d5]329      int a_e=(p_Totaldegree(strat->S[j],currRing)-currRing->pFDeg(strat->S[j],currRing));
[d42b51]330#ifdef KDEBUG
[a13cae]331      if(TEST_OPT_DEBUG)
332      {
333        p_wrp(h->p,currRing); Print(" divisibly by S[%d]=",j);
[c7a127]334        p_wrp(strat->S[j],currRing); Print(" e=%d\n",a_e);
[a13cae]335      }
[d42b51]336#endif
[342c80]337      if ((c_j<0)||(c_e>a_e))
[737e25]338      {
339        c_e=a_e; c_j=j;
[342c80]340        //c_p = nc_CreateSpoly(pCopy(strat->S[c_j]),pCopy((*h).p), currRing);
[737e25]341      }
342      /*computes the ecart*/
343      if ((strat->syzComp!=0) && !strat->honey)
344      {
345        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
346        {
[d42b51]347#ifdef KDEBUG
[737e25]348          if (TEST_OPT_DEBUG) PrintS(" > sysComp\n");
[d42b51]349#endif
[737e25]350          return 0;
351        }
352      }
353    }
354    else
355    {
[d42b51]356#ifdef KDEBUG
[a13cae]357      if(TEST_OPT_DEBUG)
358      {
359        p_wrp(h->p,currRing); Print(" not divisibly by S[%d]=",j);
360        p_wrp(strat->S[j],currRing); PrintLn();
361      }
[d42b51]362#endif
[737e25]363    }
364    j++;
365  }
366}
[83f8aff]367#endif
[35aab3]368
369/*2
370*  reduction procedure for the homogeneous case
371*  and the case of a degree-ordering
372*/
[4bbe3b]373static int nc_redHomog (LObject* h,kStrategy strat)
[35aab3]374{
375  if (strat->tl<0)
376  {
377    enterT((*h),strat);
378    return 1;
379  }
380
381  int j = 0;
382
383  if (TEST_OPT_DEBUG)
384  {
385    PrintS("red:");
386    wrp(h->p);
387    PrintS(" ");
388  }
389  loop
390  {
391    if (TEST_OPT_DEBUG) Print("%d",j);
392    if (pDivisibleBy(strat->S[j],(*h).p))
393    {
394      if (TEST_OPT_DEBUG)
395      {
396        PrintS("+\nwith ");
397        wrp(strat->S[j]);
398      }
399      /*- compute the s-polynomial -*/
[19370c]400      (*h).p = nc_ReduceSpoly(strat->S[j],(*h).p,currRing);
[35aab3]401      if ((*h).p == NULL)
402      {
403        if (TEST_OPT_DEBUG) PrintS(" to 0\n");
404        if (h->lcm!=NULL) pLmFree((*h).lcm);
405        (*h).lcm=NULL;
406        return 0;
407      }
408/*
409*      else if (strat->syzComp)
410*      {
411*        if (pMinComp((*h).p) > strat->syzComp)
412*        {
413*          enterT((*h),strat);
414*          return;
415*        }
416*      }
417*/
418      /*- try to reduce the s-polynomial -*/
419      j = 0;
420    }
421    else
422    {
423      if (j >= strat->sl)
424      {
425        enterT((*h),strat);
426        return 1;
427      }
428      j++;
429    }
430  }
431}
432
[5a9e7b]433#if 0
[35aab3]434/*2
435*  reduction procedure for the homogeneous case
436*  and the case of a degree-ordering
437*/
[4bbe3b]438static int nc_redHomog0 (LObject* h,kStrategy strat)
[35aab3]439{
440  if (strat->tl<0)
441  {
442    enterT((*h),strat);
443    return 0;
444  }
445
446  int j = 0;
447  int k = 0;
448
449  if (TEST_OPT_DEBUG)
450  {
451    PrintS("red:");
452    wrp(h->p);
453    PrintS(" ");
454  }
455  loop
456  {
457    if (TEST_OPT_DEBUG) Print("%d",j);
458    if (pDivisibleBy(strat->T[j].p,(*h).p))
459    {
460      if (TEST_OPT_DEBUG)
461      {
462        PrintS("+\nwith ");
463        wrp(strat->S[j]);
464      }
465      /*- compute the s-polynomial -*/
[4bbe3b]466      (*h).p = nc_ReduceSpoly(strat->T[j].p,(*h).p,strat->kNoether,currRing);
[35aab3]467      if ((*h).p == NULL)
468      {
469        if (TEST_OPT_DEBUG) PrintS(" to 0\n");
470        if (h->lcm!=NULL) pLmFree((*h).lcm);
471        (*h).lcm=NULL;
472        return 0;
473      }
[e36a2c0]474      else
[35aab3]475      {
[e36a2c0]476        if (TEST_OPT_INTSTRATEGY)
[35aab3]477        {
[1558d5]478          if (rField_is_Zp_a(currRing)) p_Content(h->p,currRing);
[c0e2c36]479          else h->pCleardenom();// also does a pContent
[e36a2c0]480        }
481        if (strat->syzComp!=0)
482        {
483          if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
484          {
[35aab3]485/*
[e36a2c0]486*           (*h).length=pLength0((*h).p);
[35aab3]487*/
[e36a2c0]488            enterT((*h),strat);
489            return 0;
490          }
[35aab3]491        }
492      }
493      /*- try to reduce the s-polynomial -*/
494      j = 0;
495    }
496    else
497    {
498      if (j >= strat->tl)
499      {
[e36a2c0]500        if (TEST_OPT_INTSTRATEGY)
501        {
[1558d5]502          if (rField_is_Zp_a(currRing)) p_Content(h->p,currRing);
[a0d9be]503          else h->pCleardenom();// also does a p_Content
[e36a2c0]504        }
[35aab3]505/*
506*       (*h).length=pLength0((*h).p);
507*/
508        enterT((*h),strat);
509        return 0;
510      }
511      j++;
512    }
513  }
514}
515
516/*2
517*  reduction procedure for the inhomogeneous case
518*  and not a degree-ordering
519*/
[4bbe3b]520static int nc_redLazy (LObject* h,kStrategy strat)
[35aab3]521{
522  if (strat->tl<0)
523  {
524    enterT((*h),strat);
525    return 0;
526  }
527
528  int at,d,i;
529  int j = 0;
530  int pass = 0;
[1558d5]531  int reddeg = currRing->pFDeg((*h).p,currRing);
[35aab3]532
533  if (TEST_OPT_DEBUG)
534  {
535    PrintS("red:");
536    wrp(h->p);
537    PrintS(" ");
538  }
539  loop
540  {
541    if (TEST_OPT_DEBUG) Print("%d",j);
542    if (pDivisibleBy(strat->S[j],(*h).p))
543    {
544      if (TEST_OPT_DEBUG)
545      {
546        PrintS("+\nwith ");
547        wrp(strat->S[j]);
548      }
549      /*- compute the s-polynomial -*/
[4bbe3b]550      (*h).p = nc_ReduceSpoly(strat->S[j],(*h).p,strat->kNoether,currRing);
[35aab3]551      if ((*h).p == NULL)
552      {
553        if (TEST_OPT_DEBUG) PrintS(" to 0\n");
554        if (h->lcm!=NULL) pLmFree((*h).lcm);
555        (*h).lcm=NULL;
556        return 0;
557      }
558//      else if (strat->syzComp)
559//      {
560//        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
561//        {
562//          if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
[a0d9be]563//          if (TEST_OPT_INTSTRATEGY) p_Content(h->p,currRing);
[35aab3]564//          enterTBba((*h),strat->tl+1,strat);
565//          return;
566//        }
567//      }
[e36a2c0]568      else
[35aab3]569      {
[e36a2c0]570        if (TEST_OPT_DEBUG)
571        {
572          PrintS("to:");
573          wrp((*h).p);
574          PrintLn();
575        }
576        if (TEST_OPT_INTSTRATEGY)
577        {
[a0d9be]578          p_Content(h->p,currRing);
579          //pCleardenom(h->p);// also does a p_Content
[e36a2c0]580        }
[35aab3]581      }
582      /*- try to reduce the s-polynomial -*/
583      pass++;
[1558d5]584      d = currRing->pFDeg((*h).p,currRing);
[35aab3]585      if ((strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
586      {
587        at = posInL11(strat->L,strat->Ll,h,strat);
588        if (at <= strat->Ll)
589        {
590          i=strat->sl+1;
591          do
592          {
593            i--;
594            if (i<0)
595            {
596              enterT((*h),strat);
597              return 0;
598            }
599          }
[e36a2c0]600          while (!pDivisibleBy(strat->S[i],(*h).p));
[35aab3]601          if (TEST_OPT_DEBUG) Print(" ->L[%d]\n",at);
602          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
603          (*h).p = NULL;
604          return 0;
605        }
606      }
607      else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d != reddeg))
608      {
609        Print(".%d",d);mflush();
610        reddeg = d;
611      }
612      j = 0;
613    }
614    else
615    {
616      if (TEST_OPT_DEBUG) PrintS("-");
617      if (j >= strat->sl)
618      {
619        if (TEST_OPT_DEBUG) PrintLn();
620        if (TEST_OPT_INTSTRATEGY)
621        {
[1558d5]622          if (rField_is_Zp_a(currRing)) p_Content(h->p,currRing);
[a0d9be]623          else h->pCleardenom();// also does a p_Content
[35aab3]624        }
625        enterT((*h),strat);
626        return 0;
627      }
628      j++;
629    }
630  }
631}
632
633/*2
634*  reduction procedure for the sugar-strategy (honey)
635* reduces h with elements from T choosing first possible
636* element in T with respect to the given ecart
637*/
[4bbe3b]638static int nc_redHoney (LObject*  h,kStrategy strat)
[35aab3]639{
640  if (strat->tl<0)
641  {
642    enterT((*h),strat);
643    return 0;
644  }
645
646  poly pi;
647  int i,j,at,reddeg,d,pass,ei;
648
649  pass = j = 0;
[1558d5]650  d = reddeg = currRing->pFDeg((*h).p,currRing)+(*h).ecart;
[35aab3]651  if (TEST_OPT_DEBUG)
652  {
653    PrintS("red:");
654    wrp((*h).p);
655  }
656  loop
657  {
658    if (TEST_OPT_DEBUG) Print("%d",j);
659    if (pDivisibleBy(strat->T[j].p,(*h).p))
660    {
661      if (TEST_OPT_DEBUG) PrintS("+");
662      pi = strat->T[j].p;
663      ei = strat->T[j].ecart;
664      /*
665      * the polynomial to reduce with (up to the moment) is;
666      * pi with ecart ei
667      */
668      i = j;
669      loop
670      {
671        /*- takes the first possible with respect to ecart -*/
672        i++;
673        if (i > strat->tl)
674          break;
675        if ((!BTEST1(20)) && (ei <= (*h).ecart))
676          break;
677        if (TEST_OPT_DEBUG) Print("%d",i);
678        if ((strat->T[i].ecart < ei) && pDivisibleBy(strat->T[i].p,(*h).p))
679        {
680          if (TEST_OPT_DEBUG) PrintS("+");
681          /*
682          * the polynomial to reduce with is now;
683          */
684          pi = strat->T[i].p;
685          ei = strat->T[i].ecart;
686        }
687        else if (TEST_OPT_DEBUG) PrintS("-");
688      }
689
690      /*
691      * end of search: have to reduce with pi
692      */
693      if (ei > (*h).ecart)
694      {
695        /*
696        * It is not possible to reduce h with smaller ecart;
697        * if possible h goes to the lazy-set L,i.e
698        * if its position in L would be not the last one
699        */
700        if (strat->Ll >= 0) /* L is not empty */
701        {
702          at = strat->posInL(strat->L,strat->Ll,h,strat);
703          if(at <= strat->Ll)
704          /*- h will not become the next element to reduce -*/
705          {
706            enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
707            if (TEST_OPT_DEBUG) Print(" ecart too big: -> L%d\n",at);
708            (*h).p = NULL;
709            return 0;
710          }
711        }
712      }
713      if (TEST_OPT_DEBUG)
714      {
715        PrintS("\nwith ");
716        wrp(pi);
717      }
718      if (strat->fromT)
719      {
720        strat->fromT=FALSE;
[52e2f6]721        (*h).p = nc_ReduceSpoly(pi,(*h).p,strat->kNoether,currRing);
[35aab3]722      }
723      else
[4bbe3b]724        (*h).p = nc_ReduceSpoly(pi,(*h).p,strat->kNoether,currRing);
[35aab3]725      if (TEST_OPT_DEBUG)
726      {
727        PrintS(" to ");
728        wrp((*h).p);
729        PrintLn();
730      }
731      if ((*h).p == NULL)
732      {
733        if (h->lcm!=NULL) pLmFree((*h).lcm);
734        (*h).lcm=NULL;
735        return 0;
736      }
[e36a2c0]737      if (TEST_OPT_INTSTRATEGY)
738      {
[a0d9be]739        h->pCleardenom();// also does a p_Content
[e36a2c0]740      }
[35aab3]741      /* compute the ecart */
742      if (ei <= (*h).ecart)
[1558d5]743        (*h).ecart = d-currRing->pFDeg((*h).p,currRing);
[35aab3]744      else
[1558d5]745        (*h).ecart = d-currRing->pFDeg((*h).p,currRing)+ei-(*h).ecart;
[35aab3]746//      if (strat->syzComp)
747//      {
748//        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
749//        {
750//          if (TEST_OPT_DEBUG)
751//            PrintS("  >syzComp\n");
[a0d9be]752//          if (TEST_OPT_INTSTRATEGY) p_Content(h->p,currRing);
[35aab3]753//          at=strat->posInT(strat->T,strat->tl,(*h));
754//          enterTBba((*h),at,strat);
755//          return;
756//        }
757//      }
758      /*
759      * try to reduce the s-polynomial h
760      *test first whether h should go to the lazyset L
761      *-if the degree jumps
762      *-if the number of pre-defined reductions jumps
763      */
764      pass++;
[1558d5]765      d = currRing->pFDeg((*h).p,currRing)+(*h).ecart;
[35aab3]766      if ((strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
767      {
768        at = strat->posInL(strat->L,strat->Ll,h,strat);
769        if (at <= strat->Ll)
770        {
771          /*test if h is already standardbasis element*/
772          i=strat->sl+1;
773          do
774          {
775            i--;
776            if (i<0)
777            {
778              enterT((*h),strat);
779              return 0;
780            }
781          } while (!pDivisibleBy(strat->S[i],(*h).p));
782          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
783          if (TEST_OPT_DEBUG)
784            Print(" degree jumped: -> L%d\n",at);
785          (*h).p = NULL;
786          return 0;
787        }
788      }
789      else if (TEST_OPT_PROT && (strat->Ll < 0) && (d > reddeg))
790      {
791        reddeg = d;
792        Print(".%d",d); mflush();
793      }
794      j = 0;
795    }
796    else
797    {
798      if (TEST_OPT_DEBUG) PrintS("-");
799      if (j >= strat->tl)
800      {
801        if (TEST_OPT_DEBUG) PrintLn();
802        if (TEST_OPT_INTSTRATEGY)
803        {
[a0d9be]804          h->pCleardenom();// also does a p_Content
[35aab3]805        }
806        enterT((*h),strat);
807        return 0;
808      }
809      j++;
810    }
811  }
812}
813
814/*2
815*  reduction procedure for tests only
816*  reduces with elements from T and chooses the best possible
817*/
[4bbe3b]818static int nc_redBest (LObject*  h,kStrategy strat)
[35aab3]819{
820  if (strat->tl<0)
821  {
822    enterT((*h),strat);
823    return 0;
824  }
825
826  int j,jbest,at,reddeg,d,pass;
827  poly     p,ph;
828  pass = j = 0;
829
830  if (strat->honey)
[1558d5]831    reddeg = currRing->pFDeg((*h).p,currRing)+(*h).ecart;
[35aab3]832  else
[1558d5]833    reddeg = currRing->pFDeg((*h).p,currRing);
[35aab3]834  loop
835  {
836    if (pDivisibleBy(strat->T[j].p,(*h).p))
837    {
838      /* compute the s-polynomial */
839      if (!TEST_OPT_INTSTRATEGY) pNorm((*h).p);
840#ifdef SDRING
841      // spSpolyShortBba will not work in the SRING case
842      if (pSDRING)
843      {
844        p=spSpolyCreate(strat->T[j].p,(*h).p,strat->kNoether);
845        if (p!=NULL) pDelete(&pNext(p));
846      }
847      else
848#endif
[4bbe3b]849      p = nc_CreateShortSpoly(strat->T[j].p,(*h).p);
[35aab3]850      /* computes only the first monomial of the spoly  */
851      if (p)
852      {
853        jbest = j;
854        /* looking for the best possible reduction */
855        if ((strat->syzComp==0) || (pMinComp(p) <= strat->syzComp))
856        {
857          loop
858          {
859            j++;
860            if (j > strat->tl)
861              break;
862            if (pDivisibleBy(strat->T[j].p,(*h).p))
863            {
864#ifdef SDRING
865              // spSpolyShortBba will not work in the SRING case
866              if (pSDRING)
867              {
868                ph=spSpolyCreate(strat->T[j].p,(*h).p,strat->kNoether);
869                if (ph!=NULL) pDelete(&pNext(ph));
870              }
871              else
872#endif
[4bbe3b]873              ph = nc_CreateShortSpoly(strat->T[j].p,(*h).p);
[35aab3]874              if (ph==NULL)
875              {
876                pLmFree(p);
877                pDelete(&((*h).p));
878                if (h->lcm!=NULL)
879                {
880                  pLmFree((*h).lcm);
881                  (*h).lcm=NULL;
882                }
883                return 0;
884              }
885              else if (pLmCmp(ph,p) == -1)
886              {
887                pLmFree(p);
888                p = ph;
889                jbest = j;
890              }
891              else
892              {
893                pLmFree(ph);
894              }
895            }
896          }
897        }
898        pLmFree(p);
[4bbe3b]899        (*h).p = nc_ReduceSpoly(strat->T[jbest].p,(*h).p,strat->kNoether,currRing);
[35aab3]900      }
901      else
902      {
903        if (h->lcm!=NULL)
904        {
905          pLmFree((*h).lcm);
906          (*h).lcm=NULL;
907        }
908        (*h).p = NULL;
909        return 0;
910      }
[fe89b98]911      if (strat->honey && currRing->pLexOrder)
[35aab3]912        strat->initEcart(h);
913      /* h.length:=l; */
914      /* try to reduce the s-polynomial */
915//      if (strat->syzComp)
916//      {
917//        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
918//        {
919//          if (TEST_OPT_DEBUG)
920//            PrintS(" >syzComp\n");
[a0d9be]921//          if (TEST_OPT_INTSTRATEGY) p_Content(h->p,currRing);
[35aab3]922//          at=strat->posInT(strat->T,strat->tl,(*h));
923//          enterTBba((*h),at,strat);
924//          return;
925//        }
926//      }
[fe89b98]927      if (strat->honey || currRing->pLexOrder)
[35aab3]928      {
929        pass++;
[1558d5]930        d = currRing->pFDeg((*h).p,currRing);
[35aab3]931        if (strat->honey)
932          d += (*h).ecart;
933        if ((strat->Ll >= 0) && ((pass > strat->LazyPass) || (d > reddeg)))
934        {
935          at = strat->posInL(strat->L,strat->Ll,h,strat);
936          if (at <= strat->Ll)
937          {
938            enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
939            (*h).p = NULL;
940            return 0;
941          }
942        }
943        else if (TEST_OPT_PROT && (strat->Ll < 0) && (d != reddeg))
944        {
945          reddeg = d;
946          Print("%d.");
947          mflush();
948        }
949      }
950      j = 0;
951    }
952    else
953    {
954      if (j >= strat->tl)
955      {
956        if (TEST_OPT_INTSTRATEGY)
957        {
[a0d9be]958          h->pCleardenom();// also does a p_Content
[35aab3]959        }
960        enterT((*h),strat);
961        return 0;
962      }
963      j++;
964    }
965  }
966}
967
[5a9e7b]968#endif
969
[86016d]970void nc_gr_initBba(ideal F, kStrategy strat)
[35aab3]971{
[5a9e7b]972  assume(rIsPluralRing(currRing));
973
[6909cfb]974  // int i;
[4d0cbc7]975//  idhdl h;
[35aab3]976 /* setting global variables ------------------- */
977  strat->enterS = enterSBba;
[5a9e7b]978
979/*
[35aab3]980  if ((BTEST1(20)) && (!strat->honey))
[4bbe3b]981    strat->red = nc_redBest;
[35aab3]982  else if (strat->honey)
[4bbe3b]983    strat->red = nc_redHoney;
[fe89b98]984  else if (currRing->pLexOrder && !strat->homog)
[4bbe3b]985    strat->red = nc_redLazy;
[35aab3]986  else if (TEST_OPT_INTSTRATEGY && strat->homog)
[4bbe3b]987    strat->red = nc_redHomog0;
[35aab3]988  else
[4bbe3b]989    strat->red = nc_redHomog;
[5a9e7b]990*/
991
992//   if (rIsPluralRing(currRing))
[35aab3]993    strat->red = redGrFirst;
[83f8aff]994#ifdef HAVE_RATGRING
[0b4ec2]995  if (rIsRatGRing(currRing))
[4debf02]996  {
[36b9ef]997    int ii=IDELEMS(F)-1;
998    int jj;
999    BOOLEAN is_rat_id=FALSE;
1000    for(;ii>=0;ii--)
1001    {
1002      for(jj=currRing->real_var_start;jj<=currRing->real_var_end;jj++)
1003      {
1004        if(pGetExp(F->m[ii],jj)>0) { is_rat_id=TRUE; break; }
1005      }
1006      if (is_rat_id) break;
1007    }
1008    if (is_rat_id) strat->red=redGrRatGB;
[4debf02]1009  }
[83f8aff]1010#endif
[5a9e7b]1011
[fe89b98]1012  if (currRing->pLexOrder && strat->honey)
[35aab3]1013    strat->initEcart = initEcartNormal;
1014  else
1015    strat->initEcart = initEcartBBA;
1016  if (strat->honey)
1017    strat->initEcartPair = initEcartPairMora;
1018  else
1019    strat->initEcartPair = initEcartPairBba;
[327d41]1020//  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1021//  {
1022//     //interred  machen   Aenderung
[1558d5]1023//     pFDegOld=currRing->pFDeg;
1024//     pLDegOld=currRing->pLDeg;
[327d41]1025//  //   h=ggetid("ecart");
1026//  //   if ((h!=NULL) && (IDTYP(h)==INTVEC_CMD))
1027//  //   {
1028//  //     ecartWeights=iv2array(IDINTVEC(h));
1029//  //   }
1030//  //   else
1031//    {
1032//      ecartWeights=(short *)omAlloc(((currRing->N)+1)*sizeof(short));
1033//      /*uses automatic computation of the ecartWeights to set them*/
1034//      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
1035//    }
[1558d5]1036//    currRing->pFDeg=totaldegreeWecart;
1037//    currRing->pLDeg=maxdegreeWecart;
[327d41]1038//    for(i=1; i<=(currRing->N); i++)
1039//      Print(" %d",ecartWeights[i]);
1040//    PrintLn();
1041//    mflush();
1042//  }
[35aab3]1043}
1044
[52e2f6]1045#define MYTEST 0
1046
[80ca3c]1047ideal gnc_gr_bba(const ideal F, const ideal Q, const intvec *, const intvec *, kStrategy strat, const ring _currRing)
[35aab3]1048{
[80ca3c]1049  const ring save = currRing; if( currRing != _currRing ) rChangeCurrRing(_currRing);
1050
[52e2f6]1051#if MYTEST
1052   PrintS("<gnc_gr_bba>\n");
1053#endif
1054
1055#ifdef HAVE_PLURAL
1056#if MYTEST
1057   PrintS("currRing: \n");
1058   rWrite(currRing);
1059#ifdef RDEBUG
1060   rDebugPrint(currRing);
1061#endif
1062
1063   PrintS("F: \n");
[737e25]1064   idPrint(F);
1065   PrintS("Q: \n");
[52e2f6]1066   idPrint(Q);
1067#endif
1068#endif
1069
[d5e030]1070  assume(currRing->OrdSgn != -1); // no mora!!! it terminates only for global ordering!!! (?)
[5a9e7b]1071
[6909cfb]1072  // intvec *w=NULL;
1073  // intvec *hilb=NULL;
[35aab3]1074  int   olddeg,reduc;
1075  int red_result=1;
[6909cfb]1076  int /*hilbeledeg=1,*/hilbcount=0/*,minimcnt=0*/;
[35aab3]1077
1078  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1079  // initHilbCrit(F,Q,&hilb,strat);
1080  /* in plural we don't need Hilb yet */
[86016d]1081  nc_gr_initBba(F,strat);
[35aab3]1082  initBuchMoraPos(strat);
[0b4ec2]1083  if (rIsRatGRing(currRing))
[4debf02]1084  {
1085    strat->posInL=posInL0; // by pCmp of lcm
1086  }
[0047ec]1087  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1088  /*Shdl=*/initBuchMora(F, Q,strat);
1089  strat->posInT=posInT110;
[930ea8]1090  reduc = olddeg = 0;
[52e2f6]1091
[35aab3]1092  /* compute------------------------------------------------------- */
1093  while (strat->Ll >= 0)
1094  {
1095    if (TEST_OPT_DEBUG) messageSets(strat);
[52e2f6]1096
[35aab3]1097    if (strat->Ll== 0) strat->interpt=TRUE;
1098    if (TEST_OPT_DEGBOUND
[b130fb]1099    && ((strat->honey
[1558d5]1100    && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1101       || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
[35aab3]1102    {
1103      /*
1104      *stops computation if
1105      * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1106      *a predefined number Kstd1_deg
1107      */
1108      while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1109      break;
1110    }
1111    /* picks the last element from the lazyset L */
1112    strat->P = strat->L[strat->Ll];
1113    strat->Ll--;
[626431]1114    //kTest(strat);
[52e2f6]1115
1116    if (strat->P.p != NULL)
[35aab3]1117    if (pNext(strat->P.p) == strat->tail)
1118    {
1119      /* deletes the short spoly and computes */
1120      pLmFree(strat->P.p);
1121      /* the real one */
[454cb0]1122//      if (ncRingType(currRing)==nc_lie) /* prod crit */
1123//        if(pHasNotCF(strat->P.p1,strat->P.p2))
1124//        {
[52e2f6]1125//          strat->cp++;
[454cb0]1126//          /* prod.crit itself in nc_CreateSpoly */
1127//        }
[737e25]1128
[26d633]1129
[43cbc0]1130      if( ! rIsRatGRing(currRing) )
[26d633]1131      {
[43cbc0]1132        strat->P.p = nc_CreateSpoly(strat->P.p1,strat->P.p2,currRing);
1133      }
[26d633]1134#ifdef HAVE_RATGRING
[43cbc0]1135      else
1136      {
1137        /* rational case */
1138        strat->P.p = nc_rat_CreateSpoly(strat->P.p1,strat->P.p2,currRing->real_var_start-1,currRing);
1139      }
[26d633]1140#endif
[43cbc0]1141
[52e2f6]1142
1143#ifdef PDEBUG
1144      p_Test(strat->P.p, currRing);
1145#endif
1146
1147#if MYTEST
1148      if (TEST_OPT_DEBUG)
[35aab3]1149      {
[52e2f6]1150        PrintS("p1: "); pWrite(strat->P.p1);
1151        PrintS("p2: "); pWrite(strat->P.p2);
1152        PrintS("SPoly: "); pWrite(strat->P.p);
[35aab3]1153      }
[737e25]1154#endif
[35aab3]1155    }
[52e2f6]1156
[737e25]1157
[35aab3]1158    if (strat->P.p != NULL)
1159    {
1160      if (TEST_OPT_PROT)
[52e2f6]1161        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
[35aab3]1162              &olddeg,&reduc,strat, red_result);
[52e2f6]1163
1164#if MYTEST
1165      if (TEST_OPT_DEBUG)
1166      {
1167        PrintS("p1: "); pWrite(strat->P.p1);
1168        PrintS("p2: "); pWrite(strat->P.p2);
1169        PrintS("SPoly before: "); pWrite(strat->P.p);
1170      }
1171#endif
1172
[35aab3]1173      /* reduction of the element chosen from L */
1174      strat->red(&strat->P,strat);
[52e2f6]1175
1176#if MYTEST
1177      if (TEST_OPT_DEBUG)
1178      {
1179        PrintS("red SPoly: "); pWrite(strat->P.p);
1180      }
1181#endif
[35aab3]1182    }
1183    if (strat->P.p != NULL)
1184    {
[c0e2c36]1185      if (TEST_OPT_PROT)
1186      {
1187        PrintS("s\n");
1188      }
1189      /* enter P.p into s and L */
1190      {
[0ffc823]1191/* quick unit detection in the rational case */
1192#ifdef HAVE_RATGRING
1193        if( rIsRatGRing(currRing) )
1194        {
1195          if ( p_LmIsConstantRat(strat->P.p, currRing) )
1196          {
1197#ifdef PDEBUG
1198             Print("unit element detected:"); 
1199             p_wrp(strat->P.p,currRing);
1200#endif
1201            p_Delete(&strat->P.p,currRing, strat->tailRing);
1202            strat->P.p = pOne();
1203          }
1204      }
1205#endif
[c0e2c36]1206        strat->P.sev=0;
1207        int pos=posInS(strat,strat->sl,strat->P.p, strat->P.ecart);
1208        {
1209          if (TEST_OPT_INTSTRATEGY)
[35aab3]1210          {
[c0e2c36]1211            if ((strat->syzComp==0)||(!strat->homog))
1212            {
1213              #ifdef HAVE_RATGRING
1214              if(!rIsRatGRing(currRing))
1215              #endif
1216                strat->P.p = redtailBba(strat->P.p,pos-1,strat);
1217            }
1218
[a0d9be]1219            strat->P.p=p_Cleardenom(strat->P.p, currRing);
[35aab3]1220          }
[c0e2c36]1221          else
[35aab3]1222          {
[c0e2c36]1223            pNorm(strat->P.p);
1224            if ((strat->syzComp==0)||(!strat->homog))
[35aab3]1225            {
[c0e2c36]1226              strat->P.p = redtailBba(strat->P.p,pos-1,strat);
1227            }
1228          }
1229          if (TEST_OPT_DEBUG)
1230          {
1231            PrintS("new s:"); wrp(strat->P.p);
1232            PrintLn();
[52e2f6]1233#if MYTEST
[c0e2c36]1234            Print("s: "); pWrite(strat->P.p);
[52e2f6]1235#endif
[737e25]1236
[c0e2c36]1237          }
1238          // kTest(strat);
1239          //
1240          enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat);
[737e25]1241
[c0e2c36]1242          if (strat->sl==-1) pos=0;
1243          else pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
[737e25]1244
[c0e2c36]1245          strat->enterS(strat->P,pos,strat,-1);
1246        }
1247//      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1248      }
1249      if (strat->P.lcm!=NULL) pLmFree(strat->P.lcm);
[35aab3]1250    }
1251#ifdef KDEBUG
1252    strat->P.lcm=NULL;
1253#endif
[626431]1254    //kTest(strat);
[35aab3]1255  }
1256  if (TEST_OPT_DEBUG) messageSets(strat);
[86016d]1257
[35aab3]1258  /* complete reduction of the standard basis--------- */
[07b1cf]1259  if (TEST_OPT_SB_1)
1260  {
1261    int k=1;
1262    int j;
1263    while(k<=strat->sl)
1264    {
1265      j=0;
1266      loop
1267      {
1268        if (j>=k) break;
1269        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1270        j++;
1271      }
1272      k++;
1273    }
[86016d]1274  }
1275
[07b1cf]1276  if (TEST_OPT_REDSB)
1277     completeReduce(strat);
[35aab3]1278  /* release temp data-------------------------------- */
1279  exitBuchMora(strat);
[1558d5]1280//  if (TEST_OPT_WEIGHTM)
1281//  {
1282//    currRing->pFDeg=pFDegOld;
1283//    currRing->pLDeg=pLDegOld;
1284//    if (ecartWeights)
1285//    {
1286//      omFreeSize((ADDRESS)ecartWeights,((currRing->N)+1)*sizeof(short));
1287//      ecartWeights=NULL;
1288//    }
1289//  }
[930ea8]1290  if (TEST_OPT_PROT) messageStat(hilbcount,strat);
[35aab3]1291  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
[86016d]1292
1293
[e38e91]1294#ifdef PDEBUG
1295/* for counting number of pairs [enterL] in Plural */
1296/*   extern int zaehler; */
1297/*   Print("Total pairs considered:%d\n",zaehler); zaehler=0; */
[7447d8]1298#endif /*PDEBUG*/
[52e2f6]1299
1300#if MYTEST
1301  PrintS("</gnc_gr_bba>\n");
1302#endif
1303
[80ca3c]1304  if( currRing != save )     rChangeCurrRing(save);
1305 
[35aab3]1306  return (strat->Shdl);
1307}
[5a9e7b]1308
[80ca3c]1309ideal gnc_gr_mora(const ideal F, const ideal Q, const intvec *, const intvec *, kStrategy strat, const ring _currRing)
[5a9e7b]1310{
[80ca3c]1311#ifndef NDEBUG
[5a9e7b]1312  // Not yet!
[80ca3c]1313  WarnS("Sorry, non-commutative mora is not yet implemented!");
1314#endif
1315
1316  return gnc_gr_bba(F, Q, NULL, NULL, strat, _currRing);
[5a9e7b]1317}
1318
[f2f460]1319#endif
[5a9e7b]1320
Note: See TracBrowser for help on using the repository browser.