source: git/kernel/gr_kstd2.cc @ 2499bf

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