source: git/kernel/gr_kstd2.cc @ fe89b98

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