source: git/kernel/gr_kstd2.cc @ b130fb

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