source: git/kernel/gr_kstd2.cc @ 599326

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