source: git/kernel/gr_kstd2.cc @ 19370c

fieker-DuValspielwiese
Last change on this file since 19370c was 19370c, checked in by Hans Schönemann <hannes@…>, 17 years ago
*hannes: naming conventions git-svn-id: file:///usr/local/Singular/svn/trunk@9821 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 23.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: gr_kstd2.cc,v 1.13 2007-02-07 10:49:39 Singular Exp $ */
5/*
6*  ABSTRACT -  Kernel: noncomm. alg. of Buchberger
7*/
8
9#include "mod2.h"
10
11#ifdef HAVE_PLURAL
12
13#define PLURAL_INTERNAL_DECLARATIONS
14
15#include "omalloc.h"
16#include "polys.h"
17#include "ideals.h"
18#include "febase.h"
19#include "kutil.h"
20#include "kstd1.h"
21#include "khstd.h"
22#include "kutil.h"
23//#include "spolys.h"
24//#include "cntrlc.h"
25#include "weight.h"
26#include "intvec.h"
27#include "structs.h"
28#include "gring.h"
29#include "sca.h"
30
31#if 0
32/*3
33* reduction of p2 with p1
34* do not destroy p1 and p2
35* p1 divides p2 -> for use in NF algorithm
36*/
37poly gnc_ReduceSpolyNew(const poly p1, poly p2/*,poly spNoether*/, const ring r)
38{
39  return(nc_ReduceSPoly(p1,p_Copy(p2,r)/*,spNoether*/,r));
40}
41#endif
42
43/*2
44*reduces h with elements from T choosing  the first possible
45* element in t with respect to the given pDivisibleBy
46*/
47int redGrFirst (LObject* h,kStrategy strat)
48{
49  int at,reddeg,d,i;
50  int pass = 0;
51  int j = 0;
52
53  d = pFDeg((*h).p,currRing)+(*h).ecart;
54  reddeg = strat->LazyDegree+d;
55  loop
56  {
57    if (j > strat->sl)
58    {
59      if (TEST_OPT_DEBUG) PrintLn();
60      return 0;
61    }
62    if (TEST_OPT_DEBUG) Print("%d",j);
63    if (pDivisibleBy(strat->S[j],(*h).p))
64    {
65      if (TEST_OPT_DEBUG) PrintS("+\n");
66      /*
67      * the polynomial to reduce with is;
68      * T[j].p
69      */
70      if (!TEST_OPT_INTSTRATEGY)
71        pNorm(strat->S[j]);
72      if (TEST_OPT_DEBUG)
73      {
74        wrp(h->p);
75        PrintS(" with ");
76        wrp(strat->S[j]);
77      }
78      (*h).p = nc_ReduceSpoly(strat->S[j],(*h).p, currRing);
79      //spSpolyRed(strat->T[j].p,(*h).p,strat->kNoether);
80
81      if (TEST_OPT_DEBUG)
82      {
83        PrintS(" to ");
84        wrp(h->p);
85      }
86      if ((*h).p == NULL)
87      {
88        if (h->lcm!=NULL) p_LmFree((*h).lcm, currRing);
89        return 0;
90      }
91      if (TEST_OPT_INTSTRATEGY)
92      {
93        if (rField_is_Zp_a()) pContent(h->p);
94        else pCleardenom(h->p);// also does a pContent
95      }
96      /*computes the ecart*/
97      d = pLDeg((*h).p,&((*h).length),currRing);
98      (*h).FDeg=pFDeg((*h).p,currRing);
99      (*h).ecart = d-(*h).FDeg; /*pFDeg((*h).p);*/
100      if ((strat->syzComp!=0) && !strat->honey)
101      {
102        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
103        {
104          if (TEST_OPT_DEBUG) PrintS(" > sysComp\n");
105          return 0;
106        }
107      }
108      /*- try to reduce the s-polynomial -*/
109      pass++;
110      /*
111      *test whether the polynomial should go to the lazyset L
112      *-if the degree jumps
113      *-if the number of pre-defined reductions jumps
114      */
115      if ((strat->Ll >= 0)
116      && ((d >= reddeg) || (pass > strat->LazyPass))
117      && !strat->homog)
118      {
119        at = strat->posInL(strat->L,strat->Ll,h,strat);
120        if (at <= strat->Ll)
121        {
122          i=strat->sl+1;
123          do
124          {
125            i--;
126            if (i<0) return 0;
127          } while (!pDivisibleBy(strat->S[i],(*h).p));
128          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
129          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
130          (*h).p = NULL;
131          return 0;
132        }
133      }
134      if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
135      {
136        reddeg = d+1;
137        Print(".%d",d);mflush();
138      }
139      j = 0;
140      if TEST_OPT_DEBUG PrintLn();
141    }
142    else
143    {
144      if (TEST_OPT_DEBUG) PrintS("-");
145      j++;
146    }
147  }
148}
149
150/*2
151*  reduction procedure for the homogeneous case
152*  and the case of a degree-ordering
153*/
154static int nc_redHomog (LObject* h,kStrategy strat)
155{
156  if (strat->tl<0)
157  {
158    enterT((*h),strat);
159    return 1;
160  }
161
162  int j = 0;
163
164  if (TEST_OPT_DEBUG)
165  {
166    PrintS("red:");
167    wrp(h->p);
168    PrintS(" ");
169  }
170  loop
171  {
172    if (TEST_OPT_DEBUG) Print("%d",j);
173    if (pDivisibleBy(strat->S[j],(*h).p))
174    {
175      if (TEST_OPT_DEBUG)
176      {
177        PrintS("+\nwith ");
178        wrp(strat->S[j]);
179      }
180      /*- compute the s-polynomial -*/
181      (*h).p = nc_ReduceSpoly(strat->S[j],(*h).p,currRing);
182      if ((*h).p == NULL)
183      {
184        if (TEST_OPT_DEBUG) PrintS(" to 0\n");
185        if (h->lcm!=NULL) pLmFree((*h).lcm);
186        (*h).lcm=NULL;
187        return 0;
188      }
189/*
190*      else if (strat->syzComp)
191*      {
192*        if (pMinComp((*h).p) > strat->syzComp)
193*        {
194*          enterT((*h),strat);
195*          return;
196*        }
197*      }
198*/
199      /*- try to reduce the s-polynomial -*/
200      j = 0;
201    }
202    else
203    {
204      if (j >= strat->sl)
205      {
206        enterT((*h),strat);
207        return 1;
208      }
209      j++;
210    }
211  }
212}
213
214#if 0
215/*2
216*  reduction procedure for the homogeneous case
217*  and the case of a degree-ordering
218*/
219static int nc_redHomog0 (LObject* h,kStrategy strat)
220{
221  if (strat->tl<0)
222  {
223    enterT((*h),strat);
224    return 0;
225  }
226
227  int j = 0;
228  int k = 0;
229
230  if (TEST_OPT_DEBUG)
231  {
232    PrintS("red:");
233    wrp(h->p);
234    PrintS(" ");
235  }
236  loop
237  {
238    if (TEST_OPT_DEBUG) Print("%d",j);
239    if (pDivisibleBy(strat->T[j].p,(*h).p))
240    {
241      if (TEST_OPT_DEBUG)
242      {
243        PrintS("+\nwith ");
244        wrp(strat->S[j]);
245      }
246      /*- compute the s-polynomial -*/
247      (*h).p = nc_ReduceSpoly(strat->T[j].p,(*h).p,strat->kNoether,currRing);
248      if ((*h).p == NULL)
249      {
250        if (TEST_OPT_DEBUG) PrintS(" to 0\n");
251        if (h->lcm!=NULL) pLmFree((*h).lcm);
252        (*h).lcm=NULL;
253        return 0;
254      }
255      else
256      {
257        if (TEST_OPT_INTSTRATEGY)
258        {
259          if (rField_is_Zp_a()) pContent(h->p);
260          else pCleardenom(h->p);// also does a pContent
261        }
262        if (strat->syzComp!=0)
263        {
264          if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
265          {
266/*
267*           (*h).length=pLength0((*h).p);
268*/
269            enterT((*h),strat);
270            return 0;
271          }
272        }
273      }
274      /*- try to reduce the s-polynomial -*/
275      j = 0;
276    }
277    else
278    {
279      if (j >= strat->tl)
280      {
281        if (TEST_OPT_INTSTRATEGY)
282        {
283          if (rField_is_Zp_a()) pContent(h->p);
284          else pCleardenom(h->p);// also does a pContent
285        }
286/*
287*       (*h).length=pLength0((*h).p);
288*/
289        enterT((*h),strat);
290        return 0;
291      }
292      j++;
293    }
294  }
295}
296
297/*2
298*  reduction procedure for the inhomogeneous case
299*  and not a degree-ordering
300*/
301static int nc_redLazy (LObject* h,kStrategy strat)
302{
303  if (strat->tl<0)
304  {
305    enterT((*h),strat);
306    return 0;
307  }
308
309  int at,d,i;
310  int j = 0;
311  int pass = 0;
312  int reddeg = pFDeg((*h).p,currRing);
313
314  if (TEST_OPT_DEBUG)
315  {
316    PrintS("red:");
317    wrp(h->p);
318    PrintS(" ");
319  }
320  loop
321  {
322    if (TEST_OPT_DEBUG) Print("%d",j);
323    if (pDivisibleBy(strat->S[j],(*h).p))
324    {
325      if (TEST_OPT_DEBUG)
326      {
327        PrintS("+\nwith ");
328        wrp(strat->S[j]);
329      }
330      /*- compute the s-polynomial -*/
331      (*h).p = nc_ReduceSpoly(strat->S[j],(*h).p,strat->kNoether,currRing);
332      if ((*h).p == NULL)
333      {
334        if (TEST_OPT_DEBUG) PrintS(" to 0\n");
335        if (h->lcm!=NULL) pLmFree((*h).lcm);
336        (*h).lcm=NULL;
337        return 0;
338      }
339//      else if (strat->syzComp)
340//      {
341//        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
342//        {
343//          if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
344//          if (TEST_OPT_INTSTRATEGY) pContent(h->p);
345//          enterTBba((*h),strat->tl+1,strat);
346//          return;
347//        }
348//      }
349      else
350      {
351        if (TEST_OPT_DEBUG)
352        {
353          PrintS("to:");
354          wrp((*h).p);
355          PrintLn();
356        }
357        if (TEST_OPT_INTSTRATEGY)
358        {
359          pContent(h->p);
360          //pCleardenom(h->p);// also does a pContent
361        }
362      }
363      /*- try to reduce the s-polynomial -*/
364      pass++;
365      d = pFDeg((*h).p,currRing);
366      if ((strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
367      {
368        at = posInL11(strat->L,strat->Ll,h,strat);
369        if (at <= strat->Ll)
370        {
371          i=strat->sl+1;
372          do
373          {
374            i--;
375            if (i<0)
376            {
377              enterT((*h),strat);
378              return 0;
379            }
380          }
381          while (!pDivisibleBy(strat->S[i],(*h).p));
382          if (TEST_OPT_DEBUG) Print(" ->L[%d]\n",at);
383          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
384          (*h).p = NULL;
385          return 0;
386        }
387      }
388      else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d != reddeg))
389      {
390        Print(".%d",d);mflush();
391        reddeg = d;
392      }
393      j = 0;
394    }
395    else
396    {
397      if (TEST_OPT_DEBUG) PrintS("-");
398      if (j >= strat->sl)
399      {
400        if (TEST_OPT_DEBUG) PrintLn();
401        if (TEST_OPT_INTSTRATEGY)
402        {
403          if (rField_is_Zp_a()) pContent(h->p);
404          else pCleardenom(h->p);// also does a pContent
405        }
406        enterT((*h),strat);
407        return 0;
408      }
409      j++;
410    }
411  }
412}
413
414/*2
415*  reduction procedure for the sugar-strategy (honey)
416* reduces h with elements from T choosing first possible
417* element in T with respect to the given ecart
418*/
419static int nc_redHoney (LObject*  h,kStrategy strat)
420{
421  if (strat->tl<0)
422  {
423    enterT((*h),strat);
424    return 0;
425  }
426
427  poly pi;
428  int i,j,at,reddeg,d,pass,ei;
429
430  pass = j = 0;
431  d = reddeg = pFDeg((*h).p,currRing)+(*h).ecart;
432  if (TEST_OPT_DEBUG)
433  {
434    PrintS("red:");
435    wrp((*h).p);
436  }
437  loop
438  {
439    if (TEST_OPT_DEBUG) Print("%d",j);
440    if (pDivisibleBy(strat->T[j].p,(*h).p))
441    {
442      if (TEST_OPT_DEBUG) PrintS("+");
443      pi = strat->T[j].p;
444      ei = strat->T[j].ecart;
445      /*
446      * the polynomial to reduce with (up to the moment) is;
447      * pi with ecart ei
448      */
449      i = j;
450      loop
451      {
452        /*- takes the first possible with respect to ecart -*/
453        i++;
454        if (i > strat->tl)
455          break;
456        if ((!BTEST1(20)) && (ei <= (*h).ecart))
457          break;
458        if (TEST_OPT_DEBUG) Print("%d",i);
459        if ((strat->T[i].ecart < ei) && pDivisibleBy(strat->T[i].p,(*h).p))
460        {
461          if (TEST_OPT_DEBUG) PrintS("+");
462          /*
463          * the polynomial to reduce with is now;
464          */
465          pi = strat->T[i].p;
466          ei = strat->T[i].ecart;
467        }
468        else if (TEST_OPT_DEBUG) PrintS("-");
469      }
470
471      /*
472      * end of search: have to reduce with pi
473      */
474      if (ei > (*h).ecart)
475      {
476        /*
477        * It is not possible to reduce h with smaller ecart;
478        * if possible h goes to the lazy-set L,i.e
479        * if its position in L would be not the last one
480        */
481        if (strat->Ll >= 0) /* L is not empty */
482        {
483          at = strat->posInL(strat->L,strat->Ll,h,strat);
484          if(at <= strat->Ll)
485          /*- h will not become the next element to reduce -*/
486          {
487            enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
488            if (TEST_OPT_DEBUG) Print(" ecart too big: -> L%d\n",at);
489            (*h).p = NULL;
490            return 0;
491          }
492        }
493      }
494      if (TEST_OPT_DEBUG)
495      {
496        PrintS("\nwith ");
497        wrp(pi);
498      }
499      if (strat->fromT)
500      {
501        strat->fromT=FALSE;
502        (*h).p = gnc_ReduceSpolyNew(pi,(*h).p,strat->kNoether,currRing);
503      }
504      else
505        (*h).p = nc_ReduceSpoly(pi,(*h).p,strat->kNoether,currRing);
506      if (TEST_OPT_DEBUG)
507      {
508        PrintS(" to ");
509        wrp((*h).p);
510        PrintLn();
511      }
512      if ((*h).p == NULL)
513      {
514        if (h->lcm!=NULL) pLmFree((*h).lcm);
515        (*h).lcm=NULL;
516        return 0;
517      }
518      if (TEST_OPT_INTSTRATEGY)
519      {
520        //pContent(h->p);
521        pCleardenom(h->p);// also does a pContent
522      }
523      /* compute the ecart */
524      if (ei <= (*h).ecart)
525        (*h).ecart = d-pFDeg((*h).p,currRing);
526      else
527        (*h).ecart = d-pFDeg((*h).p,currRing)+ei-(*h).ecart;
528//      if (strat->syzComp)
529//      {
530//        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
531//        {
532//          if (TEST_OPT_DEBUG)
533//            PrintS("  >syzComp\n");
534//          if (TEST_OPT_INTSTRATEGY) pContent(h->p);
535//          at=strat->posInT(strat->T,strat->tl,(*h));
536//          enterTBba((*h),at,strat);
537//          return;
538//        }
539//      }
540      /*
541      * try to reduce the s-polynomial h
542      *test first whether h should go to the lazyset L
543      *-if the degree jumps
544      *-if the number of pre-defined reductions jumps
545      */
546      pass++;
547      d = pFDeg((*h).p,currRing)+(*h).ecart;
548      if ((strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
549      {
550        at = strat->posInL(strat->L,strat->Ll,h,strat);
551        if (at <= strat->Ll)
552        {
553          /*test if h is already standardbasis element*/
554          i=strat->sl+1;
555          do
556          {
557            i--;
558            if (i<0)
559            {
560              enterT((*h),strat);
561              return 0;
562            }
563          } while (!pDivisibleBy(strat->S[i],(*h).p));
564          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
565          if (TEST_OPT_DEBUG)
566            Print(" degree jumped: -> L%d\n",at);
567          (*h).p = NULL;
568          return 0;
569        }
570      }
571      else if (TEST_OPT_PROT && (strat->Ll < 0) && (d > reddeg))
572      {
573        reddeg = d;
574        Print(".%d",d); mflush();
575      }
576      j = 0;
577    }
578    else
579    {
580      if (TEST_OPT_DEBUG) PrintS("-");
581      if (j >= strat->tl)
582      {
583        if (TEST_OPT_DEBUG) PrintLn();
584        if (TEST_OPT_INTSTRATEGY)
585        {
586          //pContent(h->p);
587          pCleardenom(h->p);// also does a pContent
588        }
589        enterT((*h),strat);
590        return 0;
591      }
592      j++;
593    }
594  }
595}
596
597/*2
598*  reduction procedure for tests only
599*  reduces with elements from T and chooses the best possible
600*/
601static int nc_redBest (LObject*  h,kStrategy strat)
602{
603  if (strat->tl<0)
604  {
605    enterT((*h),strat);
606    return 0;
607  }
608
609  int j,jbest,at,reddeg,d,pass;
610  poly     p,ph;
611  pass = j = 0;
612
613  if (strat->honey)
614    reddeg = pFDeg((*h).p,currRing)+(*h).ecart;
615  else
616    reddeg = pFDeg((*h).p,currRing);
617  loop
618  {
619    if (pDivisibleBy(strat->T[j].p,(*h).p))
620    {
621      /* compute the s-polynomial */
622      if (!TEST_OPT_INTSTRATEGY) pNorm((*h).p);
623#ifdef SDRING
624      // spSpolyShortBba will not work in the SRING case
625      if (pSDRING)
626      {
627        p=spSpolyCreate(strat->T[j].p,(*h).p,strat->kNoether);
628        if (p!=NULL) pDelete(&pNext(p));
629      }
630      else
631#endif
632      p = nc_CreateShortSpoly(strat->T[j].p,(*h).p);
633      /* computes only the first monomial of the spoly  */
634      if (p)
635      {
636        jbest = j;
637        /* looking for the best possible reduction */
638        if ((strat->syzComp==0) || (pMinComp(p) <= strat->syzComp))
639        {
640          loop
641          {
642            j++;
643            if (j > strat->tl)
644              break;
645            if (pDivisibleBy(strat->T[j].p,(*h).p))
646            {
647#ifdef SDRING
648              // spSpolyShortBba will not work in the SRING case
649              if (pSDRING)
650              {
651                ph=spSpolyCreate(strat->T[j].p,(*h).p,strat->kNoether);
652                if (ph!=NULL) pDelete(&pNext(ph));
653              }
654              else
655#endif
656              ph = nc_CreateShortSpoly(strat->T[j].p,(*h).p);
657              if (ph==NULL)
658              {
659                pLmFree(p);
660                pDelete(&((*h).p));
661                if (h->lcm!=NULL)
662                {
663                  pLmFree((*h).lcm);
664                  (*h).lcm=NULL;
665                }
666                return 0;
667              }
668              else if (pLmCmp(ph,p) == -1)
669              {
670                pLmFree(p);
671                p = ph;
672                jbest = j;
673              }
674              else
675              {
676                pLmFree(ph);
677              }
678            }
679          }
680        }
681        pLmFree(p);
682        (*h).p = nc_ReduceSpoly(strat->T[jbest].p,(*h).p,strat->kNoether,currRing);
683      }
684      else
685      {
686        if (h->lcm!=NULL)
687        {
688          pLmFree((*h).lcm);
689          (*h).lcm=NULL;
690        }
691        (*h).p = NULL;
692        return 0;
693      }
694      if (strat->honey && pLexOrder)
695        strat->initEcart(h);
696      /* h.length:=l; */
697      /* try to reduce the s-polynomial */
698//      if (strat->syzComp)
699//      {
700//        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
701//        {
702//          if (TEST_OPT_DEBUG)
703//            PrintS(" >syzComp\n");
704//          if (TEST_OPT_INTSTRATEGY) pContent(h->p);
705//          at=strat->posInT(strat->T,strat->tl,(*h));
706//          enterTBba((*h),at,strat);
707//          return;
708//        }
709//      }
710      if (strat->honey || pLexOrder)
711      {
712        pass++;
713        d = pFDeg((*h).p,currRing);
714        if (strat->honey)
715          d += (*h).ecart;
716        if ((strat->Ll >= 0) && ((pass > strat->LazyPass) || (d > reddeg)))
717        {
718          at = strat->posInL(strat->L,strat->Ll,h,strat);
719          if (at <= strat->Ll)
720          {
721            enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
722            (*h).p = NULL;
723            return 0;
724          }
725        }
726        else if (TEST_OPT_PROT && (strat->Ll < 0) && (d != reddeg))
727        {
728          reddeg = d;
729          Print("%d.");
730          mflush();
731        }
732      }
733      j = 0;
734    }
735    else
736    {
737      if (j >= strat->tl)
738      {
739        if (TEST_OPT_INTSTRATEGY)
740        {
741          //pContent(h->p);
742          pCleardenom(h->p);// also does a pContent
743        }
744        enterT((*h),strat);
745        return 0;
746      }
747      j++;
748    }
749  }
750}
751
752#endif
753
754void nc_gr_initBba(ideal F, kStrategy strat)
755{
756  assume(rIsPluralRing(currRing));
757
758  int i;
759  idhdl h;
760 /* setting global variables ------------------- */
761  strat->enterS = enterSBba;
762
763/*
764  if ((BTEST1(20)) && (!strat->honey))
765    strat->red = nc_redBest;
766  else if (strat->honey)
767    strat->red = nc_redHoney;
768  else if (pLexOrder && !strat->homog)
769    strat->red = nc_redLazy;
770  else if (TEST_OPT_INTSTRATEGY && strat->homog)
771    strat->red = nc_redHomog0;
772  else
773    strat->red = nc_redHomog;
774*/
775
776//   if (rIsPluralRing(currRing))
777    strat->red = redGrFirst;
778
779  if (pLexOrder && strat->honey)
780    strat->initEcart = initEcartNormal;
781  else
782    strat->initEcart = initEcartBBA;
783  if (strat->honey)
784    strat->initEcartPair = initEcartPairMora;
785  else
786    strat->initEcartPair = initEcartPairBba;
787  strat->kIdeal = NULL;
788  //if (strat->ak==0) strat->kIdeal->rtyp=IDEAL_CMD;
789  //else              strat->kIdeal->rtyp=MODUL_CMD;
790  //strat->kIdeal->data=(void *)strat->Shdl;
791  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
792  {
793     //interred  machen   Aenderung
794     pFDegOld=pFDeg;
795     pLDegOld=pLDeg;
796  //   h=ggetid("ecart");
797  //   if ((h!=NULL) && (IDTYP(h)==INTVEC_CMD))
798  //   {
799  //     ecartWeights=iv2array(IDINTVEC(h));
800  //   }
801  //   else
802    {
803      ecartWeights=(short *)omAlloc((pVariables+1)*sizeof(short));
804      /*uses automatic computation of the ecartWeights to set them*/
805      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
806    }
807    pFDeg=totaldegreeWecart;
808    pLDeg=maxdegreeWecart;
809    for(i=1; i<=pVariables; i++)
810      Print(" %d",ecartWeights[i]);
811    PrintLn();
812    mflush();
813  }
814}
815
816ideal gnc_gr_bba(const ideal F, const ideal Q, const intvec *, const intvec *, kStrategy strat)
817{
818  assume(pOrdSgn != -1); // no mora!!! it terminates only for global ordering!!! (?)
819
820  intvec *w=NULL;
821  intvec *hilb=NULL;
822  int   srmax,lrmax;
823  int   olddeg,reduc;
824  int red_result=1;
825  int hilbeledeg=1,hilbcount=0,minimcnt=0;
826
827  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
828  // initHilbCrit(F,Q,&hilb,strat);
829  /* in plural we don't need Hilb yet */
830  nc_gr_initBba(F,strat);
831  initBuchMoraPos(strat);
832  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
833  /*Shdl=*/initBuchMora(F, Q,strat);
834  strat->posInT=posInT110;
835  srmax = strat->sl;
836  reduc = olddeg = lrmax = 0;
837  /* compute------------------------------------------------------- */
838  while (strat->Ll >= 0)
839  {
840    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
841    if (TEST_OPT_DEBUG) messageSets(strat);
842    if (strat->Ll== 0) strat->interpt=TRUE;
843    if (TEST_OPT_DEGBOUND
844    && ((strat->honey
845    && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
846       || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
847    {
848      /*
849      *stops computation if
850      * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
851      *a predefined number Kstd1_deg
852      */
853      while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
854      break;
855    }
856    /* picks the last element from the lazyset L */
857    strat->P = strat->L[strat->Ll];
858    strat->Ll--;
859    //kTest(strat);
860    if (pNext(strat->P.p) == strat->tail)
861    {
862      /* deletes the short spoly and computes */
863      pLmFree(strat->P.p);
864      /* the real one */
865      if ((ncRingType(currRing)==nc_lie) && pHasNotCF(strat->P.p1,strat->P.p2)) /* prod crit */
866      {
867        strat->cp++;
868        /* prod.crit itself in nc_CreateSpoly */
869      }
870      strat->P.p = nc_CreateSpoly(strat->P.p1,strat->P.p2,currRing);
871    }
872    if (strat->P.p != NULL)
873    {
874      if (TEST_OPT_PROT)
875      message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
876              &olddeg,&reduc,strat, red_result);
877      /* reduction of the element chosen from L */
878      strat->red(&strat->P,strat);
879    }
880    if (strat->P.p != NULL)
881    {
882          /* statistic */
883          if (TEST_OPT_PROT)
884          {
885            PrintS("s\n");
886          }
887          /* enter P.p into s and L */
888          {
889            strat->P.sev=0;
890            int pos=posInS(strat,strat->sl,strat->P.p, strat->P.ecart);
891            {
892              if (TEST_OPT_INTSTRATEGY)
893              {
894                if ((strat->syzComp==0)||(!strat->homog))
895                {
896                  strat->P.p = redtailBba(strat->P.p,pos-1,strat);
897                }
898                pCleardenom(strat->P.p);
899              }
900              else
901              {
902                pNorm(strat->P.p);
903                if ((strat->syzComp==0)||(!strat->homog))
904                {
905                  strat->P.p = redtailBba(strat->P.p,pos-1,strat);
906                }
907              }
908              // PLURAL debug
909              /* should be used only internally!!! */
910
911              //pWrite(strat->P.p);
912
913              if (TEST_OPT_DEBUG)
914              {
915                PrintS("new s:");
916                wrp(strat->P.p);
917                PrintLn();
918              }
919              // kTest(strat);
920              //
921              enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat);
922              if (strat->sl==-1) pos=0;
923              else pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
924              strat->enterS(strat->P,pos,strat,-1);
925            }
926//            if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
927          }
928          if (strat->P.lcm!=NULL) pLmFree(strat->P.lcm);
929      if (strat->sl>srmax) srmax = strat->sl;
930    }
931#ifdef KDEBUG
932    strat->P.lcm=NULL;
933#endif
934    //kTest(strat);
935  }
936  if (TEST_OPT_DEBUG) messageSets(strat);
937
938  /* complete reduction of the standard basis--------- */
939  if (TEST_OPT_SB_1)
940  {
941    int k=1;
942    int j;
943    while(k<=strat->sl)
944    {
945      j=0;
946      loop
947      {
948        if (j>=k) break;
949        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
950        j++;
951      }
952      k++;
953    }
954  }
955
956  if (TEST_OPT_REDSB)
957     completeReduce(strat);
958  /* release temp data-------------------------------- */
959  exitBuchMora(strat);
960  if (TEST_OPT_WEIGHTM)
961  {
962    pFDeg=pFDegOld;
963    pLDeg=pLDegOld;
964    if (ecartWeights)
965    {
966      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
967      ecartWeights=NULL;
968    }
969  }
970  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
971  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
972
973
974#ifdef PDEBUG
975/* for counting number of pairs [enterL] in Plural */
976/*   extern int zaehler; */
977/*   Print("Total pairs considered:%d\n",zaehler); zaehler=0; */
978#endif /*PDEBUG*/
979  return (strat->Shdl);
980}
981
982ideal gnc_gr_mora(const ideal, const ideal, const intvec *, const intvec *, kStrategy)
983{
984  PrintS("Sorry, non-commutative mora is not yet implemented!");
985  PrintLn();
986
987  // Not yet!
988  return NULL;
989}
990
991#endif
992
Note: See TracBrowser for help on using the repository browser.