source: git/Singular/kstd2.cc @ 12310e

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