source: git/kernel/kstd2.cc @ b1dfaf

spielwiese
Last change on this file since b1dfaf was b1dfaf, checked in by Frank Seelisch <seelisch@…>, 14 years ago
patch from Kai (checked for problems under Windows OS: no problems) git-svn-id: file:///usr/local/Singular/svn/trunk@13210 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 50.5 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id$ */
5/*
6*  ABSTRACT -  Kernel: alg. of Buchberger
7*/
8
9// #define PDEBUG 2
10
11// TODO: why the following is here instead of mod2.h???
12
13// define to enable tailRings
14#define HAVE_TAIL_RING
15
16#include <kernel/mod2.h>
17
18#ifndef NDEBUG
19# define MYTEST 0
20#else /* ifndef NDEBUG */
21# define MYTEST 0
22#endif /* ifndef NDEBUG */
23
24#if MYTEST
25# ifdef HAVE_TAIL_RING
26#  undef HAVE_TAIL_RING
27# endif // ifdef HAVE_TAIL_RING
28#endif
29
30// define if no buckets should be used
31// #define NO_BUCKETS
32
33#ifdef HAVE_PLURAL
34#define PLURAL_INTERNAL_DECLARATIONS 1
35#endif
36#include <kernel/kutil.h>
37#include <kernel/options.h>
38#include <omalloc/omalloc.h>
39#include <kernel/polys.h>
40#include <kernel/ideals.h>
41#include <kernel/febase.h>
42#include <kernel/kstd1.h>
43#include <kernel/khstd.h>
44#include <kernel/kbuckets.h>
45//#include "cntrlc.h"
46#include <kernel/weight.h>
47#include <kernel/intvec.h>
48#ifdef HAVE_PLURAL
49#include <kernel/gring.h>
50#endif
51// #include "timer.h"
52
53/* shiftgb stuff */
54#include <kernel/shiftgb.h>
55
56  int (*test_PosInT)(const TSet T,const int tl,LObject &h);
57  int (*test_PosInL)(const LSet set, const int length,
58                LObject* L,const kStrategy strat);
59
60// return -1 if no divisor is found
61//        number of first divisor, otherwise
62int kFindDivisibleByInT(const TSet &T, const unsigned long* sevT,
63                        const int tl, const LObject* L, const int start)
64{
65  unsigned long not_sev = ~L->sev;
66  int j = start;
67  poly p=L->p;
68  ring r=currRing;
69  if (p==NULL)  { r=L->tailRing; p=L->t_p; }
70  L->GetLm(p, r);
71
72  pAssume(~not_sev == p_GetShortExpVector(p, r));
73
74  if (r == currRing)
75  {
76    loop
77    {
78      if (j > tl) return -1;
79#if defined(PDEBUG) || defined(PDIV_DEBUG)
80      if (p_LmShortDivisibleBy(T[j].p, sevT[j],
81                               p, not_sev, r))
82        return j;
83#else
84      if (!(sevT[j] & not_sev) &&
85          p_LmDivisibleBy(T[j].p, p, r))
86        return j;
87#endif
88      j++;
89    }
90  }
91  else
92  {
93    loop
94    {
95      if (j > tl) return -1;
96#if defined(PDEBUG) || defined(PDIV_DEBUG)
97      if (p_LmShortDivisibleBy(T[j].t_p, sevT[j],
98                               p, not_sev, r))
99        return j;
100#else
101      if (!(sevT[j] & not_sev) &&
102          p_LmDivisibleBy(T[j].t_p, p, r))
103        return j;
104#endif
105      j++;
106    }
107  }
108}
109
110// same as above, only with set S
111int kFindDivisibleByInS(const kStrategy strat, int* max_ind, LObject* L)
112{
113  unsigned long not_sev = ~L->sev;
114  poly p = L->GetLmCurrRing();
115  int j = 0;
116
117  pAssume(~not_sev == p_GetShortExpVector(p, currRing));
118#if 1
119  int ende;
120  if ((strat->ak>0) || pLexOrder) ende=strat->sl;
121  else ende=posInS(strat,*max_ind,p,0)+1;
122  if (ende>(*max_ind)) ende=(*max_ind);
123#else
124  int ende=strat->sl;
125#endif
126  (*max_ind)=ende;
127  loop
128  {
129    if (j > ende) return -1;
130#if defined(PDEBUG) || defined(PDIV_DEBUG)
131    if (p_LmShortDivisibleBy(strat->S[j], strat->sevS[j],
132                             p, not_sev, currRing))
133        return j;
134#else
135    if ( !(strat->sevS[j] & not_sev) &&
136         p_LmDivisibleBy(strat->S[j], p, currRing))
137      return j;
138#endif
139    j++;
140  }
141}
142
143int kFindNextDivisibleByInS(const kStrategy strat, int start,int max_ind, LObject* L)
144{
145  unsigned long not_sev = ~L->sev;
146  poly p = L->GetLmCurrRing();
147  int j = start;
148
149  pAssume(~not_sev == p_GetShortExpVector(p, currRing));
150#if 1
151  int ende=max_ind;
152#else
153  int ende=strat->sl;
154#endif
155  loop
156  {
157    if (j > ende) return -1;
158#if defined(PDEBUG) || defined(PDIV_DEBUG)
159    if (p_LmShortDivisibleBy(strat->S[j], strat->sevS[j],
160                             p, not_sev, currRing))
161        return j;
162#else
163    if ( !(strat->sevS[j] & not_sev) &&
164         p_LmDivisibleBy(strat->S[j], p, currRing))
165      return j;
166#endif
167    j++;
168  }
169}
170
171#ifdef HAVE_RINGS
172static NATNUMBER factorial(NATNUMBER arg)
173{
174   NATNUMBER tmp = 1; arg++;
175   for (int i = 2; i < arg; i++)
176   {
177     tmp *= i;
178   }
179   return tmp;
180}
181
182poly kFindZeroPoly(poly input_p, ring leadRing, ring tailRing)
183{
184  // m = currRing->ch
185
186  if (input_p == NULL) return NULL;
187
188  poly p = input_p;
189  poly zeroPoly = NULL;
190  NATNUMBER a = (NATNUMBER) pGetCoeff(p);
191
192  int k_ind2 = 0;
193  int a_ind2 = ind2(a);
194
195  NATNUMBER k = 1;
196  // of interest is only k_ind2, special routine for improvement ... TODO OLIVER
197  for (int i = 1; i <= leadRing->N; i++)
198  {
199    k_ind2 = k_ind2 + ind_fact_2(p_GetExp(p, i, leadRing));
200  }
201
202  a = (NATNUMBER) pGetCoeff(p);
203
204  number tmp1;
205  poly tmp2, tmp3;
206  poly lead_mult = p_ISet(1, tailRing);
207  if (leadRing->ch <= k_ind2 + a_ind2)
208  {
209    int too_much = k_ind2 + a_ind2 - leadRing->ch;
210    int s_exp;
211    zeroPoly = p_ISet(a, tailRing);
212    for (int i = 1; i <= leadRing->N; i++)
213    {
214      s_exp = p_GetExp(p, i,leadRing);
215      if (s_exp % 2 != 0)
216      {
217        s_exp = s_exp - 1;
218      }
219      while ( (0 < ind2(s_exp)) && (ind2(s_exp) <= too_much) )
220      {
221        too_much = too_much - ind2(s_exp);
222        s_exp = s_exp - 2;
223      }
224      p_SetExp(lead_mult, i, p_GetExp(p, i,leadRing) - s_exp, tailRing);
225      for (NATNUMBER j = 1; j <= s_exp; j++)
226      {
227        tmp1 = nInit(j);
228        tmp2 = p_ISet(1, tailRing);
229        p_SetExp(tmp2, i, 1, tailRing);
230        p_Setm(tmp2, tailRing);
231        if (nIsZero(tmp1))
232        { // should nowbe obsolet, test ! TODO OLIVER
233          zeroPoly = p_Mult_q(zeroPoly, tmp2, tailRing);
234        }
235        else
236        {
237          tmp3 = p_NSet(nCopy(tmp1), tailRing);
238          zeroPoly = p_Mult_q(zeroPoly, p_Add_q(tmp3, tmp2, tailRing), tailRing);
239        }
240      }
241    }
242    p_Setm(lead_mult, tailRing);
243    zeroPoly = p_Mult_mm(zeroPoly, lead_mult, tailRing);
244    tmp2 = p_NSet(nCopy(pGetCoeff(zeroPoly)), leadRing);
245    for (int i = 1; i <= leadRing->N; i++)
246    {
247      pSetExp(tmp2, i, p_GetExp(zeroPoly, i, tailRing));
248    }
249    p_Setm(tmp2, leadRing);
250    zeroPoly = p_LmDeleteAndNext(zeroPoly, tailRing);
251    pNext(tmp2) = zeroPoly;
252    return tmp2;
253  }
254/*  NATNUMBER alpha_k = twoPow(leadRing->ch - k_ind2);
255  if (1 == 0 && alpha_k <= a)
256  {  // Temporarly disabled, reducing coefficients not compatible with std TODO Oliver
257    zeroPoly = p_ISet((a / alpha_k)*alpha_k, tailRing);
258    for (int i = 1; i <= leadRing->N; i++)
259    {
260      for (NATNUMBER j = 1; j <= p_GetExp(p, i, leadRing); j++)
261      {
262        tmp1 = nInit(j);
263        tmp2 = p_ISet(1, tailRing);
264        p_SetExp(tmp2, i, 1, tailRing);
265        p_Setm(tmp2, tailRing);
266        if (nIsZero(tmp1))
267        {
268          zeroPoly = p_Mult_q(zeroPoly, tmp2, tailRing);
269        }
270        else
271        {
272          tmp3 = p_ISet((NATNUMBER) tmp1, tailRing);
273          zeroPoly = p_Mult_q(zeroPoly, p_Add_q(tmp2, tmp3, tailRing), tailRing);
274        }
275      }
276    }
277    tmp2 = p_ISet((NATNUMBER) pGetCoeff(zeroPoly), leadRing);
278    for (int i = 1; i <= leadRing->N; i++)
279    {
280      pSetExp(tmp2, i, p_GetExp(zeroPoly, i, tailRing));
281    }
282    p_Setm(tmp2, leadRing);
283    zeroPoly = p_LmDeleteAndNext(zeroPoly, tailRing);
284    pNext(tmp2) = zeroPoly;
285    return tmp2;
286  } */
287  return NULL;
288}
289
290poly kFindDivisibleByZeroPoly(LObject* h)
291{
292  return kFindZeroPoly(h->GetLmCurrRing(), currRing, h->tailRing);
293}
294#endif
295
296
297#ifdef HAVE_RINGS
298/*2
299*  reduction procedure for the ring Z/2^m
300*/
301int redRing (LObject* h,kStrategy strat)
302{
303  if (h->IsNull()) return 0; // spoly is zero (can only occure with zero divisors)
304  if (strat->tl<0) return 1;
305
306  int at,i;
307  long d;
308  int j = 0;
309  int pass = 0;
310  poly zeroPoly = NULL;
311
312// TODO warum SetpFDeg notwendig?
313  h->SetpFDeg();
314  assume(h->pFDeg() == h->FDeg);
315  long reddeg = h->GetpFDeg();
316
317  h->SetShortExpVector();
318  loop
319  {
320    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
321    if (j < 0) return 1;
322
323    ksReducePoly(h, &(strat->T[j]), NULL, NULL, strat); // with debug output
324
325    if (h->GetLmTailRing() == NULL)
326    {
327      if (h->lcm!=NULL) pLmDelete(h->lcm);
328#ifdef KDEBUG
329      h->lcm=NULL;
330#endif
331      h->Clear();
332      return 0;
333    }
334    h->SetShortExpVector();
335    d = h->SetpFDeg();
336    /*- try to reduce the s-polynomial -*/
337    pass++;
338    if (!TEST_OPT_REDTHROUGH &&
339        (strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
340    {
341      h->SetLmCurrRing();
342      if (strat->posInLDependsOnLength)
343        h->SetLength(strat->length_pLength);
344      at = strat->posInL(strat->L,strat->Ll,h,strat);
345      if (at <= strat->Ll)
346      {
347#ifdef KDEBUG
348        if (TEST_OPT_DEBUG) Print(" ->L[%d]\n",at);
349#endif
350        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);     // NOT RING CHECKED OLIVER
351        h->Clear();
352        return -1;
353      }
354    }
355    if (d != reddeg)
356    {
357      if (d >= strat->tailRing->bitmask)
358      {
359        if (h->pTotalDeg() >= strat->tailRing->bitmask)
360        {
361          strat->overflow=TRUE;
362          //Print("OVERFLOW in redRing d=%ld, max=%ld\n",d,strat->tailRing->bitmask);
363          h->GetP();
364          at = strat->posInL(strat->L,strat->Ll,h,strat);
365          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
366          h->Clear();
367          return -1;
368        }
369      }
370      else if ((TEST_OPT_PROT) && (strat->Ll < 0))
371      {
372        Print(".%ld",d);mflush();
373        reddeg = d;
374      }
375    }
376  }
377}
378#endif
379
380/*2
381*  reduction procedure for the homogeneous case
382*  and the case of a degree-ordering
383*/
384int redHomog (LObject* h,kStrategy strat)
385{
386  if (strat->tl<0) return 1;
387  //if (h->GetLmTailRing()==NULL) return 0; // HS: SHOULD NOT BE NEEDED!
388  assume(h->FDeg == h->pFDeg());
389
390  poly h_p;
391  int i,j,at,pass, ii;
392  unsigned long not_sev;
393  long reddeg,d;
394
395  pass = j = 0;
396  d = reddeg = h->GetpFDeg();
397  h->SetShortExpVector();
398  int li;
399  h_p = h->GetLmTailRing();
400  not_sev = ~ h->sev;
401  loop
402  {
403    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
404    if (j < 0) return 1;
405
406    li = strat->T[j].pLength;
407    ii = j;
408    /*
409     * the polynomial to reduce with (up to the moment) is;
410     * pi with length li
411     */
412    i = j;
413#if 1
414    if (TEST_OPT_LENGTH)
415    loop
416    {
417      /*- search the shortest possible with respect to length -*/
418      i++;
419      if (i > strat->tl)
420        break;
421      if (li<=1)
422        break;
423      if ((strat->T[i].pLength < li)
424         &&
425          p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i],
426                               h_p, not_sev, strat->tailRing))
427      {
428        /*
429         * the polynomial to reduce with is now;
430         */
431        li = strat->T[i].pLength;
432        ii = i;
433      }
434    }
435#endif
436
437    /*
438     * end of search: have to reduce with pi
439     */
440#ifdef KDEBUG
441    if (TEST_OPT_DEBUG)
442    {
443      PrintS("red:");
444      h->wrp();
445      PrintS(" with ");
446      strat->T[ii].wrp();
447    }
448#endif
449    assume(strat->fromT == FALSE);
450
451    ksReducePoly(h, &(strat->T[ii]), NULL, NULL, strat);
452
453#ifdef KDEBUG
454    if (TEST_OPT_DEBUG)
455    {
456      PrintS("\nto ");
457      h->wrp();
458      PrintLn();
459    }
460#endif
461
462    h_p = h->GetLmTailRing();
463    if (h_p == NULL)
464    {
465      if (h->lcm!=NULL) pLmFree(h->lcm);
466#ifdef KDEBUG
467      h->lcm=NULL;
468#endif
469      return 0;
470    }
471    h->SetShortExpVector();
472    not_sev = ~ h->sev;
473    /*
474     * try to reduce the s-polynomial h
475     *test first whether h should go to the lazyset L
476     *-if the degree jumps
477     *-if the number of pre-defined reductions jumps
478     */
479    pass++;
480    if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0) && (pass > strat->LazyPass))
481    {
482      h->SetLmCurrRing();
483      at = strat->posInL(strat->L,strat->Ll,h,strat);
484      if (at <= strat->Ll)
485      {
486        int dummy=strat->sl;
487        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
488          return 1;
489        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
490#ifdef KDEBUG
491        if (TEST_OPT_DEBUG)
492          Print(" lazy: -> L%d\n",at);
493#endif
494        h->Clear();
495        return -1;
496      }
497    }
498  }
499}
500
501/*2
502*  reduction procedure for the inhomogeneous case
503*  and not a degree-ordering
504*/
505int redLazy (LObject* h,kStrategy strat)
506{
507  if (strat->tl<0) return 1;
508  int at,i,ii,li;
509  int j = 0;
510  int pass = 0;
511  assume(h->pFDeg() == h->FDeg);
512  long reddeg = h->GetpFDeg();
513  long d;
514  unsigned long not_sev;
515
516  h->SetShortExpVector();
517  poly h_p = h->GetLmTailRing();
518  not_sev = ~ h->sev;
519  loop
520  {
521    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
522    if (j < 0) return 1;
523
524    li = strat->T[j].pLength;
525    #if 0
526    if (li==0)
527    {
528      li=strat->T[j].pLength=pLength(strat->T[j].p);
529    }
530    #endif
531    ii = j;
532    /*
533     * the polynomial to reduce with (up to the moment) is;
534     * pi with length li
535     */
536
537    i = j;
538#if 1
539    if (TEST_OPT_LENGTH)
540    loop
541    {
542      /*- search the shortest possible with respect to length -*/
543      i++;
544      if (i > strat->tl)
545        break;
546      if (li<=1)
547        break;
548    #if 0
549      if (strat->T[i].pLength==0)
550      {
551        PrintS("!");
552        strat->T[i].pLength=pLength(strat->T[i].p);
553      }
554   #endif
555      if ((strat->T[i].pLength < li)
556         &&
557          p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i],
558                               h_p, not_sev, strat->tailRing))
559      {
560        /*
561         * the polynomial to reduce with is now;
562         */
563        PrintS("+");
564        li = strat->T[i].pLength;
565        ii = i;
566      }
567    }
568#endif
569
570    /*
571     * end of search: have to reduce with pi
572     */
573
574
575#ifdef KDEBUG
576    if (TEST_OPT_DEBUG)
577    {
578      PrintS("red:");
579      h->wrp();
580      PrintS(" with ");
581      strat->T[ii].wrp();
582    }
583#endif
584
585    ksReducePoly(h, &(strat->T[ii]), NULL, NULL, strat);
586
587#ifdef KDEBUG
588    if (TEST_OPT_DEBUG)
589    {
590      PrintS("\nto ");
591      h->wrp();
592      PrintLn();
593    }
594#endif
595
596    h_p=h->GetLmTailRing();
597
598    if (h_p == NULL)
599    {
600      if (h->lcm!=NULL) pLmFree(h->lcm);
601#ifdef KDEBUG
602      h->lcm=NULL;
603#endif
604      return 0;
605    }
606    h->SetShortExpVector();
607    not_sev = ~ h->sev;
608    d = h->SetpFDeg();
609    /*- try to reduce the s-polynomial -*/
610    pass++;
611    if (//!TEST_OPT_REDTHROUGH &&
612        (strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
613    {
614      h->SetLmCurrRing();
615      at = strat->posInL(strat->L,strat->Ll,h,strat);
616      if (at <= strat->Ll)
617      {
618#if 1
619        int dummy=strat->sl;
620        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
621          return 1;
622#endif
623#ifdef KDEBUG
624        if (TEST_OPT_DEBUG) Print(" ->L[%d]\n",at);
625#endif
626        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
627        h->Clear();
628        return -1;
629      }
630    }
631    else if (d != reddeg)
632    {
633      if (d>=strat->tailRing->bitmask)
634      {
635        if (h->pTotalDeg() >= strat->tailRing->bitmask)
636        {
637          strat->overflow=TRUE;
638          //Print("OVERFLOW in redLazy d=%ld, max=%ld\n",d,strat->tailRing->bitmask);
639          h->GetP();
640          at = strat->posInL(strat->L,strat->Ll,h,strat);
641          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
642          h->Clear();
643          return -1;
644        }
645      }
646      else if ((TEST_OPT_PROT) && (strat->Ll < 0))
647      {
648        Print(".%ld",d);mflush();
649        reddeg = d;
650      }
651    }
652  }
653}
654/*2
655*  reduction procedure for the sugar-strategy (honey)
656* reduces h with elements from T choosing first possible
657* element in T with respect to the given ecart
658*/
659int redHoney (LObject* h, kStrategy strat)
660{
661  if (strat->tl<0) return 1;
662  //if (h->GetLmTailRing()==NULL) return 0; // HS: SHOULD NOT BE NEEDED!
663  assume(h->FDeg == h->pFDeg());
664  poly h_p;
665  int i,j,at,pass,ei, ii, h_d;
666  unsigned long not_sev;
667  long reddeg,d;
668
669  pass = j = 0;
670  d = reddeg = h->GetpFDeg() + h->ecart;
671  h->SetShortExpVector();
672  int li;
673  h_p = h->GetLmTailRing();
674  not_sev = ~ h->sev;
675
676  h->PrepareRed(strat->use_buckets);
677  loop
678  {
679    j=kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
680    if (j < 0) return 1;
681
682    ei = strat->T[j].ecart;
683    li = strat->T[j].pLength;
684    ii = j;
685    /*
686     * the polynomial to reduce with (up to the moment) is;
687     * pi with ecart ei
688     */
689    i = j;
690    if (TEST_OPT_LENGTH)
691    loop
692    {
693      /*- takes the first possible with respect to ecart -*/
694      i++;
695      if (i > strat->tl)
696        break;
697      //if (ei < h->ecart)
698      //  break;
699      if (li<=1)
700        break;
701      if ((((strat->T[i].ecart < ei) && (ei> h->ecart))
702         || ((strat->T[i].ecart <= h->ecart) && (strat->T[i].pLength < li)))
703         &&
704          p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i],
705                               h_p, not_sev, strat->tailRing))
706      {
707        /*
708         * the polynomial to reduce with is now;
709         */
710        ei = strat->T[i].ecart;
711        li = strat->T[i].pLength;
712        ii = i;
713      }
714    }
715
716    /*
717     * end of search: have to reduce with pi
718     */
719    if (!TEST_OPT_REDTHROUGH && (pass!=0) && (ei > h->ecart))
720    {
721      h->GetTP(); // clears bucket
722      h->SetLmCurrRing();
723      /*
724       * It is not possible to reduce h with smaller ecart;
725       * if possible h goes to the lazy-set L,i.e
726       * if its position in L would be not the last one
727       */
728      if (strat->Ll >= 0) /* L is not empty */
729      {
730        at = strat->posInL(strat->L,strat->Ll,h,strat);
731        if(at <= strat->Ll)
732          /*- h will not become the next element to reduce -*/
733        {
734          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
735#ifdef KDEBUG
736          if (TEST_OPT_DEBUG) Print(" ecart too big: -> L%d\n",at);
737#endif
738          h->Clear();
739          return -1;
740        }
741      }
742    }
743#ifdef KDEBUG
744    if (TEST_OPT_DEBUG)
745    {
746      PrintS("red:");
747      h->wrp();
748      PrintS(" with ");
749      strat->T[ii].wrp();
750    }
751#endif
752    assume(strat->fromT == FALSE);
753
754    number coef;
755    ksReducePoly(h,&(strat->T[ii]),strat->kNoetherTail(),&coef,strat);
756#ifdef KDEBUG
757    if (TEST_OPT_DEBUG)
758    {
759      PrintS("\nto:");
760      h->wrp();
761      PrintLn();
762    }
763#endif
764    if(h->IsNull())
765    {
766      h->Clear();
767      if (h->lcm!=NULL) pLmFree(h->lcm);
768      #ifdef KDEBUG
769      h->lcm=NULL;
770      #endif
771      return 0;
772    }
773    h->SetShortExpVector();
774    not_sev = ~ h->sev;
775    h_d = h->SetpFDeg();
776    /* compute the ecart */
777    if (ei <= h->ecart)
778      h->ecart = d-h_d;
779    else
780      h->ecart = d-h_d+ei-h->ecart;
781
782    /*
783     * try to reduce the s-polynomial h
784     *test first whether h should go to the lazyset L
785     *-if the degree jumps
786     *-if the number of pre-defined reductions jumps
787     */
788    pass++;
789    d = h_d + h->ecart;
790    if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
791    {
792      h->GetTP(); // clear bucket
793      h->SetLmCurrRing();
794      at = strat->posInL(strat->L,strat->Ll,h,strat);
795      if (at <= strat->Ll)
796      {
797        int dummy=strat->sl;
798        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
799          return 1;
800        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
801#ifdef KDEBUG
802        if (TEST_OPT_DEBUG)
803          Print(" degree jumped: -> L%d\n",at);
804#endif
805        h->Clear();
806        return -1;
807      }
808    }
809    else if (d > reddeg)
810    {
811      if (d>=strat->tailRing->bitmask)
812      {
813        if (h->pTotalDeg()+h->ecart >= strat->tailRing->bitmask)
814        {
815          strat->overflow=TRUE;
816          //Print("OVERFLOW in redHoney d=%ld, max=%ld\n",d,strat->tailRing->bitmask);
817          h->GetP();
818          at = strat->posInL(strat->L,strat->Ll,h,strat);
819          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
820          h->Clear();
821          return -1;
822        }
823      }
824      else if (TEST_OPT_PROT && (strat->Ll < 0) )
825      {
826        //h->wrp(); Print("<%d>\n",h->GetpLength());
827        reddeg = d;
828        Print(".%ld",d); mflush();
829      }
830    }
831  }
832}
833/*2
834*  reduction procedure for the normal form
835*/
836
837poly redNF (poly h,int &max_ind,int nonorm,kStrategy strat)
838{
839  if (h==NULL) return NULL;
840  int j;
841  max_ind=strat->sl;
842
843  if (0 > strat->sl)
844  {
845    return h;
846  }
847  LObject P(h);
848  P.SetShortExpVector();
849  P.bucket = kBucketCreate(currRing);
850  kBucketInit(P.bucket,P.p,pLength(P.p));
851  kbTest(P.bucket);
852#ifdef HAVE_RINGS
853  BOOLEAN is_ring = rField_is_Ring(currRing);
854#endif
855  loop
856  {
857    j=kFindDivisibleByInS(strat,&max_ind,&P);
858    if (j>=0)
859    {
860#ifdef HAVE_RINGS
861      if (!is_ring)
862      {
863#endif
864        int sl=pSize(strat->S[j]);
865        int jj=j;
866        loop
867        {
868          int sll;
869          jj=kFindNextDivisibleByInS(strat,jj+1,max_ind,&P);
870          if (jj<0) break;
871          sll=pSize(strat->S[jj]);
872          if (sll<sl)
873          {
874            #ifdef KDEBUG
875            if (TEST_OPT_DEBUG) Print("better(S%d:%d -> S%d:%d)\n",j,sl,jj,sll);
876            #endif
877            //else if (TEST_OPT_PROT) { PrintS("b"); mflush(); }
878            j=jj;
879            sl=sll;
880          }
881        }
882        if ((nonorm==0) && (!nIsOne(pGetCoeff(strat->S[j]))))
883        {
884          pNorm(strat->S[j]);
885          //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
886        }
887#ifdef HAVE_RINGS
888      }
889#endif
890      nNormalize(pGetCoeff(P.p));
891#ifdef KDEBUG
892      if (TEST_OPT_DEBUG)
893      {
894        PrintS("red:");
895        wrp(h);
896        PrintS(" with ");
897        wrp(strat->S[j]);
898      }
899#endif
900#ifdef HAVE_PLURAL
901      if (rIsPluralRing(currRing))
902      {
903        number coef;
904        nc_kBucketPolyRed(P.bucket,strat->S[j],&coef);
905        nDelete(&coef);
906      }
907      else
908#endif
909      {
910        number coef;
911        coef=kBucketPolyRed(P.bucket,strat->S[j],pLength(strat->S[j]),strat->kNoether);
912        nDelete(&coef);
913      }
914      h = kBucketGetLm(P.bucket);   // FRAGE OLIVER
915      if (h==NULL)
916      {
917        kBucketDestroy(&P.bucket);
918        return NULL;
919      }
920      kbTest(P.bucket);
921      P.p=h;
922      P.t_p=NULL;
923      P.SetShortExpVector();
924#ifdef KDEBUG
925      if (TEST_OPT_DEBUG)
926      {
927        PrintS("\nto:");
928        wrp(h);
929        PrintLn();
930      }
931#endif
932    }
933    else
934    {
935      P.p=kBucketClear(P.bucket);
936      kBucketDestroy(&P.bucket);
937      pNormalize(P.p);
938      return P.p;
939    }
940  }
941}
942
943#ifdef KDEBUG
944static int bba_count = 0;
945#endif /* KDEBUG */
946void kDebugPrint(kStrategy strat);
947
948ideal bba (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
949{
950#ifdef KDEBUG
951  bba_count++;
952  int loop_count = 0;
953#endif /* KDEBUG */
954  om_Opts.MinTrack = 5;
955  int   srmax,lrmax, red_result = 1;
956  int   olddeg,reduc;
957  int hilbeledeg=1,hilbcount=0,minimcnt=0;
958  BOOLEAN withT = FALSE;
959
960  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
961  initBuchMoraPos(strat);
962  initHilbCrit(F,Q,&hilb,strat);
963  initBba(F,strat);
964  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
965  /*Shdl=*/initBuchMora(F, Q,strat);
966  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
967  srmax = strat->sl;
968  reduc = olddeg = lrmax = 0;
969
970#ifndef NO_BUCKETS
971  if (!TEST_OPT_NOT_BUCKETS)
972    strat->use_buckets = 1;
973#endif
974
975  // redtailBBa against T for inhomogenous input
976  if (!TEST_OPT_OLDSTD)
977    withT = ! strat->homog;
978
979  // strat->posInT = posInT_pLength;
980  kTest_TS(strat);
981
982#ifdef KDEBUG
983#if MYTEST
984  if (TEST_OPT_DEBUG)
985  {
986    PrintS("bba start GB: currRing: ");
987    // rWrite(currRing);PrintLn();
988    rDebugPrint(currRing);
989    PrintLn();
990  }
991#endif /* MYTEST */
992#endif /* KDEBUG */
993
994#ifdef HAVE_TAIL_RING
995  if(!idIs0(F) &&(!rField_is_Ring()))  // create strong gcd poly computes with tailring and S[i] ->to be fixed
996    kStratInitChangeTailRing(strat);
997#endif
998  if (BVERBOSE(23))
999  {
1000    if (test_PosInT!=NULL) strat->posInT=test_PosInT;
1001    if (test_PosInL!=NULL) strat->posInL=test_PosInL;
1002    kDebugPrint(strat);
1003  }
1004
1005
1006#ifdef KDEBUG
1007  //kDebugPrint(strat);
1008#endif
1009  /* compute------------------------------------------------------- */
1010  while (strat->Ll >= 0)
1011  {
1012    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1013    #ifdef KDEBUG
1014      loop_count++;
1015      if (TEST_OPT_DEBUG) messageSets(strat);
1016    #endif
1017    if (strat->Ll== 0) strat->interpt=TRUE;
1018    if (TEST_OPT_DEGBOUND
1019        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1020            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1021    {
1022      /*
1023       *stops computation if
1024       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1025       *a predefined number Kstd1_deg
1026       */
1027      while ((strat->Ll >= 0)
1028        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1029        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1030            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1031        )
1032        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1033      if (strat->Ll<0) break;
1034      else strat->noClearS=TRUE;
1035    }
1036    /* picks the last element from the lazyset L */
1037    strat->P = strat->L[strat->Ll];
1038    strat->Ll--;
1039
1040    if (pNext(strat->P.p) == strat->tail)
1041    {
1042      // deletes the short spoly
1043#ifdef HAVE_RINGS
1044      if (rField_is_Ring(currRing))
1045        pLmDelete(strat->P.p);
1046      else
1047#endif
1048        pLmFree(strat->P.p);
1049      strat->P.p = NULL;
1050      poly m1 = NULL, m2 = NULL;
1051
1052      // check that spoly creation is ok
1053      while (strat->tailRing != currRing &&
1054             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1055      {
1056        assume(m1 == NULL && m2 == NULL);
1057        // if not, change to a ring where exponents are at least
1058        // large enough
1059        if (!kStratChangeTailRing(strat))
1060        {
1061          WerrorS("OVERFLOW...");
1062          break;
1063        }
1064      }
1065      // create the real one
1066      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
1067                    strat->tailRing, m1, m2, strat->R);
1068    }
1069    else if (strat->P.p1 == NULL)
1070    {
1071      if (strat->minim > 0)
1072        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1073      // for input polys, prepare reduction
1074      strat->P.PrepareRed(strat->use_buckets);
1075    }
1076
1077    if (strat->P.p == NULL && strat->P.t_p == NULL)
1078    {
1079      red_result = 0;
1080    }
1081    else
1082    {
1083      if (TEST_OPT_PROT)
1084        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1085                &olddeg,&reduc,strat, red_result);
1086
1087      /* reduction of the element choosen from L */
1088      red_result = strat->red(&strat->P,strat);
1089      if (errorreported)  break;
1090    }
1091
1092    if (strat->overflow)
1093    {
1094        if (!kStratChangeTailRing(strat)) { Werror("OVERFLOW.."); break;}
1095    }
1096
1097    // reduction to non-zero new poly
1098    if (red_result == 1)
1099    {
1100      // get the polynomial (canonicalize bucket, make sure P.p is set)
1101      strat->P.GetP(strat->lmBin);
1102
1103      /* statistic */
1104      if (TEST_OPT_PROT) PrintS("s");
1105
1106      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1107
1108#ifdef KDEBUG
1109#if MYTEST
1110      PrintS("New S: "); pDebugPrint(strat->P.p); PrintLn();
1111#endif /* MYTEST */
1112#endif /* KDEBUG */
1113
1114      // reduce the tail and normalize poly
1115      // in the ring case we cannot expect LC(f) = 1,
1116      // therefore we call pContent instead of pNorm
1117      if ((TEST_OPT_INTSTRATEGY) || (rField_is_Ring(currRing)))
1118      {
1119        strat->P.pCleardenom();
1120        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1121        {
1122          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1123          strat->P.pCleardenom();
1124        }
1125      }
1126      else
1127      {
1128        strat->P.pNorm();
1129        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1130          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1131      }
1132
1133#ifdef KDEBUG
1134      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1135#if MYTEST
1136      PrintS("New (reduced) S: "); pDebugPrint(strat->P.p); PrintLn();
1137#endif /* MYTEST */
1138#endif /* KDEBUG */
1139
1140      // min_std stuff
1141      if ((strat->P.p1==NULL) && (strat->minim>0))
1142      {
1143        if (strat->minim==1)
1144        {
1145          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1146          p_Delete(&strat->P.p2, currRing, strat->tailRing);
1147        }
1148        else
1149        {
1150          strat->M->m[minimcnt]=strat->P.p2;
1151          strat->P.p2=NULL;
1152        }
1153        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1154          pNext(strat->M->m[minimcnt])
1155            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1156                                           strat->tailRing, currRing,
1157                                           currRing->PolyBin);
1158        minimcnt++;
1159      }
1160
1161      // enter into S, L, and T
1162      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1163        enterT(strat->P, strat);
1164#ifdef HAVE_RINGS
1165      if (rField_is_Ring(currRing))
1166        superenterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1167      else
1168#endif
1169        enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1170      // posInS only depends on the leading term
1171      strat->enterS(strat->P, pos, strat, strat->tl);
1172#if 0
1173      int pl=pLength(strat->P.p);
1174      if (pl==1)
1175      {
1176        //if (TEST_OPT_PROT)
1177        //PrintS("<1>");
1178      }
1179      else if (pl==2)
1180      {
1181        //if (TEST_OPT_PROT)
1182        //PrintS("<2>");
1183      }
1184#endif
1185      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1186//      Print("[%d]",hilbeledeg);
1187      if (strat->P.lcm!=NULL)
1188#ifdef HAVE_RINGS
1189        pLmDelete(strat->P.lcm);
1190#else
1191        pLmFree(strat->P.lcm);
1192#endif
1193      if (strat->sl>srmax) srmax = strat->sl;
1194    }
1195    else if (strat->P.p1 == NULL && strat->minim > 0)
1196    {
1197      p_Delete(&strat->P.p2, currRing, strat->tailRing);
1198    }
1199
1200#ifdef KDEBUG
1201    memset(&(strat->P), 0, sizeof(strat->P));
1202#endif /* KDEBUG */
1203    kTest_TS(strat);
1204  }
1205#ifdef KDEBUG
1206#if MYTEST
1207  PrintS("bba finish GB: currRing: "); rWrite(currRing);
1208#endif /* MYTEST */
1209  if (TEST_OPT_DEBUG) messageSets(strat);
1210#endif /* KDEBUG */
1211
1212  if (TEST_OPT_SB_1)
1213  {
1214    int k=1;
1215    int j;
1216    while(k<=strat->sl)
1217    {
1218      j=0;
1219      loop
1220      {
1221        if (j>=k) break;
1222        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1223        j++;
1224      }
1225      k++;
1226    }
1227  }
1228
1229  /* complete reduction of the standard basis--------- */
1230  if (TEST_OPT_REDSB)
1231  {
1232    completeReduce(strat);
1233#ifdef HAVE_TAIL_RING
1234    if (strat->completeReduce_retry)
1235    {
1236      // completeReduce needed larger exponents, retry
1237      // to reduce with S (instead of T)
1238      // and in currRing (instead of strat->tailRing)
1239      cleanT(strat);strat->tailRing=currRing;
1240      int i;
1241      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1242      completeReduce(strat);
1243    }
1244#endif
1245  }
1246  else if (TEST_OPT_PROT) PrintLn();
1247
1248  /* release temp data-------------------------------- */
1249  exitBuchMora(strat);
1250  if (TEST_OPT_WEIGHTM)
1251  {
1252    pRestoreDegProcs(pFDegOld, pLDegOld);
1253    if (ecartWeights)
1254    {
1255      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1256      ecartWeights=NULL;
1257    }
1258  }
1259  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1260  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1261
1262#ifdef KDEBUG
1263#if MYTEST
1264  PrintS("bba_end: currRing: "); rWrite(currRing);
1265#endif /* MYTEST */
1266#endif /* KDEBUG */
1267  idTest(strat->Shdl);
1268
1269  return (strat->Shdl);
1270}
1271
1272poly kNF2 (ideal F,ideal Q,poly q,kStrategy strat, int lazyReduce)
1273{
1274  assume(q!=NULL);
1275  assume(!(idIs0(F)&&(Q==NULL))); // NF(q, std(0) in polynomial ring?
1276
1277// lazy_reduce flags: can be combined by |
1278//#define KSTD_NF_LAZY   1
1279  // do only a reduction of the leading term
1280//#define KSTD_NF_NONORM 4
1281  // only global: avoid normalization, return a multiply of NF
1282  poly   p;
1283  int   i;
1284
1285  //if ((idIs0(F))&&(Q==NULL))
1286  //  return pCopy(q); /*F=0*/
1287  //strat->ak = idRankFreeModule(F);
1288  /*- creating temp data structures------------------- -*/
1289  BITSET save_test=test;
1290  test|=Sy_bit(OPT_REDTAIL);
1291  initBuchMoraCrit(strat);
1292  strat->initEcart = initEcartBBA;
1293  strat->enterS = enterSBba;
1294#ifndef NO_BUCKETS
1295  strat->use_buckets = (!TEST_OPT_NOT_BUCKETS) && (!rIsPluralRing(currRing));
1296#endif
1297  /*- set S -*/
1298  strat->sl = -1;
1299  /*- init local data struct.---------------------------------------- -*/
1300  /*Shdl=*/initS(F,Q,strat);
1301  /*- compute------------------------------------------------------- -*/
1302  //if ((TEST_OPT_INTSTRATEGY)&&(lazyReduce==0))
1303  //{
1304  //  for (i=strat->sl;i>=0;i--)
1305  //    pNorm(strat->S[i]);
1306  //}
1307  kTest(strat);
1308  if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
1309  int max_ind;
1310  p = redNF(pCopy(q),max_ind,lazyReduce & KSTD_NF_NONORM,strat);
1311  if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
1312  {
1313    if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
1314    #ifdef HAVE_RINGS
1315    if (rField_is_Ring())
1316    {
1317      p = redtailBba_Z(p,max_ind,strat);
1318    }
1319    else
1320    #endif
1321    {
1322      BITSET save=test;
1323      test &= ~Sy_bit(OPT_INTSTRATEGY);
1324      p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
1325      test=save;
1326    }
1327  }
1328  /*- release temp data------------------------------- -*/
1329  omfree(strat->sevS);
1330  omfree(strat->ecartS);
1331  omfree(strat->T);
1332  omfree(strat->sevT);
1333  omfree(strat->R);
1334  omfree(strat->S_2_R);
1335  omfree(strat->L);
1336  omfree(strat->B);
1337  omfree(strat->fromQ);
1338  idDelete(&strat->Shdl);
1339  test=save_test;
1340  if (TEST_OPT_PROT) PrintLn();
1341  return p;
1342}
1343
1344ideal kNF2 (ideal F,ideal Q,ideal q,kStrategy strat, int lazyReduce)
1345{
1346  assume(!idIs0(q));
1347  assume(!(idIs0(F)&&(Q==NULL)));
1348// lazy_reduce flags: can be combined by |
1349//#define KSTD_NF_LAZY   1
1350  // do only a reduction of the leading term
1351//#define KSTD_NF_NONORM 4
1352  // only global: avoid normalization, return a multiply of NF
1353  poly   p;
1354  int   i;
1355  ideal res;
1356  int max_ind;
1357
1358  //if (idIs0(q))
1359  //  return idInit(IDELEMS(q),si_max(q->rank,F->rank));
1360  //if ((idIs0(F))&&(Q==NULL))
1361  //  return idCopy(q); /*F=0*/
1362  //strat->ak = idRankFreeModule(F);
1363  /*- creating temp data structures------------------- -*/
1364  BITSET save_test=test;
1365  test|=Sy_bit(OPT_REDTAIL);
1366  initBuchMoraCrit(strat);
1367  strat->initEcart = initEcartBBA;
1368  strat->enterS = enterSBba;
1369  /*- set S -*/
1370  strat->sl = -1;
1371#ifndef NO_BUCKETS
1372  strat->use_buckets = (!TEST_OPT_NOT_BUCKETS) && (!rIsPluralRing(currRing));
1373#endif
1374  /*- init local data struct.---------------------------------------- -*/
1375  /*Shdl=*/initS(F,Q,strat);
1376  /*- compute------------------------------------------------------- -*/
1377  res=idInit(IDELEMS(q),si_max(q->rank,F->rank));
1378  BITSET save=test;
1379  test &= ~Sy_bit(OPT_INTSTRATEGY);
1380  for (i=IDELEMS(q)-1; i>=0; i--)
1381  {
1382    if (q->m[i]!=NULL)
1383    {
1384      if (TEST_OPT_PROT) { PrintS("r");mflush(); }
1385      p = redNF(pCopy(q->m[i]),max_ind,lazyReduce & KSTD_NF_NONORM,strat);
1386      if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
1387      {
1388        if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
1389        #ifdef HAVE_RINGS
1390        if (rField_is_Ring())
1391        {
1392          p = redtailBba_Z(p,max_ind,strat);
1393        }
1394        else
1395        #endif
1396        {
1397          p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
1398        }
1399      }
1400      res->m[i]=p;
1401    }
1402    //else
1403    //  res->m[i]=NULL;
1404  }
1405  /*- release temp data------------------------------- -*/
1406  test=save;
1407  omfree(strat->sevS);
1408  omfree(strat->ecartS);
1409  omfree(strat->T);
1410  omfree(strat->sevT);
1411  omfree(strat->R);
1412  omfree(strat->S_2_R);
1413  omfree(strat->L);
1414  omfree(strat->B);
1415  omfree(strat->fromQ);
1416  idDelete(&strat->Shdl);
1417  test=save_test;
1418  if (TEST_OPT_PROT) PrintLn();
1419  return res;
1420}
1421
1422/* shiftgb stuff */
1423#ifdef HAVE_SHIFTBBA
1424
1425
1426ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, int uptodeg, int lV)
1427{
1428#ifdef KDEBUG
1429  bba_count++;
1430  int loop_count = 0;
1431#endif
1432  om_Opts.MinTrack = 5;
1433  int   srmax,lrmax, red_result = 1;
1434  int   olddeg,reduc;
1435  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1436  BOOLEAN withT = TRUE; // very important for shifts
1437
1438  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit, NO CHANGES */
1439  initBuchMoraPos(strat); /*NO CHANGES YET: perhaps later*/
1440  initHilbCrit(F,Q,&hilb,strat); /*NO CHANGES*/
1441  initBbaShift(F,strat); /* DONE */
1442  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1443  /*Shdl=*/initBuchMoraShift(F, Q,strat); /* updateS with no toT, i.e. no init for T */
1444  updateSShift(strat,uptodeg,lV); /* initializes T */
1445
1446  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
1447  srmax = strat->sl;
1448  reduc = olddeg = lrmax = 0;
1449  strat->lV=lV;
1450
1451#ifndef NO_BUCKETS
1452  if (!TEST_OPT_NOT_BUCKETS)
1453    strat->use_buckets = 1;
1454#endif
1455
1456  // redtailBBa against T for inhomogenous input
1457  //  if (!TEST_OPT_OLDSTD)
1458  //    withT = ! strat->homog;
1459
1460  // strat->posInT = posInT_pLength;
1461  kTest_TS(strat);
1462
1463#ifdef HAVE_TAIL_RING
1464  kStratInitChangeTailRing(strat);
1465#endif
1466
1467  /* compute------------------------------------------------------- */
1468  while (strat->Ll >= 0)
1469  {
1470    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1471#ifdef KDEBUG
1472    loop_count++;
1473    if (TEST_OPT_DEBUG) messageSets(strat);
1474#endif
1475    if (strat->Ll== 0) strat->interpt=TRUE;
1476    if (TEST_OPT_DEGBOUND
1477        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1478            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1479    {
1480      /*
1481       *stops computation if
1482       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1483       *a predefined number Kstd1_deg
1484       */
1485      while ((strat->Ll >= 0)
1486        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1487        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1488            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1489        )
1490        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1491      if (strat->Ll<0) break;
1492      else strat->noClearS=TRUE;
1493    }
1494    /* picks the last element from the lazyset L */
1495    strat->P = strat->L[strat->Ll];
1496    strat->Ll--;
1497
1498    if (pNext(strat->P.p) == strat->tail)
1499    {
1500      // deletes the short spoly
1501      pLmFree(strat->P.p);
1502      strat->P.p = NULL;
1503      poly m1 = NULL, m2 = NULL;
1504
1505      // check that spoly creation is ok
1506      while (strat->tailRing != currRing &&
1507             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1508      {
1509        assume(m1 == NULL && m2 == NULL);
1510        // if not, change to a ring where exponents are at least
1511        // large enough
1512        kStratChangeTailRing(strat);
1513      }
1514      // create the real one
1515      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
1516                    strat->tailRing, m1, m2, strat->R);
1517    }
1518    else if (strat->P.p1 == NULL)
1519    {
1520      if (strat->minim > 0)
1521        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1522      // for input polys, prepare reduction
1523      strat->P.PrepareRed(strat->use_buckets);
1524    }
1525
1526    poly qq;
1527
1528    /* here in the nonhomog case we shrink the new spoly */
1529
1530    if ( ! strat->homog)
1531    {
1532      strat->P.GetP(strat->lmBin); // because shifts are counted with .p structure
1533      /* in the nonhomog case we have to shrink the polynomial */
1534      assume(strat->P.t_p!=NULL);
1535      qq = p_Shrink(strat->P.t_p, lV, strat->tailRing); // direct shrink
1536      if (qq != NULL)
1537      {
1538         /* we're here if Shrink is nonzero */
1539        //         strat->P.p =  NULL;
1540        //        strat->P.Delete(); /* deletes P.p and P.t_p */ //error
1541        strat->P.p   =  NULL; // is not set by Delete
1542        strat->P.t_p =  qq;
1543        strat->P.GetP(strat->lmBin);
1544        // update sev and length
1545        strat->initEcart(&(strat->P));
1546        strat->P.sev = pGetShortExpVector(strat->P.p);
1547//         strat->P.FDeg = strat->P.pFDeg();
1548//         strat->P.length = strat->P.pLDeg();
1549//         strat->P.pLength =strat->P.GetpLength(); //pLength(strat->P.p);
1550      }
1551      else
1552      {
1553         /* Shrink is zero, like y(1)*y(2) - y(1)*y(3)*/
1554#ifdef KDEBUG
1555         if (TEST_OPT_DEBUG){PrintS("nonzero s shrinks to 0");PrintLn();}
1556#endif
1557         //         strat->P.Delete();  // cause error
1558         strat->P.p = NULL;
1559         strat->P.t_p = NULL;
1560           //         strat->P.p = NULL; // or delete strat->P.p ?
1561       }
1562    }
1563      /* end shrinking poly in the nonhomog case */
1564
1565    if (strat->P.p == NULL && strat->P.t_p == NULL)
1566    {
1567      red_result = 0;
1568    }
1569    else
1570    {
1571      if (TEST_OPT_PROT)
1572        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1573                &olddeg,&reduc,strat, red_result);
1574
1575      /* reduction of the element choosen from L */
1576      red_result = strat->red(&strat->P,strat);
1577    }
1578
1579    // reduction to non-zero new poly
1580    if (red_result == 1)
1581    {
1582      /* statistic */
1583      if (TEST_OPT_PROT) PrintS("s");
1584
1585      // get the polynomial (canonicalize bucket, make sure P.p is set)
1586      strat->P.GetP(strat->lmBin);
1587
1588      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1589
1590      // reduce the tail and normalize poly
1591      if (TEST_OPT_INTSTRATEGY)
1592      {
1593        strat->P.pCleardenom();
1594        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1595        {
1596          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1597          strat->P.pCleardenom();
1598        }
1599      }
1600      else
1601      {
1602        strat->P.pNorm();
1603        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1604          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1605      }
1606
1607      // here we must shrink again! and optionally reduce again
1608      // or build shrink into redtailBba!
1609
1610#ifdef KDEBUG
1611      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1612#endif
1613
1614      // min_std stuff
1615      if ((strat->P.p1==NULL) && (strat->minim>0))
1616      {
1617        if (strat->minim==1)
1618        {
1619          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1620          p_Delete(&strat->P.p2, currRing, strat->tailRing);
1621        }
1622        else
1623        {
1624          strat->M->m[minimcnt]=strat->P.p2;
1625          strat->P.p2=NULL;
1626        }
1627        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1628          pNext(strat->M->m[minimcnt])
1629            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1630                                           strat->tailRing, currRing,
1631                                           currRing->PolyBin);
1632        minimcnt++;
1633      }
1634
1635    /* here in the nonhomog case we shrink the reduced poly AGAIN */
1636
1637    if ( ! strat->homog)
1638    {
1639      strat->P.GetP(strat->lmBin); // because shifts are counted with .p structure
1640      /* assume strat->P.t_p != NULL */
1641      /* in the nonhomog case we have to shrink the polynomial */
1642      assume(strat->P.t_p!=NULL); // poly qq defined above
1643      qq = p_Shrink(strat->P.t_p, lV, strat->tailRing); // direct shrink
1644      if (qq != NULL)
1645      {
1646         /* we're here if Shrink is nonzero */
1647        //         strat->P.p =  NULL;
1648        //        strat->P.Delete(); /* deletes P.p and P.t_p */ //error
1649        strat->P.p   =  NULL; // is not set by Delete
1650        strat->P.t_p =  qq;
1651        strat->P.GetP(strat->lmBin);
1652        // update sev and length
1653        strat->initEcart(&(strat->P));
1654        strat->P.sev = pGetShortExpVector(strat->P.p);
1655      }
1656      else
1657      {
1658         /* Shrink is zero, like y(1)*y(2) - y(1)*y(3)*/
1659#ifdef PDEBUG
1660         if (TEST_OPT_DEBUG){PrintS("nonzero s shrinks to 0");PrintLn();}
1661#endif
1662         //         strat->P.Delete();  // cause error
1663         strat->P.p = NULL;
1664         strat->P.t_p = NULL;
1665           //         strat->P.p = NULL; // or delete strat->P.p ?
1666         goto     red_shrink2zero;
1667       }
1668    }
1669      /* end shrinking poly AGAIN in the nonhomog case */
1670
1671
1672      // enter into S, L, and T
1673      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1674      //        enterT(strat->P, strat); // this was here before Shift stuff
1675      //enterTShift(LObject p, kStrategy strat, int atT, int uptodeg, int lV); // syntax
1676      // the default value for atT = -1 as in bba
1677      /*   strat->P.GetP(); */
1678      // because shifts are counted with .p structure // done before, but ?
1679      enterTShift(strat->P,strat,-1,uptodeg, lV);
1680      enterpairsShift(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl,uptodeg,lV);
1681      //      enterpairsShift(vw,strat->sl,strat->P.ecart,pos,strat, strat->tl,uptodeg,lV);
1682      // posInS only depends on the leading term
1683      strat->enterS(strat->P, pos, strat, strat->tl);
1684
1685      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1686//      Print("[%d]",hilbeledeg);
1687      if (strat->P.lcm!=NULL) pLmFree(strat->P.lcm);
1688      if (strat->sl>srmax) srmax = strat->sl;
1689    }
1690    else
1691    {
1692    red_shrink2zero:
1693      if (strat->P.p1 == NULL && strat->minim > 0)
1694      {
1695        p_Delete(&strat->P.p2, currRing, strat->tailRing);
1696      }
1697    }
1698#ifdef KDEBUG
1699    memset(&(strat->P), 0, sizeof(strat->P));
1700#endif
1701    kTest_TS(strat);
1702  }
1703#ifdef KDEBUG
1704  if (TEST_OPT_DEBUG) messageSets(strat);
1705#endif
1706  /* complete reduction of the standard basis--------- */
1707  /*  shift case: look for elt's in S such that they are divisible by elt in T */
1708  //  if (TEST_OPT_SB_1)
1709  if (TEST_OPT_REDSB)
1710  {
1711    int k=0;
1712    int j=-1;
1713    while(k<=strat->sl)
1714    {
1715//       loop
1716//       {
1717//         if (j>=k) break;
1718//         clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1719//         j++;
1720//       }
1721      LObject Ln (strat->S[k],currRing, strat->tailRing);
1722      Ln.SetShortExpVector();
1723      j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln, j+1);
1724      if (j<0) {  k++; j=-1;}
1725      else
1726      {
1727        if ( pLmCmp(strat->S[k],strat->T[j].p) == 0)
1728        {
1729          j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln, j+1);
1730          if (j<0) {  k++; j=-1;}
1731          else
1732          {
1733            deleteInS(k,strat);
1734          }
1735        }
1736        else
1737        {
1738          deleteInS(k,strat);
1739        }
1740      }
1741    }
1742  }
1743
1744  if (TEST_OPT_REDSB)
1745  {    completeReduce(strat, TRUE); //shift: withT = TRUE
1746    if (strat->completeReduce_retry)
1747    {
1748      // completeReduce needed larger exponents, retry
1749      // to reduce with S (instead of T)
1750      // and in currRing (instead of strat->tailRing)
1751      cleanT(strat);strat->tailRing=currRing;
1752      int i;
1753      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1754      completeReduce(strat, TRUE);
1755    }
1756  }
1757  else if (TEST_OPT_PROT) PrintLn();
1758
1759  /* release temp data-------------------------------- */
1760  exitBuchMora(strat);
1761  if (TEST_OPT_WEIGHTM)
1762  {
1763    pRestoreDegProcs(pFDegOld, pLDegOld);
1764    if (ecartWeights)
1765    {
1766      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1767      ecartWeights=NULL;
1768    }
1769  }
1770  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1771  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1772  return (strat->Shdl);
1773}
1774
1775
1776ideal freegb(ideal I, int uptodeg, int lVblock)
1777{
1778  /* todo main call */
1779
1780  /* assume: ring is prepared, ideal is copied into shifted ring */
1781  /* uptodeg and lVblock are correct - test them! */
1782
1783  /* check whether the ideal is in V */
1784
1785//  if (0)
1786  if (! ideal_isInV(I,lVblock) )
1787  {
1788    WerrorS("The input ideal contains incorrectly encoded elements! ");
1789    return(NULL);
1790  }
1791
1792  //  kStrategy strat = new skStrategy;
1793  /* ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, int uptodeg, int lV) */
1794  /* at the moment:
1795- no quotient (check)
1796- no *w, no *hilb
1797  */
1798  /* ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
1799     int newIdeal, intvec *vw) */
1800  ideal RS = kStdShift(I,NULL, testHomog, NULL,NULL,0,0,NULL, uptodeg, lVblock);
1801    //bbaShift(I,NULL, NULL, NULL, strat, uptodeg, lVblock);
1802  idSkipZeroes(RS);
1803  return(RS);
1804}
1805
1806/*2
1807*reduces h with elements from T choosing  the first possible
1808* element in t with respect to the given pDivisibleBy
1809*/
1810int redFirstShift (LObject* h,kStrategy strat)
1811{
1812  if (h->IsNull()) return 0;
1813
1814  int at, reddeg,d;
1815  int pass = 0;
1816  int j = 0;
1817
1818  if (! strat->homog)
1819  {
1820    d = h->GetpFDeg() + h->ecart;
1821    reddeg = strat->LazyDegree+d;
1822  }
1823  h->SetShortExpVector();
1824  loop
1825  {
1826    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
1827    if (j < 0)
1828    {
1829      h->SetDegStuffReturnLDeg(strat->LDegLast);
1830      return 1;
1831    }
1832
1833    if (!TEST_OPT_INTSTRATEGY)
1834      strat->T[j].pNorm();
1835#ifdef KDEBUG
1836    if (TEST_OPT_DEBUG)
1837    {
1838      PrintS("reduce ");
1839      h->wrp();
1840      PrintS(" with ");
1841      strat->T[j].wrp();
1842    }
1843#endif
1844    ksReducePoly(h, &(strat->T[j]), strat->kNoetherTail(), NULL, strat);
1845    if (!h->IsNull())
1846    {
1847      poly qq=p_Shrink(h->GetTP(),strat->lV,strat->tailRing);
1848      h->p=NULL;
1849      h->t_p=qq;
1850      if (qq!=NULL) h->GetP(strat->lmBin);
1851    }
1852
1853#ifdef KDEBUG
1854    if (TEST_OPT_DEBUG)
1855    {
1856      PrintS(" to ");
1857      wrp(h->p);
1858      PrintLn();
1859    }
1860#endif
1861    if (h->IsNull())
1862    {
1863      if (h->lcm!=NULL) pLmFree(h->lcm);
1864      h->Clear();
1865      return 0;
1866    }
1867    h->SetShortExpVector();
1868
1869#if 0
1870    if ((strat->syzComp!=0) && !strat->honey)
1871    {
1872      if ((strat->syzComp>0) &&
1873          (h->Comp() > strat->syzComp))
1874      {
1875        assume(h->MinComp() > strat->syzComp);
1876#ifdef KDEBUG
1877        if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
1878#endif
1879        if (strat->homog)
1880          h->SetDegStuffReturnLDeg(strat->LDegLast);
1881        return -2;
1882      }
1883    }
1884#endif
1885    if (!strat->homog)
1886    {
1887      if (!TEST_OPT_OLDSTD && strat->honey)
1888      {
1889        h->SetpFDeg();
1890        if (strat->T[j].ecart <= h->ecart)
1891          h->ecart = d - h->GetpFDeg();
1892        else
1893          h->ecart = d - h->GetpFDeg() + strat->T[j].ecart - h->ecart;
1894
1895        d = h->GetpFDeg() + h->ecart;
1896      }
1897      else
1898        d = h->SetDegStuffReturnLDeg(strat->LDegLast);
1899      /*- try to reduce the s-polynomial -*/
1900      pass++;
1901      /*
1902       *test whether the polynomial should go to the lazyset L
1903       *-if the degree jumps
1904       *-if the number of pre-defined reductions jumps
1905       */
1906      if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
1907          && ((d >= reddeg) || (pass > strat->LazyPass)))
1908      {
1909        h->SetLmCurrRing();
1910        if (strat->posInLDependsOnLength)
1911          h->SetLength(strat->length_pLength);
1912        at = strat->posInL(strat->L,strat->Ll,h,strat);
1913        if (at <= strat->Ll)
1914        {
1915          int dummy=strat->sl;
1916          /*          if (kFindDivisibleByInS(strat,&dummy, h) < 0) */
1917          if (kFindDivisibleByInT(strat->T,strat->sevT, dummy, h) < 0)
1918            return 1;
1919          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
1920#ifdef KDEBUG
1921          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
1922#endif
1923          h->Clear();
1924          return -1;
1925        }
1926      }
1927      if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
1928      {
1929        reddeg = d+1;
1930        Print(".%d",d);mflush();
1931      }
1932    }
1933  }
1934}
1935
1936void initBbaShift(ideal F,kStrategy strat)
1937{
1938  int i;
1939  idhdl h;
1940 /* setting global variables ------------------- */
1941  strat->enterS = enterSBba; /* remains as is, we change enterT! */
1942
1943  strat->red = redFirstShift; /* no redHomog ! */
1944
1945  if (pLexOrder && strat->honey)
1946    strat->initEcart = initEcartNormal;
1947  else
1948    strat->initEcart = initEcartBBA;
1949  if (strat->honey)
1950    strat->initEcartPair = initEcartPairMora;
1951  else
1952    strat->initEcartPair = initEcartPairBba;
1953  strat->kIdeal = NULL;
1954  //if (strat->ak==0) strat->kIdeal->rtyp=IDEAL_CMD;
1955  //else              strat->kIdeal->rtyp=MODUL_CMD;
1956  //strat->kIdeal->data=(void *)strat->Shdl;
1957  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1958  {
1959    //interred  machen   Aenderung
1960    pFDegOld=pFDeg;
1961    pLDegOld=pLDeg;
1962    //h=ggetid("ecart");
1963    //if ((h!=NULL) /*&& (IDTYP(h)==INTVEC_CMD)*/)
1964    //{
1965    //  ecartWeights=iv2array(IDINTVEC(h));
1966    //}
1967    //else
1968    {
1969      ecartWeights=(short *)omAlloc((pVariables+1)*sizeof(short));
1970      /*uses automatic computation of the ecartWeights to set them*/
1971      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
1972    }
1973    pRestoreDegProcs(totaldegreeWecart, maxdegreeWecart);
1974    if (TEST_OPT_PROT)
1975    {
1976      for(i=1; i<=pVariables; i++)
1977        Print(" %d",ecartWeights[i]);
1978      PrintLn();
1979      mflush();
1980    }
1981  }
1982}
1983#endif
Note: See TracBrowser for help on using the repository browser.