source: git/Singular/kstd2.cc @ 743c32

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