source: git/Singular/kstd2.cc @ f92fa13

spielwiese
Last change on this file since f92fa13 was f92fa13, checked in by Olaf Bachmann <obachman@…>, 26 years ago
1998-03-16 Olaf Bachmann <obachman@mathematik.uni-kl.de> * polys-impl.h: #define COMP_FAST * configure.in,Makefile.in: check for flex -P; increased version number to 1.1.7 1998-03-04 Olaf Bachmann <obachman@mathematik.uni-kl.de> * febase.h: added macro assume() * spSpolyLoop.cc: Automatic generation of SpolyLoops using spSpolyLoop.pl * kstd*.cc: New calling interface to get SpolyLoop * ring.h: Introduced rOrderType_t git-svn-id: file:///usr/local/Singular/svn/trunk@1236 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 40.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kstd2.cc,v 1.12 1998-03-16 14:56:32 obachman Exp $ */
5/*
6*  ABSTRACT -  Kernel: alg. of Buchberger
7*/
8
9#include "mod2.h"
10#include "tok.h"
11#include "mmemory.h"
12#include "polys.h"
13#include "ideals.h"
14#include "febase.h"
15#include "kutil.h"
16#include "kstd1.h"
17#include "kstd2.h"
18#include "khstd.h"
19#include "spolys.h"
20#include "cntrlc.h"
21#include "weight.h"
22#include "ipid.h"
23#include "ipshell.h"
24#include "intvec.h"
25#ifdef STDTRACE
26#include "comm.h"
27#include "lists.h"
28#endif
29#ifdef COMP_FAST
30#include "spSpolyLoop.h"
31#endif
32
33// #include "timer.h"
34
35/*2
36* consider the part above syzComp:
37* (assume the polynomial comes from a syz computation)
38* - it is a constant term: return a copy of it
39* - else: return NULL
40*/
41static poly kFromInput(poly p,kStrategy strat)
42{
43  poly q=p;
44
45  if (pGetComp(q)>strat->syzComp) return NULL;
46  while ((q!=NULL) && (pGetComp(q)<=strat->syzComp)) pIter(q);
47  if (pIsConstantComp(q))
48    return pHead(q);
49  return NULL;
50}
51
52/*2
53*  reduction procedure for the syz
54*  and TEST_OPT_MINRES: special minimizing during computations
55*  assumes homogeneous case and degree-ordering
56*/
57static void redSyz (LObject* h,kStrategy strat)
58{
59  int j = 0,i=0,pos;
60  BOOLEAN exchanged=pDivisibleBy((*h).p2,(*h).p1);
61  poly p,q;
62
63  if (exchanged)
64  {
65    q = kFromInput((*h).p1,strat);
66    if (q==NULL)
67    {
68      exchanged = FALSE;
69    }
70    else
71    {
72      while (i<=strat->Ll)
73      {
74        if ((strat->L[i].p1==strat->P.p1) || (strat->L[i].p2==strat->P.p1))
75        {
76//PrintS("#");
77          deleteInL(strat->L,&strat->Ll,i,strat);
78        }
79        else
80          i++;
81      }
82      i = 0;
83    }
84  }
85#ifdef KDEBUG
86  if (TEST_OPT_DEBUG)
87  {
88    PrintS("red:");
89    wrp(h->p);
90    PrintS(" ");
91  }
92#endif
93  loop
94  {
95#ifdef KDEBUG
96    if (TEST_OPT_DEBUG) Print("%d",j);
97#endif
98    if (pDivisibleBy(strat->S[j],(*h).p))
99    {
100#ifdef KDEBUG
101      if (TEST_OPT_DEBUG)
102      {
103        PrintS("+\nwith ");
104        wrp(strat->S[j]);
105      }
106#endif
107      if ((!exchanged) && (pEqual((*h).p,strat->S[j])))
108      {
109//PrintS("@");
110        q = kFromInput(strat->S[j],strat);
111        if (q!=NULL)
112        {
113//Print("%d*",pGetComp(q));
114          exchanged = TRUE;
115          p = strat->S[j];
116          if (!TEST_OPT_INTSTRATEGY)
117            pNorm((*h).p);
118          else
119          {
120            //pContent((*h).p);
121            pCleardenom((*h).p);// also does a pContent
122          }
123          strat->S[j] = (*h).p;
124          (*h).p = p;
125          while ((i<=strat->tl) && (strat->T[i].p!=p)) i++;
126          if (i<=strat->tl) strat->T[i].p = strat->S[j];
127          for (i=0;i<=strat->Ll;i++)
128          {
129            if (strat->L[i].p1==p) strat->L[i].p1=strat->S[j];
130            if (strat->L[i].p2==p) strat->L[i].p2=strat->S[j];
131          }
132        }
133      }
134      //if (strat->interpt) test_int_std(strat->kIdeal);
135      /*- compute the s-polynomial -*/
136      (*h).p = spSpolyRed(strat->S[j],(*h).p,strat->kNoether,
137                          strat->spSpolyLoop);
138      if ((*h).p == NULL)
139      {
140#ifdef KDEBUG
141        if (TEST_OPT_DEBUG) PrintS(" to 0\n");
142#endif
143        if (h->lcm!=NULL) pFree1((*h).lcm);
144#ifdef KDEBUG
145        (*h).lcm=NULL;
146#endif
147        return;
148      }
149/*- try to reduce the s-polynomial -*/
150      j = 0;
151    }
152    else
153    {
154      if (j >= strat->sl)
155      {
156        if (exchanged)
157        {
158          if (pGetComp((*h).p) > strat->syzComp)
159          {
160//PrintS("syz");
161            pDelete(&((*h).p));
162            return;
163          }
164          else
165          {
166            if (!TEST_OPT_INTSTRATEGY)
167            {
168//PrintS("r");
169              pos = posInS(strat->S,strat->sl,(*h).p);
170              pNorm((*h).p);
171              (*h).p = redtailSyz((*h).p,pos-1,strat);
172            }
173            p = (*h).p;
174            while ((pNext(p)!=NULL) && (pGetComp(pNext(p))<=strat->syzComp))
175               pIter(p);
176            pDelete(&pNext(p));
177            pNext(p) = q;
178          }
179        }
180        else if (!TEST_OPT_INTSTRATEGY)
181        {
182          pos = posInS(strat->S,strat->sl,(*h).p);
183          pNorm((*h).p);
184          (*h).p = redtailSyz((*h).p,pos-1,strat);
185        }
186        enterTBba((*h),strat->tl+1,strat);
187        return;
188      }
189      j++;
190    }
191  }
192}
193
194/*2
195*  reduction procedure for the homogeneous case
196*  and the case of a degree-ordering
197*/
198static void redHomog (LObject* h,kStrategy strat)
199{
200  if (strat->tl<0)
201  {
202    enterTBba((*h),0,strat);
203    return;
204  }
205
206  int j = 0;
207
208#ifdef KDEBUG
209  if (TEST_OPT_DEBUG)
210  {
211    PrintS("red:");
212    wrp(h->p);
213    PrintS(" ");
214  }
215#endif
216  if (strat->ak!=0)
217  {
218    loop
219      {
220#ifdef KDEBUG
221        if (TEST_OPT_DEBUG) Print("%d",j);
222#endif
223        if (pDivisibleBy1(strat->S[j],(*h).p))
224        {
225#ifdef KDEBUG
226          if (TEST_OPT_DEBUG)
227          {
228            PrintS("+\nwith ");
229            wrp(strat->S[j]);
230          }
231#endif
232          //if (strat->interpt) test_int_std(strat->kIdeal);
233          /*- compute the s-polynomial -*/
234          (*h).p = spSpolyRed(strat->S[j],(*h).p,strat->kNoether,
235                              strat->spSpolyLoop);
236          if ((*h).p == NULL)
237          {
238#ifdef KDEBUG
239            if (TEST_OPT_DEBUG) PrintS(" to 0\n");
240#endif
241            if (h->lcm!=NULL) pFree1((*h).lcm);
242#ifdef KDEBUG
243            (*h).lcm=NULL;
244#endif
245            return;
246          }
247          j = 0;
248        }
249        else
250        {
251          if (j >= strat->sl)
252          {
253            enterTBba((*h),strat->tl+1,strat);
254            return;
255          }
256          j++;
257        }
258      }
259  }
260  else
261  {
262    // no module component
263    loop
264      {
265#ifdef KDEBUG
266        if (TEST_OPT_DEBUG) Print("%d",j);
267#endif
268        if (pDivisibleBy2(strat->S[j],(*h).p))
269        {
270#ifdef KDEBUG
271          if (TEST_OPT_DEBUG)
272          {
273            PrintS("+\nwith ");
274            wrp(strat->S[j]);
275          }
276#endif
277          //if (strat->interpt) test_int_std(strat->kIdeal);
278          /*- compute the s-polynomial -*/
279          (*h).p = spSpolyRed(strat->S[j],(*h).p,strat->kNoether,
280                              strat->spSpolyLoop);
281          if ((*h).p == NULL)
282          {
283#ifdef KDEBUG
284            if (TEST_OPT_DEBUG) PrintS(" to 0\n");
285#endif
286            if (h->lcm!=NULL) pFree1((*h).lcm);
287#ifdef KDEBUG
288            (*h).lcm=NULL;
289#endif
290            return;
291          }
292          j = 0;
293        }
294        else
295        {
296          if (j >= strat->sl)
297          {
298            enterTBba((*h),strat->tl+1,strat);
299            return;
300          }
301          j++;
302        }
303      }
304  }
305}
306
307/*2
308*  reduction procedure for the homogeneous case
309*  and the case of a degree-ordering
310*/
311static void redHomog0 (LObject* h,kStrategy strat)
312{
313  if (strat->tl<0)
314  {
315    enterTBba((*h),0,strat);
316    return;
317  }
318
319  int j = 0;
320  int k = 0;
321
322#ifdef KDEBUG
323  if (TEST_OPT_DEBUG)
324  {
325    PrintS("red:");
326    wrp(h->p);
327    PrintS(" ");
328  }
329#endif
330  if (strat->ak)
331  {
332    loop
333      {
334#ifdef KDEBUG
335        if (TEST_OPT_DEBUG) Print("%d",j);
336#endif
337        if (pDivisibleBy1(strat->T[j].p,(*h).p))
338        {
339          //if (strat->interpt) test_int_std(strat->kIdeal);
340#ifdef KDEBUG
341          if (TEST_OPT_DEBUG)
342          {
343            PrintS("+\nwith ");
344            wrp(strat->S[j]);
345          }
346#endif
347          /*- compute the s-polynomial -*/
348          (*h).p = spSpolyRed(strat->T[j].p,(*h).p,strat->kNoether,
349                              strat->spSpolyLoop);
350          if ((*h).p == NULL)
351          {
352#ifdef KDEBUG
353            if (TEST_OPT_DEBUG) PrintS(" to 0\n");
354#endif
355            if (h->lcm!=NULL) pFree1((*h).lcm);
356#ifdef KDEBUG
357            (*h).lcm=NULL;
358#endif
359            return;
360          }
361          j = 0;
362        }
363        else
364        {
365          if (j >= strat->tl)
366          {
367            //pContent((*h).p);
368            pCleardenom((*h).p);// also does a pContent
369/*
370 *       (*h).length=pLength0((*h).p);
371 */
372            k=strat->posInT(strat->T,strat->tl,(*h));
373            enterTBba((*h),k,strat);
374            return;
375          }
376          j++;
377        }
378      }
379  }
380  else
381  {
382    loop
383      {
384
385        // no module component
386#ifdef KDEBUG
387        if (TEST_OPT_DEBUG) Print("%d",j);
388#endif
389        if (pDivisibleBy2(strat->T[j].p,(*h).p))
390        {
391          //if (strat->interpt) test_int_std(strat->kIdeal);
392#ifdef KDEBUG
393          if (TEST_OPT_DEBUG)
394          {
395            PrintS("+\nwith ");
396            wrp(strat->S[j]);
397          }
398#endif
399          /*- compute the s-polynomial -*/
400          (*h).p = spSpolyRed(strat->T[j].p,(*h).p,strat->kNoether,
401                              strat->spSpolyLoop);
402          if ((*h).p == NULL)
403          {
404#ifdef KDEBUG
405            if (TEST_OPT_DEBUG) PrintS(" to 0\n");
406#endif
407            if (h->lcm!=NULL) pFree1((*h).lcm);
408#ifdef KDEBUG
409            (*h).lcm=NULL;
410#endif
411            return;
412          }
413          j = 0;
414        }
415        else
416        {
417          if (j >= strat->tl)
418          {
419            //pContent((*h).p);
420            pCleardenom((*h).p);// also does a pContent
421/*
422 *       (*h).length=pLength0((*h).p);
423 */
424            k=strat->posInT(strat->T,strat->tl,(*h));
425            enterTBba((*h),k,strat);
426            return;
427          }
428          j++;
429        }
430      }
431  }
432}
433
434
435/*2
436*  reduction procedure for the inhomogeneous case
437*  and not a degree-ordering
438*/
439static void redLazy (LObject* h,kStrategy strat)
440{
441  if (strat->tl<0)
442  {
443    enterTBba((*h),0,strat);
444    return;
445  }
446
447  int at,d,i;
448  int j = 0;
449  int pass = 0;
450  int reddeg = pFDeg((*h).p);
451
452#ifdef KDEBUG
453  if (TEST_OPT_DEBUG)
454  {
455    PrintS("red:");
456    wrp(h->p);
457    PrintS(" ");
458  }
459#endif
460  loop
461  {
462    if (pDivisibleBy1(strat->S[j],(*h).p))
463    {
464      //if (strat->interpt) test_int_std(strat->kIdeal);
465#ifdef KDEBUG
466      if (TEST_OPT_DEBUG)
467      {
468        Print("\nwith S[%d] ",j);
469        wrp(strat->S[j]);
470      }
471#endif
472      /*- compute the s-polynomial -*/
473      (*h).p = spSpolyRed(strat->S[j],(*h).p,strat->kNoether
474                          , strat->spSpolyLoop);
475      if ((*h).p == NULL)
476      {
477#ifdef KDEBUG
478        if (TEST_OPT_DEBUG) PrintS(" to 0\n");
479#endif
480        if (h->lcm!=NULL) pFree1((*h).lcm);
481#ifdef KDEBUG
482        (*h).lcm=NULL;
483#endif
484        return;
485      }
486#ifdef KDEBUG
487      else if (TEST_OPT_DEBUG)
488      {
489        PrintS("to:");
490        wrp((*h).p);
491        PrintLn();
492      }
493#endif
494      /*- try to reduce the s-polynomial -*/
495      pass++;
496      d = pFDeg((*h).p);
497      if ((strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
498      {
499        at = posInL11(strat->L,strat->Ll,*h,strat);
500        if (at <= strat->Ll)
501        {
502          i=strat->sl+1;
503          do
504          {
505            i--;
506            if (i<0)
507            {
508              enterTBba((*h),strat->tl+1,strat);
509              return;
510            }
511          }
512          while (!pDivisibleBy1(strat->S[i],(*h).p));
513#ifdef KDEBUG
514          if (TEST_OPT_DEBUG) Print(" ->L[%d]\n",at);
515#endif
516          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
517          (*h).p = NULL;
518          return;
519        }
520      }
521      else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d != reddeg))
522      {
523        Print(".%d",d);mflush();
524        reddeg = d;
525      }
526      j = 0;
527    }
528    else
529    {
530      if (j >= strat->sl)
531      {
532#ifdef KDEBUG
533        if (TEST_OPT_DEBUG) PrintLn();
534#endif
535        if (TEST_OPT_INTSTRATEGY)
536        {
537          //pContent(h->p);
538          pCleardenom(h->p);// also does a pContent
539        }
540        enterTBba((*h),strat->tl+1,strat);
541        return;
542      }
543      j++;
544    }
545  }
546}
547
548/*2
549*  reduction procedure for the sugar-strategy (honey)
550* reduces h with elements from T choosing first possible
551* element in T with respect to the given ecart
552*/
553static void redHoney (LObject*  h,kStrategy strat)
554{
555  if (strat->tl<0)
556  {
557    enterTBba((*h),0,strat);
558    return;
559  }
560
561  poly pi;
562  int i,j,at,reddeg,d,pass,ei;
563
564  pass = j = 0;
565  d = reddeg = pFDeg((*h).p)+(*h).ecart;
566#ifdef KDEBUG
567  if (TEST_OPT_DEBUG)
568  {
569    PrintS("red:");
570    wrp((*h).p);
571  }
572#endif
573  loop
574  {
575    if (pDivisibleBy1(strat->T[j].p,(*h).p))
576    {
577#ifdef KDEBUG
578      if (TEST_OPT_DEBUG) Print(" T[%d]",j);
579#endif
580      pi = strat->T[j].p;
581      ei = strat->T[j].ecart;
582      /*
583      * the polynomial to reduce with (up to the moment) is;
584      * pi with ecart ei
585      */
586      i = j;
587      loop
588      {
589        /*- takes the first possible with respect to ecart -*/
590        i++;
591        if (i > strat->tl)
592          break;
593        if ((!BTEST1(20)) && (ei <= (*h).ecart))
594          break;
595        if ((strat->T[i].ecart < ei) && pDivisibleBy1(strat->T[i].p,(*h).p))
596        {
597#ifdef KDEBUG
598          if (TEST_OPT_DEBUG) Print(" T[%d]",i);
599#endif
600          /*
601          * the polynomial to reduce with is now;
602          */
603          pi = strat->T[i].p;
604          ei = strat->T[i].ecart;
605        }
606      }
607
608      /*
609      * end of search: have to reduce with pi
610      */
611      if (ei > (*h).ecart)
612      {
613        /*
614        * It is not possible to reduce h with smaller ecart;
615        * if possible h goes to the lazy-set L,i.e
616        * if its position in L would be not the last one
617        */
618        if (strat->Ll >= 0) /* L is not empty */
619        {
620          at = strat->posInL(strat->L,strat->Ll,*h,strat);
621          if(at <= strat->Ll)
622          /*- h will not become the next element to reduce -*/
623          {
624            enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
625#ifdef KDEBUG
626            if (TEST_OPT_DEBUG) Print(" ecart too big: -> L%d\n",at);
627#endif
628            (*h).p = NULL;
629            return;
630          }
631        }
632        if (TEST_OPT_MOREPAIRS)
633        {
634        /*put the polynomial also in the pair set*/
635          strat->fromT = TRUE;
636          if (!TEST_OPT_INTSTRATEGY) pNorm((*h).p);
637          enterpairs((*h).p,strat->sl,(*h).ecart,0,strat);
638        }
639      }
640#ifdef KDEBUG
641      if (TEST_OPT_DEBUG)
642      {
643        PrintS("\nwith ");
644        wrp(pi);
645      }
646#endif
647      if (strat->fromT)
648      {
649        strat->fromT=FALSE;
650        (*h).p = spSpolyRedNew(pi,(*h).p,strat->kNoether,
651                               strat->spSpolyLoop);
652      }
653      else
654        (*h).p = spSpolyRed(pi,(*h).p,strat->kNoether, strat->spSpolyLoop);
655#ifdef KDEBUG
656      if (TEST_OPT_DEBUG)
657      {
658        PrintS(" to ");
659        wrp((*h).p);
660        PrintLn();
661      }
662#endif
663      if ((*h).p == NULL)
664      {
665        if (h->lcm!=NULL) pFree1((*h).lcm);
666#ifdef KDEBUG
667        (*h).lcm=NULL;
668#endif
669        return;
670      }
671      /* compute the ecart */
672      if (ei <= (*h).ecart)
673        (*h).ecart = d-pFDeg((*h).p);
674      else
675        (*h).ecart = d-pFDeg((*h).p)+ei-(*h).ecart;
676//      if (strat->syzComp)
677//      {
678//        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
679//        {
680#ifdef KDEBUG
681//          if (TEST_OPT_DEBUG)
682#endif
683//            PrintS("  >syzComp\n");
684//          if (TEST_OPT_INTSTRATEGY) pContent(h->p);
685//          at=strat->posInT(strat->T,strat->tl,(*h));
686//          enterTBba((*h),at,strat);
687//          return;
688//        }
689//      }
690      /*
691      * try to reduce the s-polynomial h
692      *test first whether h should go to the lazyset L
693      *-if the degree jumps
694      *-if the number of pre-defined reductions jumps
695      */
696      pass++;
697      d = pFDeg((*h).p)+(*h).ecart;
698      if ((strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
699      {
700        at = strat->posInL(strat->L,strat->Ll,*h,strat);
701        if (at <= strat->Ll)
702        {
703          /*test if h is already standardbasis element*/
704          i=strat->sl+1;
705          do
706          {
707            i--;
708            if (i<0)
709            {
710              at=strat->posInT(strat->T,strat->tl,(*h));
711              enterTBba((*h),at,strat);
712              return;
713            }
714          } while (!pDivisibleBy1(strat->S[i],(*h).p));
715          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
716#ifdef KDEBUG
717          if (TEST_OPT_DEBUG)
718            Print(" degree jumped: -> L%d\n",at);
719#endif
720          (*h).p = NULL;
721          return;
722        }
723      }
724      else if (TEST_OPT_PROT && (strat->Ll < 0) && (d > reddeg))
725      {
726        reddeg = d;
727        Print(".%d",d); mflush();
728      }
729      j = 0;
730    }
731    else
732    {
733      if (j >= strat->tl)
734      {
735#ifdef KDEBUG
736        if (TEST_OPT_DEBUG) PrintLn();
737#endif
738        if (TEST_OPT_INTSTRATEGY)
739        {
740          //pContent(h->p);
741          pCleardenom(h->p);// also does a pContent
742        }
743        at=strat->posInT(strat->T,strat->tl,(*h));
744        enterTBba((*h),at,strat);
745        return;
746      }
747      j++;
748    }
749  }
750}
751
752/*2
753*  reduction procedure for tests only
754*  reduces with elements from T and chooses the best possible
755*/
756static void redBest (LObject*  h,kStrategy strat)
757{
758  if (strat->tl<0)
759  {
760    enterTBba((*h),0,strat);
761    return;
762  }
763
764  int j,jbest,at,reddeg,d,pass;
765  poly     p,ph;
766  pass = j = 0;
767
768  if (strat->honey)
769    reddeg = pFDeg((*h).p)+(*h).ecart;
770  else
771    reddeg = pFDeg((*h).p);
772  loop
773  {
774    if (pDivisibleBy(strat->T[j].p,(*h).p))
775    {
776      //if (strat->interpt) test_int_std(strat->kIdeal);
777      /* compute the s-polynomial */
778      if (!TEST_OPT_INTSTRATEGY) pNorm((*h).p);
779#ifdef SDRING
780      // spSpolyShortBba will not work in the SRING case
781      if (pSDRING)
782      {
783        p=spSpolyCreate(strat->T[j].p,(*h).p,strat->kNoether);
784        if (p!=NULL) pDelete(&pNext(p));
785      }
786      else
787#endif
788      p = spSpolyShortBba(strat->T[j].p,(*h).p);
789      /* computes only the first monomial of the spoly  */
790      if (p)
791      {
792        jbest = j;
793        /* looking for the best possible reduction */
794        if ((strat->syzComp==0) || (pMinComp(p) <= strat->syzComp))
795        {
796          loop
797          {
798            j++;
799            if (j > strat->tl)
800              break;
801            if (pDivisibleBy(strat->T[j].p,(*h).p))
802            {
803#ifdef SDRING
804              // spSpolyShortBba will not work in the SRING case
805              if (pSDRING)
806              {
807                ph=spSpolyCreate(strat->T[j].p,(*h).p,strat->kNoether);
808                if (ph!=NULL) pDelete(&pNext(ph));
809              }
810              else
811#endif
812              ph = spSpolyShortBba(strat->T[j].p,(*h).p);
813              if (ph==NULL)
814              {
815                pFree1(p);
816                pDelete(&((*h).p));
817                if (h->lcm!=NULL) pFree1((*h).lcm);
818#ifdef KDEBUG
819                (*h).lcm=NULL;
820#endif
821                return;
822              }
823              else if (pComp0(ph,p) == -1)
824              {
825                pFree1(p);
826                p = ph;
827                jbest = j;
828              }
829              else
830              {
831                pFree1(ph);
832              }
833            }
834          }
835        }
836        pFree1(p);
837        (*h).p = spSpolyRed(strat->T[jbest].p,(*h).p,strat->kNoether,
838                            strat->spSpolyLoop);
839      }
840      else
841      {
842        if (h->lcm!=NULL) pFree1((*h).lcm);
843#ifdef KDEBUG
844        (*h).lcm=NULL;
845#endif
846        (*h).p = NULL;
847        return;
848      }
849      if (strat->honey && pLexOrder)
850        strat->initEcart(h);
851      /* h.length:=l; */
852      /* try to reduce the s-polynomial */
853//      if (strat->syzComp)
854//      {
855//        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
856//        {
857#ifdef KDEBUG
858//          if (TEST_OPT_DEBUG)
859#endif
860//            PrintS(" >syzComp\n");
861//          if (TEST_OPT_INTSTRATEGY) pContent(h->p);
862//          at=strat->posInT(strat->T,strat->tl,(*h));
863//          enterTBba((*h),at,strat);
864//          return;
865//        }
866//      }
867      if (strat->honey || pLexOrder)
868      {
869        pass++;
870        d = pFDeg((*h).p);
871        if (strat->honey)
872          d += (*h).ecart;
873        if ((strat->Ll >= 0) && ((pass > strat->LazyPass) || (d > reddeg)))
874        {
875          at = strat->posInL(strat->L,strat->Ll,*h,strat);
876          if (at <= strat->Ll)
877          {
878            enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
879            (*h).p = NULL;
880            return;
881          }
882        }
883        else if (TEST_OPT_PROT && (strat->Ll < 0) && (d != reddeg))
884        {
885          reddeg = d;
886          Print("%d.");
887          mflush();
888        }
889      }
890      j = 0;
891    }
892    else
893    {
894      if (j >= strat->tl)
895      {
896        if (TEST_OPT_INTSTRATEGY)
897        {
898          //pContent(h->p);
899          pCleardenom(h->p);// also does a pContent
900        }
901        at=strat->posInT(strat->T,strat->tl,(*h));
902        enterTBba((*h),at,strat);
903        return;
904      }
905      j++;
906    }
907  }
908}
909
910/*2
911*  reduction procedure for the normal form
912*/
913
914static poly redNF (poly h,kStrategy strat)
915{
916  int j = 0;
917  int z = 3;
918
919#ifdef KDEBUG
920 if (TEST_OPT_DEBUG)
921 {
922   PrintS("red:");wrp(h);
923 }
924#endif
925  if (0 > strat->tl)
926  {
927#ifdef KDEBUG
928    if (TEST_OPT_DEBUG) PrintLn();
929#endif
930    return h;
931  }
932  loop
933  {
934    if (pDivisibleBy1(strat->S[j],h))
935    {
936      //if (strat->interpt) test_int_std(strat->kIdeal);
937      /*- compute the s-polynomial -*/
938#ifdef KDEBUG
939      if (TEST_OPT_DEBUG)
940      {
941        Print("\nwith S[%d]:",j);wrp(strat->S[j]);
942      }
943#endif
944      h = spSpolyRed(strat->S[j],h,strat->kNoether, strat->spSpolyLoop);
945#ifdef KDEBUG
946      if (TEST_OPT_DEBUG)
947      {
948        PrintS("\nto:");
949        wrp(h);
950        if (h==NULL) PrintLn();
951      }
952#endif
953      if (h == NULL) return NULL;
954      z++;
955      if (z>=10)
956      {
957        z=0;
958        pNormalize(h);
959      }
960      /*- try to reduce the s-polynomial -*/
961      j = 0;
962    }
963    else
964    {
965      if (j >= strat->sl) return h;
966      j++;
967    }
968  }
969}
970
971void initBba(ideal F,kStrategy strat)
972{
973  int i;
974  idhdl h;
975 /* setting global variables ------------------- */
976  strat->enterS = enterSBba;
977  if ((BTEST1(20)) && (!strat->honey))
978    strat->red = redBest;
979  else if (strat->honey)
980    strat->red = redHoney;
981  else if (pLexOrder && !strat->homog)
982    strat->red = redLazy;
983  else if (TEST_OPT_INTSTRATEGY && strat->homog)
984    strat->red = redHomog0;
985  else
986    strat->red = redHomog;
987  if (TEST_OPT_MINRES && strat->homog && (strat->syzComp >0))
988    strat->red = redSyz;
989
990  if (pLexOrder && strat->honey)
991    strat->initEcart = initEcartNormal;
992  else
993    strat->initEcart = initEcartBBA;
994  if (strat->honey)
995    strat->initEcartPair = initEcartPairMora;
996  else
997    strat->initEcartPair = initEcartPairBba;
998  strat->kIdeal = NULL;
999  //if (strat->ak==0) strat->kIdeal->rtyp=IDEAL_CMD;
1000  //else              strat->kIdeal->rtyp=MODUL_CMD;
1001  //strat->kIdeal->data=(void *)strat->Shdl;
1002  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1003  {
1004    //interred  machen   Aenderung
1005    pFDegOld=pFDeg;
1006    pLDegOld=pLDeg;
1007    h=ggetid("ecart");
1008    if ((h!=NULL) && (IDTYP(h)==INTVEC_CMD))
1009    {
1010      ecartWeights=iv2array(IDINTVEC(h));
1011    }
1012    else
1013    {
1014      ecartWeights=(short *)Alloc((pVariables+1)*sizeof(short));
1015      /*uses automatic computation of the ecartWeights to set them*/
1016      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
1017    }
1018    pFDeg=totaldegreeWecart;
1019    pLDeg=maxdegreeWecart;
1020    for(i=1; i<=pVariables; i++)
1021      Print(" %d",ecartWeights[i]);
1022    PrintLn();
1023    mflush();
1024  }
1025}
1026
1027#ifdef STDTRACE
1028lists bbaLink (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, stdLink stdTrace)
1029{
1030  int oldLl;
1031  int srmax,lrmax;
1032  int olddeg,reduc;
1033  int anzTupel=0, anzNew = 0, anzSkipped=0;
1034#ifdef SDRING
1035  polyset aug=(polyset)Alloc(setmax*sizeof(poly));
1036  int augmax=setmax, augl=-1;
1037  poly oldLcm=NULL;
1038#endif
1039  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1040
1041  if(stdTrace!=NULL) stdTrace->Start(strat);
1042
1043  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1044  initHilbCrit(F,Q,&hilb,strat);
1045  initBba(F,strat);
1046  initBuchMoraPos(strat);
1047  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1048  /*Shdl=*/initBuchMora(F, Q,strat);
1049  if (strat->minim>0)
1050  {
1051    strat->M=idInit(IDELEMS(F),F->rank);
1052  }
1053  srmax = strat->sl;
1054  reduc = olddeg = lrmax = 0;
1055  /* compute------------------------------------------------------- */
1056  while ((stdTrace!=NULL && !stdTrace->CheckEnd(strat)) || (stdTrace == NULL && strat->Ll>=0))
1057    {
1058//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1059      if(stdTrace!=NULL && stdTrace->Receive)
1060        {
1061          stdTrace->ReceiveMsg();
1062          stdTrace->ParseMessage(strat);
1063        }
1064//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1065      if((stdTrace!=NULL && stdTrace->Verwaltung) || (stdTrace == NULL))
1066        {
1067          if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1068#ifdef KDEBUG
1069          if (TEST_OPT_DEBUG) messageSets(strat);
1070#endif
1071          //test_int_std(strat->kIdeal);
1072          if (strat->Ll== 0) strat->interpt=TRUE;
1073          if (TEST_OPT_DEGBOUND
1074              && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p)>Kstd1_deg))
1075                  || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p)>Kstd1_deg))))
1076            {
1077              /*
1078               *stops computation if
1079               * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1080               *a predefined number Kstd1_deg
1081               */
1082              while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1083              break;
1084            }
1085        }
1086//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1087      if((stdTrace!=NULL && stdTrace->TupelL) || (stdTrace == NULL ))
1088        {
1089          /* picks the last element from the lazyset L */
1090          strat->P = strat->L[strat->Ll];
1091          anzTupel++;
1092          strat->Ll--;
1093          if(stdTrace!=NULL && stdTrace->TupelStore)
1094            {
1095              if (TEST_OPT_PROT) PrintS(":");
1096              stdTrace->Store(strat->P);
1097              strat->P.p=NULL;
1098              anzSkipped++;
1099            }
1100        }
1101//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1102      if((stdTrace!=NULL && stdTrace->SPoly) || (stdTrace == NULL))
1103        {
1104          kTest(strat);
1105          if (pNext(strat->P.p) == strat->tail)
1106            {
1107              /* deletes the short spoly and computes */
1108              pFree1(strat->P.p);
1109              /* the real one */
1110              strat->P.p = spSpolyCreate(strat->P.p1,strat->P.p2,strat->kNoether);
1111            }
1112          if((strat->P.p1==NULL) && (strat->minim>0))
1113            strat->P.p2=pCopy(strat->P.p);
1114        }
1115//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1116      if((stdTrace!=NULL && stdTrace->Reduzieren) || (stdTrace == NULL))
1117        {
1118#ifdef SDRING
1119          if (strat->P.p != NULL)
1120#endif
1121            {
1122              if (strat->honey)
1123                {
1124                  if (TEST_OPT_PROT) message(strat->P.ecart+pFDeg(strat->P.p),&olddeg,&reduc,strat);
1125                }
1126              else
1127                {
1128                  if (TEST_OPT_PROT) message(pFDeg(strat->P.p),&olddeg,&reduc,strat);
1129                }
1130              /* reduction of the element choosen from L */
1131              oldLl=strat->Ll;
1132              strat->red(&strat->P,strat);
1133              if(stdTrace!=NULL && stdTrace->TupelPosition)
1134                stdTrace->CheckPosition(strat,oldLl);
1135              if((stdTrace!=NULL && stdTrace->TupelMelden))
1136                stdTrace->SendTupel(strat);
1137              if(stdTrace!=NULL && strat->P.p!=NULL && stdTrace->Modus==ModCheck)
1138                anzNew++;
1139            }
1140          if (strat->P.p != NULL)
1141            {
1142#ifdef SDRING
1143              aug[0]=strat->P.p;
1144              augl=0;
1145              if (pSDRING)
1146          {
1147            oldLcm=strat->P.lcm;
1148#ifdef SRING
1149            if (pSRING) psAug(pCopy(strat->P.p),pOne(),&aug,&augl,&augmax);
1150#endif
1151#ifdef DRING
1152            if (pDRING) pdAug(pCopy(strat->P.p),&aug,&augl,&augmax);
1153#endif
1154#ifdef KDEBUG
1155            if (TEST_OPT_DEBUG)
1156            {
1157              PrintS(" aug of ");
1158              wrp(aug[0]);
1159              PrintLn();
1160              int iiaug=augl;
1161              while (iiaug>=0)
1162              {
1163                Print(" to %d:",iiaug);
1164                wrp(aug[iiaug]);
1165                PrintLn();
1166                iiaug--;
1167              }
1168            }
1169#endif
1170          }
1171              for (augl++;augl != 0;)
1172                {
1173                  strat->P.p=aug[--augl];
1174                  aug[augl]=NULL;
1175                  if (pSDRING)
1176                    {
1177                      if (oldLcm==NULL) strat->P.lcm=NULL;
1178                      else  strat->P.lcm=pCopy1(oldLcm);
1179                    }
1180                  if ((augl!=0)&&(strat->P.p!=NULL))
1181                    strat->red(&strat->P,strat);
1182                  if (strat->P.p != NULL)
1183                    {
1184#endif
1185                      /* statistic */
1186                      if (TEST_OPT_PROT) PrintS("s");
1187                      /* enter P.p into s and L */
1188                      {
1189                        int pos=posInS(strat->S,strat->sl,strat->P.p);
1190#ifdef SDRING
1191                        if ((pSDRING) && (pos<=strat->sl)&& (pComparePolys(strat->P.p,strat->S[pos])))
1192                          {
1193                            if (TEST_OPT_PROT)
1194                              PrintS("d");
1195                          }
1196                        else
1197#endif
1198                          {
1199                            if (TEST_OPT_INTSTRATEGY)
1200                              {
1201                                if ((!TEST_OPT_MINRES)||(strat->syzComp==0)||(!strat->homog))
1202                                  {
1203                                    strat->P.p = redtailBba(strat->P.p,pos-1,strat);
1204                                    pCleardenom(strat->P.p);
1205                                  }
1206                              }
1207                            else
1208                              {
1209                                pNorm(strat->P.p);
1210                                if ((!TEST_OPT_MINRES)||(strat->syzComp==0)||(!strat->homog))
1211                                  {
1212                                    strat->P.p = redtailBba(strat->P.p,pos-1,strat);
1213                                  }
1214                              }
1215#ifdef KDEBUG
1216                            if (TEST_OPT_DEBUG)
1217                              {
1218                                PrintS("new s:");
1219                                wrp(strat->P.p);
1220                                PrintLn();
1221                              }
1222#endif
1223                            if((strat->P.p1==NULL) && (strat->minim>0))
1224                              {
1225                                if (strat->minim==1)
1226                                  {
1227                                    strat->M->m[minimcnt]=pCopy(strat->P.p);
1228                                    pDelete(&strat->P.p2);
1229                                  }
1230                                else
1231                                  {
1232                                    strat->M->m[minimcnt]=strat->P.p2;
1233                                    strat->P.p2=NULL;
1234                                  }
1235                                minimcnt++;
1236                              }
1237                            enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat);
1238                            if (strat->sl==-1) pos=0;
1239                            else pos=posInS(strat->S,strat->sl,strat->P.p);
1240                            strat->enterS(strat->P,pos,strat);
1241                          }
1242                        if (hilb!=NULL)
1243                          {  // xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
1244                            oldLl=strat->Ll;
1245                            khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1246                            if(stdTrace!=NULL)
1247                              stdTrace->CheckHilb(strat,oldLl);
1248                          }
1249                      }
1250                      if (strat->P.lcm!=NULL) pFree1(strat->P.lcm);
1251#ifdef SDRING
1252                    }
1253                }
1254              /* delete the old pair */
1255              if (pSDRING &&(oldLcm!=NULL)) pFree1(oldLcm);
1256#endif
1257              if (strat->sl>srmax) srmax = strat->sl;
1258            }
1259          if(stdTrace!=NULL && stdTrace->TupelTesten)
1260            stdTrace->TupelDifferent(strat);
1261        }
1262#ifdef KDEBUG
1263      strat->P.lcm=NULL;
1264#endif
1265      kTest(strat);
1266    }
1267  if(stdTrace !=NULL)
1268    if(TEST_OPT_PROT)
1269      {
1270        Print("\n(Tupel  Skipped  New) = (%i  %i  %i)\n",anzTupel, anzSkipped, anzNew);
1271      }
1272  if((stdTrace!=NULL && stdTrace->ResultSend) || (stdTrace == NULL))
1273    {
1274#ifdef KDEBUG
1275      if (TEST_OPT_DEBUG) messageSets(strat);
1276#endif
1277      /* complete reduction of the standard basis--------- */
1278      if (TEST_OPT_REDSB) completeReduce(strat);
1279      /* release temp data-------------------------------- */
1280      exitBuchMora(strat);
1281      if (TEST_OPT_WEIGHTM)
1282        {
1283          pFDeg=pFDegOld;
1284          pLDeg=pLDegOld;
1285          if (ecartWeights)
1286            {
1287              Free((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1288              ecartWeights=NULL;
1289            }
1290        }
1291#ifdef SDRING
1292      Free((ADDRESS)aug,augmax*sizeof(poly));
1293#endif
1294      if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1295      if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1296    }
1297  if(stdTrace!=NULL)
1298    stdTrace->End(strat);
1299  lists l=(lists)Alloc(sizeof(slists));
1300  l->Init(2);
1301  l->m[0].rtyp = IDEAL_CMD;
1302  l->m[0].data = (void *) strat->Shdl;
1303   if(stdTrace!=NULL )
1304     {
1305       l->m[1].rtyp = LIST_CMD;
1306       l->m[1].data = (void *)stdTrace->RestTupel();
1307     }
1308  return (l);
1309}
1310
1311#else
1312
1313ideal bba (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
1314{
1315  int   srmax,lrmax;
1316  int   olddeg,reduc;
1317#ifdef SDRING
1318  polyset aug=(polyset)Alloc(setmax*sizeof(poly));
1319  int augmax=setmax, augl=-1;
1320  poly oldLcm=NULL;
1321#endif
1322  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1323
1324  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1325  initHilbCrit(F,Q,&hilb,strat);
1326  initBba(F,strat);
1327  initBuchMoraPos(strat);
1328  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1329  /*Shdl=*/initBuchMora(F, Q,strat);
1330  if (strat->minim>0)
1331  {
1332    strat->M=idInit(IDELEMS(F),F->rank);
1333  }
1334  srmax = strat->sl;
1335  reduc = olddeg = lrmax = 0;
1336  /* compute------------------------------------------------------- */
1337  while (strat->Ll >= 0)
1338  {
1339    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1340#ifdef KDEBUG
1341    if (TEST_OPT_DEBUG) messageSets(strat);
1342#endif
1343    //test_int_std(strat->kIdeal);
1344    if (strat->Ll== 0) strat->interpt=TRUE;
1345    if (TEST_OPT_DEGBOUND
1346    && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p)>Kstd1_deg))
1347       || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p)>Kstd1_deg))))
1348    {
1349      /*
1350      *stops computation if
1351      * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1352      *a predefined number Kstd1_deg
1353      */
1354      while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1355      break;
1356    }
1357    /* picks the last element from the lazyset L */
1358    strat->P = strat->L[strat->Ll];
1359    strat->Ll--;
1360    kTest(strat);
1361    if (pNext(strat->P.p) == strat->tail)
1362    {
1363      /* deletes the short spoly and computes */
1364      pFree1(strat->P.p);
1365      /* the real one */
1366      strat->P.p = spSpolyCreate(strat->P.p1,strat->P.p2,strat->kNoether);
1367    }
1368    kTest(strat);
1369    if((strat->P.p1==NULL) && (strat->minim>0))
1370      strat->P.p2=pCopy(strat->P.p);
1371#ifdef SDRING
1372    if (strat->P.p != NULL)
1373#endif
1374    {
1375      if (strat->honey)
1376      {
1377        if (TEST_OPT_PROT) message(strat->P.ecart+pFDeg(strat->P.p),&olddeg,&reduc,strat);
1378      }
1379      else
1380      {
1381        if (TEST_OPT_PROT) message(pFDeg(strat->P.p),&olddeg,&reduc,strat);
1382      }
1383      kTest(strat);
1384      /* reduction of the element choosen from L */
1385      strat->red(&strat->P,strat);
1386      pTest(strat->P.p);
1387    }
1388    kTest(strat);
1389    if (strat->P.p != NULL)
1390    {
1391#ifdef SDRING
1392      aug[0]=strat->P.p;
1393      augl=0;
1394      if (pSDRING)
1395      {
1396        oldLcm=strat->P.lcm;
1397#ifdef SRING
1398        if (pSRING) psAug(pCopy(strat->P.p),pOne(),&aug,&augl,&augmax);
1399#endif
1400#ifdef DRING
1401        if (pDRING) pdAug(pCopy(strat->P.p),&aug,&augl,&augmax);
1402#endif
1403#ifdef KDEBUG
1404        if (TEST_OPT_DEBUG)
1405        {
1406          PrintS(" aug of ");
1407          wrp(aug[0]);
1408          PrintLn();
1409          int iiaug=augl;
1410          while (iiaug>=0)
1411          {
1412            Print(" to %d:",iiaug);
1413            wrp(aug[iiaug]);
1414            PrintLn();
1415            iiaug--;
1416          }
1417        }
1418#endif
1419      }
1420      for (augl++;augl != 0;)
1421      {
1422        strat->P.p=aug[--augl];
1423        aug[augl]=NULL;
1424        if (pSDRING)
1425        {
1426          if (oldLcm==NULL) strat->P.lcm=NULL;
1427          else  strat->P.lcm=pCopy1(oldLcm);
1428        }
1429        if ((augl!=0)&&(strat->P.p!=NULL))
1430          strat->red(&strat->P,strat);
1431        if (strat->P.p != NULL)
1432        {
1433#endif
1434          /* statistic */
1435          if (TEST_OPT_PROT) PrintS("s");
1436          /* enter P.p into s and L */
1437          {
1438            int pos=posInS(strat->S,strat->sl,strat->P.p);
1439#ifdef SDRING
1440            if ((pSDRING) && (pos<=strat->sl)&& (pComparePolys(strat->P.p,strat->S[pos])))
1441            {
1442              if (TEST_OPT_PROT)
1443                PrintS("d");
1444            }
1445            else
1446#endif
1447            {
1448              if (TEST_OPT_INTSTRATEGY)
1449              {
1450                if ((!TEST_OPT_MINRES)||(strat->syzComp==0)||(!strat->homog))
1451                {
1452                  strat->P.p = redtailBba(strat->P.p,pos-1,strat);
1453                  pCleardenom(strat->P.p);
1454                }
1455              }
1456              else
1457              {
1458                pNorm(strat->P.p);
1459                if ((!TEST_OPT_MINRES)||(strat->syzComp==0)||(!strat->homog))
1460                {
1461                  strat->P.p = redtailBba(strat->P.p,pos-1,strat);
1462                }
1463              }
1464#ifdef KDEBUG
1465              if (TEST_OPT_DEBUG)
1466              {
1467                PrintS("new s:");
1468                wrp(strat->P.p);
1469                PrintLn();
1470              }
1471#endif
1472              if((strat->P.p1==NULL) && (strat->minim>0))
1473              {
1474                if (strat->minim==1)
1475                {
1476                  strat->M->m[minimcnt]=pCopy(strat->P.p);
1477                  pDelete(&strat->P.p2);
1478                }
1479                else
1480                {
1481                  strat->M->m[minimcnt]=strat->P.p2;
1482                  strat->P.p2=NULL;
1483                }
1484                minimcnt++;
1485              }
1486              enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat);
1487              if (strat->sl==-1) pos=0;
1488              else pos=posInS(strat->S,strat->sl,strat->P.p);
1489              strat->enterS(strat->P,pos,strat);
1490            }
1491            if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1492          }
1493          if (strat->P.lcm!=NULL) pFree1(strat->P.lcm);
1494#ifdef SDRING
1495        }
1496      }
1497      /* delete the old pair */
1498      if (pSDRING &&(oldLcm!=NULL)) pFree1(oldLcm);
1499#endif
1500      if (strat->sl>srmax) srmax = strat->sl;
1501    }
1502#ifdef KDEBUG
1503    strat->P.lcm=NULL;
1504#endif
1505    kTest(strat);
1506  }
1507#ifdef KDEBUG
1508  if (TEST_OPT_DEBUG) messageSets(strat);
1509#endif
1510  /* complete reduction of the standard basis--------- */
1511  if (TEST_OPT_REDSB) completeReduce(strat);
1512  /* release temp data-------------------------------- */
1513  exitBuchMora(strat);
1514  if (TEST_OPT_WEIGHTM)
1515  {
1516    pFDeg=pFDegOld;
1517    pLDeg=pLDegOld;
1518    if (ecartWeights)
1519    {
1520      Free((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1521      ecartWeights=NULL;
1522    }
1523  }
1524#ifdef SDRING
1525  Free((ADDRESS)aug,augmax*sizeof(poly));
1526#endif
1527  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1528  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1529  return (strat->Shdl);
1530}
1531#endif
1532
1533poly kNF2 (ideal F,ideal Q,poly q,kStrategy strat, int lazyReduce)
1534{
1535  poly   p;
1536  int   i;
1537
1538  if ((idIs0(F))&&(Q==NULL))
1539    return pCopy(q); /*F=0*/
1540  strat->ak = idRankFreeModule(F);
1541  /*- creating temp data structures------------------- -*/
1542  BITSET save_test=test;
1543  test|=Sy_bit(OPT_REDTAIL);
1544  initBuchMoraCrit(strat);
1545  strat->initEcart = initEcartBBA;
1546  strat->enterS = enterSBba;
1547  /*- set S -*/
1548  strat->sl = -1;
1549#ifdef COMP_FAST
1550  strat->spSpolyLoop = spGetSpolyLoop(currRing, strat);
1551#endif
1552  /*- init local data struct.---------------------------------------- -*/
1553  /*Shdl=*/initS(F,Q,strat);
1554  /*- compute------------------------------------------------------- -*/
1555  if ((TEST_OPT_INTSTRATEGY)&&(lazyReduce==0))
1556  {
1557    for (i=strat->sl;i>=0;i--)
1558      pNorm(strat->S[i]);
1559  }
1560  kTest(strat);
1561  p = redNF(pCopy(q),strat);
1562  kTest(strat);
1563  if ((p!=NULL)&&(lazyReduce==0))
1564  {
1565    p = redtailBba(p,strat->sl,strat);
1566  }
1567  kTest(strat);
1568  /*- release temp data------------------------------- -*/
1569  Free((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
1570  idDelete(&strat->Shdl);
1571  test=save_test;
1572  return p;
1573}
1574
1575ideal kNF2 (ideal F,ideal Q,ideal q,kStrategy strat, int lazyReduce)
1576{
1577  poly   p;
1578  int   i;
1579  ideal res;
1580
1581  if (idIs0(q))
1582    return idInit(1,q->rank);
1583  if ((idIs0(F))&&(Q==NULL))
1584    return idCopy(q); /*F=0*/
1585  strat->ak = idRankFreeModule(F);
1586  /*- creating temp data structures------------------- -*/
1587  BITSET save_test=test;
1588  test|=Sy_bit(OPT_REDTAIL);
1589  initBuchMoraCrit(strat);
1590  strat->initEcart = initEcartBBA;
1591  strat->enterS = enterSBba;
1592  /*- set S -*/
1593  strat->sl = -1;
1594#ifdef COMP_FAST
1595  strat->spSpolyLoop = spGetSpolyLoop(currRing, strat);
1596#endif
1597  /*- init local data struct.---------------------------------------- -*/
1598  /*Shdl=*/initS(F,Q,strat);
1599  /*- compute------------------------------------------------------- -*/
1600  res=idInit(IDELEMS(q),q->rank);
1601  if ((TEST_OPT_INTSTRATEGY)&&(lazyReduce==0))
1602  {
1603    for (i=strat->sl;i>=0;i--)
1604      pNorm(strat->S[i]);
1605  }
1606  for (i=IDELEMS(q)-1; i>=0; i--)
1607  {
1608    if (q->m[i]!=NULL)
1609    {
1610      p = redNF(pCopy(q->m[i]),strat);
1611      if ((p!=NULL)&&(lazyReduce==0))
1612      {
1613        p = redtailBba(p,strat->sl,strat);
1614      }
1615      res->m[i]=p;
1616    }
1617    //else
1618    //  res->m[i]=NULL;
1619    if (TEST_OPT_PROT)
1620    {
1621      PrintS("-");mflush();
1622    }
1623  }
1624  /*- release temp data------------------------------- -*/
1625  Free((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
1626  idDelete(&strat->Shdl);
1627  test=save_test;
1628  return res;
1629}
1630
1631static ideal bbared (ideal F, ideal Q,kStrategy strat)
1632{
1633
1634  /* complete reduction of the standard basis--------- */
1635  completeReduce(strat);
1636  /* release temp data-------------------------------- */
1637  exitBuchMora(strat);
1638  if (TEST_OPT_WEIGHTM)
1639  {
1640    pFDeg=pFDegOld;
1641    pLDeg=pLDegOld;
1642    if (ecartWeights)
1643    {
1644      Free((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1645      ecartWeights=NULL;
1646    }
1647  }
1648  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1649  return (strat->Shdl);
1650}
1651
1652ideal stdred(ideal F, ideal Q, tHomog h,intvec ** w)
1653{
1654  ideal r;
1655  BOOLEAN b=pLexOrder,toReset=FALSE;
1656  BOOLEAN delete_w=(w==NULL);
1657  kStrategy strat=(kStrategy)Alloc0(sizeof(skStrategy));
1658
1659  if (currRing->ch==0) strat->LazyPass=2;
1660  else                 strat->LazyPass=20;
1661  strat->LazyDegree = 1;
1662  if ((h==testHomog))
1663  {
1664    if (idRankFreeModule(F)==0)
1665    {
1666      h = (tHomog)idHomIdeal(F,Q);
1667      w=NULL;
1668    }
1669    else
1670      h = (tHomog)idHomModule(F,Q,w);
1671  }
1672  if (h==isHomog)
1673  {
1674    if ((w!=NULL) && (*w!=NULL))
1675    {
1676      kModW = *w;
1677      pOldFDeg = pFDeg;
1678      pFDeg = kModDeg;
1679      toReset = TRUE;
1680    }
1681    pLexOrder = TRUE;
1682    strat->LazyPass*=2;
1683  }
1684  strat->homog=h;
1685  spSet(currRing);
1686#ifdef COMP_FAST
1687  strat->spSpolyLoop = spGetSpolyLoop(currRing, strat);
1688#endif
1689  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1690  initBuchMoraPos(strat);
1691  if (pOrdSgn==1)
1692    initBba(F,strat);
1693  else
1694    initMora(F,strat);
1695  initBuchMora(F, Q,strat);
1696  //initS(F,Q,strat);
1697// Ende der Initalisierung
1698  r=bbared(F,Q,strat);
1699#ifdef KDEBUG
1700  int i;
1701  for (i=0; i<IDELEMS(r); i++) pTest(r->m[i]);
1702#endif
1703// Ende: aufraeumen
1704  if (toReset)
1705  {
1706    kModW = NULL;
1707    pFDeg = pOldFDeg;
1708  }
1709  pLexOrder = b;
1710  Free((ADDRESS)strat,sizeof(skStrategy));
1711  if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
1712  idSkipZeroes(r);
1713  return r;
1714}
Note: See TracBrowser for help on using the repository browser.