source: git/kernel/kstd2.cc @ f224d85

spielwiese
Last change on this file since f224d85 was f224d85, checked in by Hans Schoenemann <hannes@…>, 12 years ago
fix: removing last from p_*templates and k* routines
  • Property mode set to 100644
File size: 80.4 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5*  ABSTRACT -  Kernel: alg. of Buchberger
6*/
7
8// #define PDEBUG 2
9
10// TODO: why the following is here instead of mod2.h???
11
12// define to enable tailRings
13#define HAVE_TAIL_RING
14
15#include "config.h"
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
37#define DEBUGF50  0
38#define DEBUGF51  0
39
40#ifdef DEBUGF5
41#undef DEBUGF5
42//#define DEBUGF5 1
43#endif
44
45#define F5C       1
46#if F5C
47  #define F5CTAILRED 0
48#endif
49
50#include <kernel/kutil.h>
51#include <misc/options.h>
52#include <omalloc/omalloc.h>
53#include <kernel/polys.h>
54#include <kernel/ideals.h>
55#include <kernel/febase.h>
56#include <kernel/kstd1.h>
57#include <kernel/khstd.h>
58#include <polys/kbuckets.h>
59#include <polys/prCopy.h>
60//#include "cntrlc.h"
61#include <polys/weight.h>
62#include <misc/intvec.h>
63#ifdef HAVE_PLURAL
64#include <polys/nc/nc.h>
65#endif
66// #include "timer.h"
67
68/* shiftgb stuff */
69#include <kernel/shiftgb.h>
70
71  int (*test_PosInT)(const TSet T,const int tl,LObject &h);
72  int (*test_PosInL)(const LSet set, const int length,
73                LObject* L,const kStrategy strat);
74
75// return -1 if no divisor is found
76//        number of first divisor, otherwise
77int kFindDivisibleByInT(const TSet &T, const unsigned long* sevT,
78                        const int tl, const LObject* L, const int start)
79{
80  unsigned long not_sev = ~L->sev;
81  int j = start;
82  poly p=L->p;
83  ring r=currRing;
84  L->GetLm(p, r);
85
86  pAssume(~not_sev == p_GetShortExpVector(p, r));
87
88  if (r == currRing)
89  {
90    loop
91    {
92      if (j > tl) return -1;
93#if defined(PDEBUG) || defined(PDIV_DEBUG)
94      if (p_LmShortDivisibleBy(T[j].p, sevT[j],
95                               p, not_sev, r))
96        return j;
97#else
98      if (!(sevT[j] & not_sev) &&
99          p_LmDivisibleBy(T[j].p, p, r))
100        return j;
101#endif
102      j++;
103    }
104  }
105  else
106  {
107    loop
108    {
109      if (j > tl) return -1;
110#if defined(PDEBUG) || defined(PDIV_DEBUG)
111      if (p_LmShortDivisibleBy(T[j].t_p, sevT[j],
112                               p, not_sev, r))
113        return j;
114#else
115      if (!(sevT[j] & not_sev) &&
116          p_LmDivisibleBy(T[j].t_p, p, r))
117        return j;
118#endif
119      j++;
120    }
121  }
122}
123
124// same as above, only with set S
125int kFindDivisibleByInS(const kStrategy strat, int* max_ind, LObject* L)
126{
127  unsigned long not_sev = ~L->sev;
128  poly p = L->GetLmCurrRing();
129  int j = 0;
130
131  pAssume(~not_sev == p_GetShortExpVector(p, currRing));
132#if 1
133  int ende;
134  if ((strat->ak>0) || currRing->pLexOrder) ende=strat->sl;
135  else ende=posInS(strat,*max_ind,p,0)+1;
136  if (ende>(*max_ind)) ende=(*max_ind);
137#else
138  int ende=strat->sl;
139#endif
140  (*max_ind)=ende;
141  loop
142  {
143    if (j > ende) return -1;
144#if defined(PDEBUG) || defined(PDIV_DEBUG)
145    if (p_LmShortDivisibleBy(strat->S[j], strat->sevS[j],
146                             p, not_sev, currRing))
147        return j;
148#else
149    if ( !(strat->sevS[j] & not_sev) &&
150         p_LmDivisibleBy(strat->S[j], p, currRing))
151      return j;
152#endif
153    j++;
154  }
155}
156
157int kFindNextDivisibleByInS(const kStrategy strat, int start,int max_ind, LObject* L)
158{
159  unsigned long not_sev = ~L->sev;
160  poly p = L->GetLmCurrRing();
161  int j = start;
162
163  pAssume(~not_sev == p_GetShortExpVector(p, currRing));
164#if 1
165  int ende=max_ind;
166#else
167  int ende=strat->sl;
168#endif
169  loop
170  {
171    if (j > ende) return -1;
172#if defined(PDEBUG) || defined(PDIV_DEBUG)
173    if (p_LmShortDivisibleBy(strat->S[j], strat->sevS[j],
174                             p, not_sev, currRing))
175        return j;
176#else
177    if ( !(strat->sevS[j] & not_sev) &&
178         p_LmDivisibleBy(strat->S[j], p, currRing))
179      return j;
180#endif
181    j++;
182  }
183}
184
185#ifdef HAVE_RINGS
186poly kFindZeroPoly(poly input_p, ring leadRing, ring tailRing)
187{
188  // m = currRing->ch
189
190  if (input_p == NULL) return NULL;
191
192  poly p = input_p;
193  poly zeroPoly = NULL;
194  NATNUMBER a = (NATNUMBER) pGetCoeff(p);
195
196  int k_ind2 = 0;
197  int a_ind2 = ind2(a);
198
199  NATNUMBER k = 1;
200  // of interest is only k_ind2, special routine for improvement ... TODO OLIVER
201  for (int i = 1; i <= leadRing->N; i++)
202  {
203    k_ind2 = k_ind2 + ind_fact_2(p_GetExp(p, i, leadRing));
204  }
205
206  a = (NATNUMBER) pGetCoeff(p);
207
208  number tmp1;
209  poly tmp2, tmp3;
210  poly lead_mult = p_ISet(1, tailRing);
211  if (n_GetChar(leadRing->cf) <= k_ind2 + a_ind2)
212  {
213    int too_much = k_ind2 + a_ind2 - n_GetChar(leadRing->cf);
214    int s_exp;
215    zeroPoly = p_ISet(a, tailRing);
216    for (int i = 1; i <= leadRing->N; i++)
217    {
218      s_exp = p_GetExp(p, i,leadRing);
219      if (s_exp % 2 != 0)
220      {
221        s_exp = s_exp - 1;
222      }
223      while ( (0 < ind2(s_exp)) && (ind2(s_exp) <= too_much) )
224      {
225        too_much = too_much - ind2(s_exp);
226        s_exp = s_exp - 2;
227      }
228      p_SetExp(lead_mult, i, p_GetExp(p, i,leadRing) - s_exp, tailRing);
229      for (NATNUMBER j = 1; j <= s_exp; j++)
230      {
231        tmp1 = nInit(j);
232        tmp2 = p_ISet(1, tailRing);
233        p_SetExp(tmp2, i, 1, tailRing);
234        p_Setm(tmp2, tailRing);
235        if (nIsZero(tmp1))
236        { // should nowbe obsolet, test ! TODO OLIVER
237          zeroPoly = p_Mult_q(zeroPoly, tmp2, tailRing);
238        }
239        else
240        {
241          tmp3 = p_NSet(nCopy(tmp1), tailRing);
242          zeroPoly = p_Mult_q(zeroPoly, p_Add_q(tmp3, tmp2, tailRing), tailRing);
243        }
244      }
245    }
246    p_Setm(lead_mult, tailRing);
247    zeroPoly = p_Mult_mm(zeroPoly, lead_mult, tailRing);
248    tmp2 = p_NSet(nCopy(pGetCoeff(zeroPoly)), leadRing);
249    for (int i = 1; i <= leadRing->N; i++)
250    {
251      pSetExp(tmp2, i, p_GetExp(zeroPoly, i, tailRing));
252    }
253    p_Setm(tmp2, leadRing);
254    zeroPoly = p_LmDeleteAndNext(zeroPoly, tailRing);
255    pNext(tmp2) = zeroPoly;
256    return tmp2;
257  }
258/*  NATNUMBER alpha_k = twoPow(leadRing->ch - k_ind2);
259  if (1 == 0 && alpha_k <= a)
260  {  // Temporarly disabled, reducing coefficients not compatible with std TODO Oliver
261    zeroPoly = p_ISet((a / alpha_k)*alpha_k, tailRing);
262    for (int i = 1; i <= leadRing->N; i++)
263    {
264      for (NATNUMBER j = 1; j <= p_GetExp(p, i, leadRing); j++)
265      {
266        tmp1 = nInit(j);
267        tmp2 = p_ISet(1, tailRing);
268        p_SetExp(tmp2, i, 1, tailRing);
269        p_Setm(tmp2, tailRing);
270        if (nIsZero(tmp1))
271        {
272          zeroPoly = p_Mult_q(zeroPoly, tmp2, tailRing);
273        }
274        else
275        {
276          tmp3 = p_ISet((NATNUMBER) tmp1, tailRing);
277          zeroPoly = p_Mult_q(zeroPoly, p_Add_q(tmp2, tmp3, tailRing), tailRing);
278        }
279      }
280    }
281    tmp2 = p_ISet((NATNUMBER) pGetCoeff(zeroPoly), leadRing);
282    for (int i = 1; i <= leadRing->N; i++)
283    {
284      pSetExp(tmp2, i, p_GetExp(zeroPoly, i, tailRing));
285    }
286    p_Setm(tmp2, leadRing);
287    zeroPoly = p_LmDeleteAndNext(zeroPoly, tailRing);
288    pNext(tmp2) = zeroPoly;
289    return tmp2;
290  } */
291  return NULL;
292}
293#endif
294
295
296#ifdef HAVE_RINGS
297/*2
298*  reduction procedure for the ring Z/2^m
299*/
300int redRing (LObject* h,kStrategy strat)
301{
302  if (h->IsNull()) return 0; // spoly is zero (can only occure with zero divisors)
303  if (strat->tl<0) return 1;
304
305  int at,i;
306  long d;
307  int j = 0;
308  int pass = 0;
309  poly zeroPoly = NULL;
310
311// TODO warum SetpFDeg notwendig?
312  h->SetpFDeg();
313  assume(h->pFDeg() == h->FDeg);
314  long reddeg = h->GetpFDeg();
315
316  h->SetShortExpVector();
317  loop
318  {
319    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
320    if (j < 0) return 1;
321
322    ksReducePoly(h, &(strat->T[j]), NULL, NULL, strat); // with debug output
323
324    if (h->GetLmTailRing() == NULL)
325    {
326      if (h->lcm!=NULL) pLmDelete(h->lcm);
327#ifdef KDEBUG
328      h->lcm=NULL;
329#endif
330      h->Clear();
331      return 0;
332    }
333    h->SetShortExpVector();
334    d = h->SetpFDeg();
335    /*- try to reduce the s-polynomial -*/
336    pass++;
337    if (!TEST_OPT_REDTHROUGH &&
338        (strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
339    {
340      h->SetLmCurrRing();
341      if (strat->posInLDependsOnLength)
342        h->SetLength(strat->length_pLength);
343      at = strat->posInL(strat->L,strat->Ll,h,strat);
344      if (at <= strat->Ll)
345      {
346#ifdef KDEBUG
347        if (TEST_OPT_DEBUG) Print(" ->L[%d]\n",at);
348#endif
349        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);     // NOT RING CHECKED OLIVER
350        h->Clear();
351        return -1;
352      }
353    }
354    if (d != reddeg)
355    {
356      if (d >= strat->tailRing->bitmask)
357      {
358        if (h->pTotalDeg() >= strat->tailRing->bitmask)
359        {
360          strat->overflow=TRUE;
361          //Print("OVERFLOW in redRing d=%ld, max=%ld\n",d,strat->tailRing->bitmask);
362          h->GetP();
363          at = strat->posInL(strat->L,strat->Ll,h,strat);
364          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
365          h->Clear();
366          return -1;
367        }
368      }
369      else if ((TEST_OPT_PROT) && (strat->Ll < 0))
370      {
371        Print(".%ld",d);mflush();
372        reddeg = d;
373      }
374    }
375  }
376}
377#endif
378
379/*2
380*  reduction procedure for the homogeneous case
381*  and the case of a degree-ordering
382*/
383int redHomog (LObject* h,kStrategy strat)
384{
385  if (strat->tl<0) return 1;
386  //if (h->GetLmTailRing()==NULL) return 0; // HS: SHOULD NOT BE NEEDED!
387  assume(h->FDeg == h->pFDeg());
388
389  poly h_p;
390  int i,j,at,pass, ii;
391  unsigned long not_sev;
392  long reddeg,d;
393
394  pass = j = 0;
395  d = reddeg = h->GetpFDeg();
396  h->SetShortExpVector();
397  int li;
398  h_p = h->GetLmTailRing();
399  not_sev = ~ h->sev;
400  loop
401  {
402    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
403    if (j < 0) return 1;
404
405    li = strat->T[j].pLength;
406    ii = j;
407    /*
408     * the polynomial to reduce with (up to the moment) is;
409     * pi with length li
410     */
411    i = j;
412#if 1
413    if (TEST_OPT_LENGTH)
414    loop
415    {
416      /*- search the shortest possible with respect to length -*/
417      i++;
418      if (i > strat->tl)
419        break;
420      if (li<=1)
421        break;
422      if ((strat->T[i].pLength < li)
423         &&
424          p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i],
425                               h_p, not_sev, strat->tailRing))
426      {
427        /*
428         * the polynomial to reduce with is now;
429         */
430        li = strat->T[i].pLength;
431        ii = i;
432      }
433    }
434#endif
435
436    /*
437     * end of search: have to reduce with pi
438     */
439#ifdef KDEBUG
440    if (TEST_OPT_DEBUG)
441    {
442      PrintS("red:");
443      h->wrp();
444      PrintS(" with ");
445      strat->T[ii].wrp();
446    }
447#endif
448    assume(strat->fromT == FALSE);
449
450    ksReducePoly(h, &(strat->T[ii]), NULL, NULL, strat);
451
452#ifdef KDEBUG
453    if (TEST_OPT_DEBUG)
454    {
455      PrintS("\nto ");
456      h->wrp();
457      PrintLn();
458    }
459#endif
460
461    h_p = h->GetLmTailRing();
462    if (h_p == NULL)
463    {
464      if (h->lcm!=NULL) pLmFree(h->lcm);
465#ifdef KDEBUG
466      h->lcm=NULL;
467#endif
468      return 0;
469    }
470    h->SetShortExpVector();
471    not_sev = ~ h->sev;
472    /*
473     * try to reduce the s-polynomial h
474     *test first whether h should go to the lazyset L
475     *-if the degree jumps
476     *-if the number of pre-defined reductions jumps
477     */
478    pass++;
479    if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0) && (pass > strat->LazyPass))
480    {
481      h->SetLmCurrRing();
482      at = strat->posInL(strat->L,strat->Ll,h,strat);
483      if (at <= strat->Ll)
484      {
485        int dummy=strat->sl;
486        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
487          return 1;
488        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
489#ifdef KDEBUG
490        if (TEST_OPT_DEBUG)
491          Print(" lazy: -> L%d\n",at);
492#endif
493        h->Clear();
494        return -1;
495      }
496    }
497  }
498}
499
500/*2
501*  reduction procedure for signature-based standard
502*  basis algorithms:
503*  all reductions have to be sig-safe!
504*
505*  2 is returned if and only if the pair is rejected by the rewritten criterion
506*  at exactly this point of the computations. This is the last possible point
507*  such a check can be done => checks with the biggest set of available
508*  signatures
509*/
510int redSig (LObject* h,kStrategy strat)
511{
512  if (strat->tl<0) return 1;
513  //if (h->GetLmTailRing()==NULL) return 0; // HS: SHOULD NOT BE NEEDED!
514  //printf("FDEGS: %ld -- %ld\n",h->FDeg, h->pFDeg());
515  assume(h->FDeg == h->pFDeg());
516//#if 1
517#ifdef DEBUGF5
518  Print("------- IN REDSIG -------\n");
519  Print("p: ");
520  pWrite(pHead(h->p));
521  Print("p1: ");
522  pWrite(pHead(h->p1));
523  Print("p2: ");
524  pWrite(pHead(h->p2));
525  Print("---------------------------\n");
526#endif
527  poly h_p;
528  int i,j,at,pass, ii;
529  int start=0;
530  int sigSafe;
531  unsigned long not_sev;
532  long reddeg,d;
533
534  pass = j = 0;
535  d = reddeg = h->GetpFDeg();
536  h->SetShortExpVector();
537  int li;
538  h_p = h->GetLmTailRing();
539  not_sev = ~ h->sev;
540  loop
541  {
542    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h, start);
543    if (j < 0)
544    {
545      return 1;
546    }
547
548    li = strat->T[j].pLength;
549    ii = j;
550    /*
551     * the polynomial to reduce with (up to the moment) is;
552     * pi with length li
553     */
554    i = j;
555#if 1
556    if (TEST_OPT_LENGTH)
557    loop
558    {
559      /*- search the shortest possible with respect to length -*/
560      i++;
561      if (i > strat->tl)
562        break;
563      if (li<=1)
564        break;
565      if ((strat->T[i].pLength < li)
566         &&
567          p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i],
568                               h_p, not_sev, strat->tailRing))
569      {
570        /*
571         * the polynomial to reduce with is now;
572         */
573        li = strat->T[i].pLength;
574        ii = i;
575      }
576    }
577    start = ii+1;
578#endif
579
580    /*
581     * end of search: have to reduce with pi
582     */
583#ifdef KDEBUG
584    if (TEST_OPT_DEBUG)
585    {
586      PrintS("red:");
587      h->wrp();
588      PrintS(" with ");
589      strat->T[ii].wrp();
590    }
591#endif
592    assume(strat->fromT == FALSE);
593//#if 1
594#ifdef DEBUGF5
595    Print("BEFORE REDUCTION WITH %d:\n",ii);
596    Print("--------------------------------\n");
597    pWrite(h->sig);
598    pWrite(strat->T[ii].sig);
599    pWrite(h->GetLmCurrRing());
600    pWrite(pHead(h->p1));
601    pWrite(pHead(h->p2));
602    pWrite(pHead(strat->T[ii].p));
603    Print("--------------------------------\n");
604    printf("INDEX OF REDUCER T: %d\n",ii);
605#endif
606    sigSafe = ksReducePolySig(h, &(strat->T[ii]), strat->S_2_R[ii], NULL, NULL, strat);
607    // if reduction has taken place, i.e. the reduction was sig-safe
608    // otherwise start is already at the next position and the loop
609    // searching reducers in T goes on from index start
610//#if 1
611#ifdef DEBUGF5
612    Print("SigSAFE: %d\n",sigSafe);
613#endif
614    if (sigSafe != 3)
615    {
616      // start the next search for reducers in T from the beginning
617      start = 0;
618#ifdef KDEBUG
619      if (TEST_OPT_DEBUG)
620      {
621        PrintS("\nto ");
622        h->wrp();
623        PrintLn();
624      }
625#endif
626
627      h_p = h->GetLmTailRing();
628      if (h_p == NULL)
629      {
630        if (h->lcm!=NULL) pLmFree(h->lcm);
631#ifdef KDEBUG
632        h->lcm=NULL;
633#endif
634        return 0;
635      }
636      h->SetShortExpVector();
637      not_sev = ~ h->sev;
638      /*
639      * try to reduce the s-polynomial h
640      *test first whether h should go to the lazyset L
641      *-if the degree jumps
642      *-if the number of pre-defined reductions jumps
643      */
644      pass++;
645      if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0) && (pass > strat->LazyPass))
646      {
647        h->SetLmCurrRing();
648        at = strat->posInL(strat->L,strat->Ll,h,strat);
649        if (at <= strat->Ll)
650        {
651          int dummy=strat->sl;
652          if (kFindDivisibleByInS(strat, &dummy, h) < 0)
653          {
654            return 1;
655          }
656          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
657#ifdef KDEBUG
658          if (TEST_OPT_DEBUG)
659            Print(" lazy: -> L%d\n",at);
660#endif
661          h->Clear();
662          return -1;
663        }
664      }
665    }
666  }
667}
668
669/*2
670*  reduction procedure for the inhomogeneous case
671*  and not a degree-ordering
672*/
673int redLazy (LObject* h,kStrategy strat)
674{
675  if (strat->tl<0) return 1;
676  int at,i,ii,li;
677  int j = 0;
678  int pass = 0;
679  assume(h->pFDeg() == h->FDeg);
680  long reddeg = h->GetpFDeg();
681  long d;
682  unsigned long not_sev;
683
684  h->SetShortExpVector();
685  poly h_p = h->GetLmTailRing();
686  not_sev = ~ h->sev;
687  loop
688  {
689    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
690    if (j < 0) return 1;
691
692    li = strat->T[j].pLength;
693    #if 0
694    if (li==0)
695    {
696      li=strat->T[j].pLength=pLength(strat->T[j].p);
697    }
698    #endif
699    ii = j;
700    /*
701     * the polynomial to reduce with (up to the moment) is;
702     * pi with length li
703     */
704
705    i = j;
706#if 1
707    if (TEST_OPT_LENGTH)
708    loop
709    {
710      /*- search the shortest possible with respect to length -*/
711      i++;
712      if (i > strat->tl)
713        break;
714      if (li<=1)
715        break;
716    #if 0
717      if (strat->T[i].pLength==0)
718      {
719        PrintS("!");
720        strat->T[i].pLength=pLength(strat->T[i].p);
721      }
722   #endif
723      if ((strat->T[i].pLength < li)
724         &&
725          p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i],
726                               h_p, not_sev, strat->tailRing))
727      {
728        /*
729         * the polynomial to reduce with is now;
730         */
731        PrintS("+");
732        li = strat->T[i].pLength;
733        ii = i;
734      }
735    }
736#endif
737
738    /*
739     * end of search: have to reduce with pi
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
753    ksReducePoly(h, &(strat->T[ii]), NULL, NULL, strat);
754
755#ifdef KDEBUG
756    if (TEST_OPT_DEBUG)
757    {
758      PrintS("\nto ");
759      h->wrp();
760      PrintLn();
761    }
762#endif
763
764    h_p=h->GetLmTailRing();
765
766    if (h_p == NULL)
767    {
768      if (h->lcm!=NULL) pLmFree(h->lcm);
769#ifdef KDEBUG
770      h->lcm=NULL;
771#endif
772      return 0;
773    }
774    h->SetShortExpVector();
775    not_sev = ~ h->sev;
776    d = h->SetpFDeg();
777    /*- try to reduce the s-polynomial -*/
778    pass++;
779    if (//!TEST_OPT_REDTHROUGH &&
780        (strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
781    {
782      h->SetLmCurrRing();
783      at = strat->posInL(strat->L,strat->Ll,h,strat);
784      if (at <= strat->Ll)
785      {
786#if 1
787        int dummy=strat->sl;
788        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
789          return 1;
790#endif
791#ifdef KDEBUG
792        if (TEST_OPT_DEBUG) Print(" ->L[%d]\n",at);
793#endif
794        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
795        h->Clear();
796        return -1;
797      }
798    }
799    else if (d != reddeg)
800    {
801      if (d>=strat->tailRing->bitmask)
802      {
803        if (h->pTotalDeg() >= strat->tailRing->bitmask)
804        {
805          strat->overflow=TRUE;
806          //Print("OVERFLOW in redLazy d=%ld, max=%ld\n",d,strat->tailRing->bitmask);
807          h->GetP();
808          at = strat->posInL(strat->L,strat->Ll,h,strat);
809          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
810          h->Clear();
811          return -1;
812        }
813      }
814      else if ((TEST_OPT_PROT) && (strat->Ll < 0))
815      {
816        Print(".%ld",d);mflush();
817        reddeg = d;
818      }
819    }
820  }
821}
822/*2
823*  reduction procedure for the sugar-strategy (honey)
824* reduces h with elements from T choosing first possible
825* element in T with respect to the given ecart
826*/
827int redHoney (LObject* h, kStrategy strat)
828{
829  if (strat->tl<0) return 1;
830  //if (h->GetLmTailRing()==NULL) return 0; // HS: SHOULD NOT BE NEEDED!
831  assume(h->FDeg == h->pFDeg());
832  poly h_p;
833  int i,j,at,pass,ei, ii, h_d;
834  unsigned long not_sev;
835  long reddeg,d;
836
837  pass = j = 0;
838  d = reddeg = h->GetpFDeg() + h->ecart;
839  h->SetShortExpVector();
840  int li;
841  h_p = h->GetLmTailRing();
842  not_sev = ~ h->sev;
843
844  h->PrepareRed(strat->use_buckets);
845  loop
846  {
847    j=kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
848    if (j < 0) return 1;
849
850    ei = strat->T[j].ecart;
851    li = strat->T[j].pLength;
852    ii = j;
853    /*
854     * the polynomial to reduce with (up to the moment) is;
855     * pi with ecart ei
856     */
857    i = j;
858    if (TEST_OPT_LENGTH)
859    loop
860    {
861      /*- takes the first possible with respect to ecart -*/
862      i++;
863      if (i > strat->tl)
864        break;
865      //if (ei < h->ecart)
866      //  break;
867      if (li<=1)
868        break;
869      if ((((strat->T[i].ecart < ei) && (ei> h->ecart))
870         || ((strat->T[i].ecart <= h->ecart) && (strat->T[i].pLength < li)))
871         &&
872          p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i],
873                               h_p, not_sev, strat->tailRing))
874      {
875        /*
876         * the polynomial to reduce with is now;
877         */
878        ei = strat->T[i].ecart;
879        li = strat->T[i].pLength;
880        ii = i;
881      }
882    }
883
884    /*
885     * end of search: have to reduce with pi
886     */
887    if (!TEST_OPT_REDTHROUGH && (pass!=0) && (ei > h->ecart))
888    {
889      h->GetTP(); // clears bucket
890      h->SetLmCurrRing();
891      /*
892       * It is not possible to reduce h with smaller ecart;
893       * if possible h goes to the lazy-set L,i.e
894       * if its position in L would be not the last one
895       */
896      if (strat->Ll >= 0) /* L is not empty */
897      {
898        at = strat->posInL(strat->L,strat->Ll,h,strat);
899        if(at <= strat->Ll)
900          /*- h will not become the next element to reduce -*/
901        {
902          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
903#ifdef KDEBUG
904          if (TEST_OPT_DEBUG) Print(" ecart too big: -> L%d\n",at);
905#endif
906          h->Clear();
907          return -1;
908        }
909      }
910    }
911#ifdef KDEBUG
912    if (TEST_OPT_DEBUG)
913    {
914      PrintS("red:");
915      h->wrp();
916      PrintS(" with ");
917      strat->T[ii].wrp();
918    }
919#endif
920    assume(strat->fromT == FALSE);
921
922    number coef;
923    ksReducePoly(h,&(strat->T[ii]),strat->kNoetherTail(),&coef,strat);
924#ifdef KDEBUG
925    if (TEST_OPT_DEBUG)
926    {
927      PrintS("\nto:");
928      h->wrp();
929      PrintLn();
930    }
931#endif
932    if(h->IsNull())
933    {
934      h->Clear();
935      if (h->lcm!=NULL) pLmFree(h->lcm);
936      #ifdef KDEBUG
937      h->lcm=NULL;
938      #endif
939      return 0;
940    }
941    h->SetShortExpVector();
942    not_sev = ~ h->sev;
943    h_d = h->SetpFDeg();
944    /* compute the ecart */
945    if (ei <= h->ecart)
946      h->ecart = d-h_d;
947    else
948      h->ecart = d-h_d+ei-h->ecart;
949
950    /*
951     * try to reduce the s-polynomial h
952     *test first whether h should go to the lazyset L
953     *-if the degree jumps
954     *-if the number of pre-defined reductions jumps
955     */
956    pass++;
957    d = h_d + h->ecart;
958    if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
959    {
960      h->GetTP(); // clear bucket
961      h->SetLmCurrRing();
962      at = strat->posInL(strat->L,strat->Ll,h,strat);
963      if (at <= strat->Ll)
964      {
965        int dummy=strat->sl;
966        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
967          return 1;
968        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
969#ifdef KDEBUG
970        if (TEST_OPT_DEBUG)
971          Print(" degree jumped: -> L%d\n",at);
972#endif
973        h->Clear();
974        return -1;
975      }
976    }
977    else if (d > reddeg)
978    {
979      if (d>=strat->tailRing->bitmask)
980      {
981        if (h->pTotalDeg()+h->ecart >= strat->tailRing->bitmask)
982        {
983          strat->overflow=TRUE;
984          //Print("OVERFLOW in redHoney d=%ld, max=%ld\n",d,strat->tailRing->bitmask);
985          h->GetP();
986          at = strat->posInL(strat->L,strat->Ll,h,strat);
987          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
988          h->Clear();
989          return -1;
990        }
991      }
992      else if (TEST_OPT_PROT && (strat->Ll < 0) )
993      {
994        //h->wrp(); Print("<%d>\n",h->GetpLength());
995        reddeg = d;
996        Print(".%ld",d); mflush();
997      }
998    }
999  }
1000}
1001
1002/*2
1003*  reduction procedure for the normal form
1004*/
1005
1006poly redNF (poly h,int &max_ind,int nonorm,kStrategy strat)
1007{
1008  if (h==NULL) return NULL;
1009  int j;
1010  max_ind=strat->sl;
1011
1012  if (0 > strat->sl)
1013  {
1014    return h;
1015  }
1016  LObject P(h);
1017  P.SetShortExpVector();
1018  P.bucket = kBucketCreate(currRing);
1019  kBucketInit(P.bucket,P.p,pLength(P.p));
1020  kbTest(P.bucket);
1021#ifdef HAVE_RINGS
1022  BOOLEAN is_ring = rField_is_Ring(currRing);
1023#endif
1024#ifdef KDEBUG
1025  if (TEST_OPT_DEBUG)
1026  {
1027    PrintS("redNF: starting S: ");
1028    for( j = 0; j <= max_ind; j++ )
1029    {
1030      Print("S[%d] (of size: %d): ", j, pSize(strat->S[j]));
1031      pWrite(strat->S[j]);
1032    }
1033  };
1034#endif
1035
1036  loop
1037  {
1038    j=kFindDivisibleByInS(strat,&max_ind,&P);
1039    if (j>=0)
1040    {
1041#ifdef HAVE_RINGS
1042      if (!is_ring)
1043      {
1044#endif
1045        int sl=pSize(strat->S[j]);
1046        int jj=j;
1047        loop
1048        {
1049          int sll;
1050          jj=kFindNextDivisibleByInS(strat,jj+1,max_ind,&P);
1051          if (jj<0) break;
1052          sll=pSize(strat->S[jj]);
1053          if (sll<sl)
1054          {
1055            #ifdef KDEBUG
1056            if (TEST_OPT_DEBUG) Print("better(S%d:%d -> S%d:%d)\n",j,sl,jj,sll);
1057            #endif
1058            //else if (TEST_OPT_PROT) { PrintS("b"); mflush(); }
1059            j=jj;
1060            sl=sll;
1061          }
1062        }
1063        if ((nonorm==0) && (!nIsOne(pGetCoeff(strat->S[j]))))
1064        {
1065          pNorm(strat->S[j]);
1066          //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
1067        }
1068#ifdef HAVE_RINGS
1069      }
1070#endif
1071      nNormalize(pGetCoeff(P.p));
1072#ifdef KDEBUG
1073      if (TEST_OPT_DEBUG)
1074      {
1075        PrintS("red:");
1076        wrp(h);
1077        PrintS(" with ");
1078        wrp(strat->S[j]);
1079      }
1080#endif
1081#ifdef HAVE_PLURAL
1082      if (rIsPluralRing(currRing))
1083      {
1084        number coef;
1085        nc_kBucketPolyRed(P.bucket,strat->S[j],&coef);
1086        nDelete(&coef);
1087      }
1088      else
1089#endif
1090      {
1091        number coef;
1092        coef=kBucketPolyRed(P.bucket,strat->S[j],pLength(strat->S[j]),strat->kNoether);
1093        nDelete(&coef);
1094      }
1095      h = kBucketGetLm(P.bucket);   // FRAGE OLIVER
1096      if (h==NULL)
1097      {
1098        kBucketDestroy(&P.bucket);
1099
1100#ifdef KDEBUG
1101        if (TEST_OPT_DEBUG)
1102        {
1103          PrintS("redNF: starting S: ");
1104          for( j = 0; j <= max_ind; j++ )
1105          {
1106            Print("S[%d] (of size: %d): ", j, pSize(strat->S[j]));
1107            pWrite(strat->S[j]);
1108          }
1109        };
1110#endif
1111
1112        return NULL;
1113      }
1114      kbTest(P.bucket);
1115      P.p=h;
1116      P.t_p=NULL;
1117      P.SetShortExpVector();
1118#ifdef KDEBUG
1119      if (TEST_OPT_DEBUG)
1120      {
1121        PrintS("\nto:");
1122        wrp(h);
1123        PrintLn();
1124      }
1125#endif
1126    }
1127    else
1128    {
1129      P.p=kBucketClear(P.bucket);
1130      kBucketDestroy(&P.bucket);
1131      pNormalize(P.p);
1132
1133#ifdef KDEBUG
1134      if (TEST_OPT_DEBUG)
1135      {
1136        PrintS("redNF: starting S: ");
1137        for( j = 0; j <= max_ind; j++ )
1138        {
1139          Print("S[%d] (of size: %d): ", j, pSize(strat->S[j]));
1140          pWrite(strat->S[j]);
1141        }
1142      };
1143#endif
1144
1145      return P.p;
1146    }
1147  }
1148}
1149
1150#ifdef KDEBUG
1151static int bba_count = 0;
1152#endif /* KDEBUG */
1153void kDebugPrint(kStrategy strat);
1154
1155ideal bba (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
1156{
1157#ifdef KDEBUG
1158  bba_count++;
1159  int loop_count = 0;
1160#endif /* KDEBUG */
1161  om_Opts.MinTrack = 5;
1162  int   red_result = 1;
1163  int   olddeg,reduc;
1164  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1165  BOOLEAN withT = FALSE;
1166
1167  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1168  initBuchMoraPos(strat);
1169  initHilbCrit(F,Q,&hilb,strat);
1170  initBba(F,strat);
1171  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1172  /*Shdl=*/initBuchMora(F, Q,strat);
1173  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
1174  reduc = olddeg = 0;
1175
1176#ifndef NO_BUCKETS
1177  if (!TEST_OPT_NOT_BUCKETS)
1178    strat->use_buckets = 1;
1179#endif
1180
1181  // redtailBBa against T for inhomogenous input
1182  if (!TEST_OPT_OLDSTD)
1183    withT = ! strat->homog;
1184
1185  // strat->posInT = posInT_pLength;
1186  kTest_TS(strat);
1187
1188#ifdef KDEBUG
1189#if MYTEST
1190  if (TEST_OPT_DEBUG)
1191  {
1192    PrintS("bba start GB: currRing: ");
1193    // rWrite(currRing);PrintLn();
1194    rDebugPrint(currRing);
1195    PrintLn();
1196  }
1197#endif /* MYTEST */
1198#endif /* KDEBUG */
1199
1200#ifdef HAVE_TAIL_RING
1201  if(!idIs0(F) &&(!rField_is_Ring(currRing)))  // create strong gcd poly computes with tailring and S[i] ->to be fixed
1202    kStratInitChangeTailRing(strat);
1203#endif
1204  if (BVERBOSE(23))
1205  {
1206    if (test_PosInT!=NULL) strat->posInT=test_PosInT;
1207    if (test_PosInL!=NULL) strat->posInL=test_PosInL;
1208    kDebugPrint(strat);
1209  }
1210
1211
1212#ifdef KDEBUG
1213  //kDebugPrint(strat);
1214#endif
1215  /* compute------------------------------------------------------- */
1216  while (strat->Ll >= 0)
1217  {
1218    #ifdef KDEBUG
1219      loop_count++;
1220      if (TEST_OPT_DEBUG) messageSets(strat);
1221    #endif
1222    if (strat->Ll== 0) strat->interpt=TRUE;
1223    if (TEST_OPT_DEGBOUND
1224        && ((strat->honey && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1225            || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1226    {
1227      /*
1228       *stops computation if
1229       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1230       *a predefined number Kstd1_deg
1231       */
1232      while ((strat->Ll >= 0)
1233        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1234        && ((strat->honey && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1235            || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1236        )
1237        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1238      if (strat->Ll<0) break;
1239      else strat->noClearS=TRUE;
1240    }
1241    /* picks the last element from the lazyset L */
1242    strat->P = strat->L[strat->Ll];
1243    strat->Ll--;
1244
1245    if (pNext(strat->P.p) == strat->tail)
1246    {
1247      // deletes the short spoly
1248#ifdef HAVE_RINGS
1249      if (rField_is_Ring(currRing))
1250        pLmDelete(strat->P.p);
1251      else
1252#endif
1253        pLmFree(strat->P.p);
1254      strat->P.p = NULL;
1255      poly m1 = NULL, m2 = NULL;
1256
1257      // check that spoly creation is ok
1258      while (strat->tailRing != currRing &&
1259             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1260      {
1261        assume(m1 == NULL && m2 == NULL);
1262        // if not, change to a ring where exponents are at least
1263        // large enough
1264        if (!kStratChangeTailRing(strat))
1265        {
1266          WerrorS("OVERFLOW...");
1267          break;
1268        }
1269      }
1270      // create the real one
1271      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
1272                    strat->tailRing, m1, m2, strat->R);
1273    }
1274    else if (strat->P.p1 == NULL)
1275    {
1276      if (strat->minim > 0)
1277        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1278      // for input polys, prepare reduction
1279      strat->P.PrepareRed(strat->use_buckets);
1280    }
1281
1282    if (strat->P.p == NULL && strat->P.t_p == NULL)
1283    {
1284      red_result = 0;
1285    }
1286    else
1287    {
1288      if (TEST_OPT_PROT)
1289        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1290                &olddeg,&reduc,strat, red_result);
1291
1292      /* reduction of the element choosen from L */
1293      red_result = strat->red(&strat->P,strat);
1294      if (errorreported)  break;
1295    }
1296
1297    if (strat->overflow)
1298    {
1299        if (!kStratChangeTailRing(strat)) { Werror("OVERFLOW.."); break;}
1300    }
1301
1302    // reduction to non-zero new poly
1303    if (red_result == 1)
1304    {
1305      // get the polynomial (canonicalize bucket, make sure P.p is set)
1306      strat->P.GetP(strat->lmBin);
1307      // in the homogeneous case FDeg >= pFDeg (sugar/honey)
1308      // but now, for entering S, T, we reset it
1309      // in the inhomogeneous case: FDeg == pFDeg
1310      if (strat->homog) strat->initEcart(&(strat->P));
1311
1312      /* statistic */
1313      if (TEST_OPT_PROT) PrintS("s");
1314
1315      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1316
1317#ifdef KDEBUG
1318#if MYTEST
1319      PrintS("New S: "); p_DebugPrint(strat->P.p, currRing); PrintLn();
1320#endif /* MYTEST */
1321#endif /* KDEBUG */
1322
1323      // reduce the tail and normalize poly
1324      // in the ring case we cannot expect LC(f) = 1,
1325      // therefore we call pContent instead of pNorm
1326      if ((TEST_OPT_INTSTRATEGY) || (rField_is_Ring(currRing)))
1327      {
1328        strat->P.pCleardenom();
1329        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1330        {
1331          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1332          strat->P.pCleardenom();
1333        }
1334      }
1335      else
1336      {
1337        strat->P.pNorm();
1338        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1339          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1340      }
1341
1342#ifdef KDEBUG
1343      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1344#if MYTEST
1345      PrintS("New (reduced) S: "); p_DebugPrint(strat->P.p, currRing); PrintLn();
1346#endif /* MYTEST */
1347#endif /* KDEBUG */
1348
1349      // min_std stuff
1350      if ((strat->P.p1==NULL) && (strat->minim>0))
1351      {
1352        if (strat->minim==1)
1353        {
1354          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1355          p_Delete(&strat->P.p2, currRing, strat->tailRing);
1356        }
1357        else
1358        {
1359          strat->M->m[minimcnt]=strat->P.p2;
1360          strat->P.p2=NULL;
1361        }
1362        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1363          pNext(strat->M->m[minimcnt])
1364            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1365                                           strat->tailRing, currRing,
1366                                           currRing->PolyBin);
1367        minimcnt++;
1368      }
1369
1370      // enter into S, L, and T
1371      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1372        enterT(strat->P, strat);
1373#ifdef HAVE_RINGS
1374      if (rField_is_Ring(currRing))
1375        superenterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1376      else
1377#endif
1378        enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1379      // posInS only depends on the leading term
1380      strat->enterS(strat->P, pos, strat, strat->tl);
1381#if 0
1382      int pl=pLength(strat->P.p);
1383      if (pl==1)
1384      {
1385        //if (TEST_OPT_PROT)
1386        //PrintS("<1>");
1387      }
1388      else if (pl==2)
1389      {
1390        //if (TEST_OPT_PROT)
1391        //PrintS("<2>");
1392      }
1393#endif
1394      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1395//      Print("[%d]",hilbeledeg);
1396      if (strat->P.lcm!=NULL)
1397#ifdef HAVE_RINGS
1398        pLmDelete(strat->P.lcm);
1399#else
1400        pLmFree(strat->P.lcm);
1401#endif
1402    }
1403    else if (strat->P.p1 == NULL && strat->minim > 0)
1404    {
1405      p_Delete(&strat->P.p2, currRing, strat->tailRing);
1406    }
1407
1408#ifdef KDEBUG
1409    memset(&(strat->P), 0, sizeof(strat->P));
1410#endif /* KDEBUG */
1411    kTest_TS(strat);
1412  }
1413#ifdef KDEBUG
1414#if MYTEST
1415  PrintS("bba finish GB: currRing: "); rWrite(currRing);
1416#endif /* MYTEST */
1417  if (TEST_OPT_DEBUG) messageSets(strat);
1418#endif /* KDEBUG */
1419
1420  if (TEST_OPT_SB_1)
1421  {
1422    int k=1;
1423    int j;
1424    while(k<=strat->sl)
1425    {
1426      j=0;
1427      loop
1428      {
1429        if (j>=k) break;
1430        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1431        j++;
1432      }
1433      k++;
1434    }
1435  }
1436
1437  /* complete reduction of the standard basis--------- */
1438  if (TEST_OPT_REDSB)
1439  {
1440    completeReduce(strat);
1441#ifdef HAVE_TAIL_RING
1442    if (strat->completeReduce_retry)
1443    {
1444      // completeReduce needed larger exponents, retry
1445      // to reduce with S (instead of T)
1446      // and in currRing (instead of strat->tailRing)
1447      cleanT(strat);strat->tailRing=currRing;
1448      int i;
1449      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1450      completeReduce(strat);
1451    }
1452#endif
1453  }
1454  else if (TEST_OPT_PROT) PrintLn();
1455
1456  /* release temp data-------------------------------- */
1457  exitBuchMora(strat);
1458//  if (TEST_OPT_WEIGHTM)
1459//  {
1460//    pRestoreDegProcs(currRing,pFDegOld, pLDegOld);
1461//    if (ecartWeights)
1462//    {
1463//      omFreeSize((ADDRESS)ecartWeights,((currRing->N)+1)*sizeof(short));
1464//      ecartWeights=NULL;
1465//    }
1466//  }
1467  if (TEST_OPT_PROT) messageStat(hilbcount,strat);
1468  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1469
1470#ifdef KDEBUG
1471#if MYTEST
1472  PrintS("bba_end: currRing: "); rWrite(currRing);
1473#endif /* MYTEST */
1474#endif /* KDEBUG */
1475  idTest(strat->Shdl);
1476
1477  return (strat->Shdl);
1478}
1479ideal sba (ideal F0, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
1480{
1481  // ring order stuff:
1482  // in sba we have (until now) two possibilities:
1483  // 1. an incremental computation w.r.t. (C,monomial order)
1484  // 2. a (possibly non-incremental) computation w.r.t. the
1485  //    induced Schreyer order.
1486  // The corresponding orders are computed in sbaRing(), depending
1487  // on the flag strat->incremental
1488  ideal F = F0;
1489  ring sRing, currRingOld;
1490  currRingOld  = currRing; 
1491  if (strat->incremental)
1492  {
1493    sRing = sbaRing(strat);
1494    if (sRing!=currRingOld)
1495    {
1496      rChangeCurrRing (sRing);
1497      F = idrMoveR (F0, currRingOld, currRing);
1498    }
1499  }
1500#if 0
1501  printf("SBA COMPUTATIONS DONE IN THE FOLLOWING RING:\n");
1502  rWrite (currRing);
1503  printf("\n");
1504#endif
1505#ifdef KDEBUG
1506  bba_count++;
1507  int loop_count = 0;
1508#endif /* KDEBUG */
1509  om_Opts.MinTrack = 5;
1510  int   srmax,lrmax, red_result = 1;
1511  int   olddeg,reduc;
1512  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1513  long zeroreductions = 0;
1514  LObject L;
1515  BOOLEAN withT     = FALSE;
1516  strat->max_lower_index = 0;
1517
1518  //initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1519  initSbaCrit(strat); /*set Gebauer, honey, sugarCrit*/
1520  initSbaPos(strat);
1521  //initBuchMoraPos(strat);
1522  initHilbCrit(F,Q,&hilb,strat);
1523  initSba(F,strat);
1524  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1525  /*Shdl=*/initSbaBuchMora(F, Q,strat);
1526  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
1527  srmax = strat->sl;
1528  reduc = olddeg = lrmax = 0;
1529
1530#ifndef NO_BUCKETS
1531  if (!TEST_OPT_NOT_BUCKETS)
1532    strat->use_buckets = 1;
1533#endif
1534
1535  // redtailBBa against T for inhomogenous input
1536  if (!TEST_OPT_OLDSTD)
1537    withT = ! strat->homog;
1538
1539  // strat->posInT = posInT_pLength;
1540  kTest_TS(strat);
1541
1542#ifdef KDEBUG
1543#if MYTEST
1544  if (TEST_OPT_DEBUG)
1545  {
1546    PrintS("bba start GB: currRing: ");
1547    // rWrite(currRing);PrintLn();
1548    rDebugPrint(currRing);
1549    PrintLn();
1550  }
1551#endif /* MYTEST */
1552#endif /* KDEBUG */
1553
1554#ifdef HAVE_TAIL_RING
1555  if(!idIs0(F) &&(!rField_is_Ring(currRing)))  // create strong gcd poly computes with tailring and S[i] ->to be fixed
1556    kStratInitChangeTailRing(strat);
1557#endif
1558  if (BVERBOSE(23))
1559  {
1560    if (test_PosInT!=NULL) strat->posInT=test_PosInT;
1561    if (test_PosInL!=NULL) strat->posInL=test_PosInL;
1562    kDebugPrint(strat);
1563  }
1564
1565
1566#ifdef KDEBUG
1567  //kDebugPrint(strat);
1568#endif
1569  /* compute------------------------------------------------------- */
1570  while (strat->Ll >= 0)
1571  {
1572    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1573    #ifdef KDEBUG
1574      loop_count++;
1575      if (TEST_OPT_DEBUG) messageSets(strat);
1576    #endif
1577    if (strat->Ll== 0) strat->interpt=TRUE;
1578    if (TEST_OPT_DEGBOUND
1579        && ((strat->honey && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1580            || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1581    {
1582      /*
1583       *stops computation if
1584       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1585       *a predefined number Kstd1_deg
1586       */
1587      while ((strat->Ll >= 0)
1588        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1589        && ((strat->honey && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1590            || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1591        )
1592        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1593      if (strat->Ll<0) break;
1594      else strat->noClearS=TRUE;
1595    }
1596    if (strat->incremental && pGetComp(strat->L[strat->Ll].sig) != strat->currIdx)
1597    {
1598      strat->currIdx  = pGetComp(strat->L[strat->Ll].sig);
1599#if F5C
1600      // 1. interreduction of the current standard basis
1601      // 2. generation of new principal syzygy rules for syzCriterion
1602      f5c ( strat, olddeg, minimcnt, hilbeledeg, hilbcount, srmax, 
1603            lrmax, reduc, Q, w, hilb );
1604#endif
1605      // initialize new syzygy rules for the next iteration step 
1606      initSyzRules(strat);
1607    }
1608    /*********************************************************************
1609     * interrreduction step is done, we can go on with the next iteration
1610     * step of the signature-based algorithm
1611     ********************************************************************/
1612    /* picks the last element from the lazyset L */
1613    strat->P = strat->L[strat->Ll];
1614    strat->Ll--;
1615//#if 1
1616#ifdef DEBUGF5
1617    Print("SIG OF NEXT PAIR TO HANDLE IN SIG-BASED ALGORITHM\n");
1618    Print("-------------------------------------------------\n");
1619    pWrite(strat->P.sig);
1620    pWrite(pHead(strat->P.p));
1621    pWrite(pHead(strat->P.p1));
1622    pWrite(pHead(strat->P.p2));
1623    Print("-------------------------------------------------\n");
1624#endif
1625    if (pNext(strat->P.p) == strat->tail)
1626    {
1627      // deletes the short spoly
1628#ifdef HAVE_RINGS
1629      if (rField_is_Ring(currRing))
1630        pLmDelete(strat->P.p);
1631      else
1632#endif
1633        pLmFree(strat->P.p);
1634
1635      // TODO: needs some masking
1636      // TODO: masking needs to vanish once the signature
1637      //       sutff is completely implemented
1638      strat->P.p = NULL;
1639      poly m1 = NULL, m2 = NULL;
1640
1641      // check that spoly creation is ok
1642      while (strat->tailRing != currRing &&
1643             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1644      {
1645        assume(m1 == NULL && m2 == NULL);
1646        // if not, change to a ring where exponents are at least
1647        // large enough
1648        if (!kStratChangeTailRing(strat))
1649        {
1650          WerrorS("OVERFLOW...");
1651          break;
1652        }
1653      }
1654      // create the real one
1655      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
1656                    strat->tailRing, m1, m2, strat->R);
1657
1658    }
1659    else if (strat->P.p1 == NULL)
1660    {
1661      if (strat->minim > 0)
1662        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1663      // for input polys, prepare reduction
1664      strat->P.PrepareRed(strat->use_buckets);
1665    }
1666
1667    if (strat->P.p == NULL && strat->P.t_p == NULL)
1668    {
1669      red_result = 0;
1670    }
1671    else
1672    {
1673      if (TEST_OPT_PROT)
1674        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1675                &olddeg,&reduc,strat, red_result);
1676
1677//#if 1
1678#ifdef DEBUGF5
1679      Print("Poly before red: ");
1680      pWrite(strat->P.p);
1681#endif
1682      /* reduction of the element choosen from L */
1683      if (!strat->rewCrit2(strat->P.sig, ~strat->P.sevSig, strat, strat->P.checked+1))
1684        red_result = strat->red(&strat->P,strat);
1685      else
1686      {
1687        if (strat->P.lcm!=NULL)
1688          pLmFree(strat->P.lcm);
1689        red_result = 2;
1690      }
1691      if (errorreported)  break;
1692    }
1693
1694    if (strat->overflow)
1695    {
1696        if (!kStratChangeTailRing(strat)) { Werror("OVERFLOW.."); break;}
1697    }
1698    if (strat->incremental)
1699    {
1700      for (int jj = 0; jj<strat->tl+1; jj++)
1701      {
1702        if (pGetComp(strat->T[jj].sig) == strat->currIdx)
1703        {
1704          strat->T[jj].is_sigsafe = FALSE;
1705        }
1706      }
1707    }
1708    else
1709    {
1710      for (int jj = 0; jj<strat->tl+1; jj++)
1711      {
1712        strat->T[jj].is_sigsafe = FALSE;
1713      }
1714    }
1715
1716    // reduction to non-zero new poly
1717    if (red_result == 1)
1718    {
1719      // get the polynomial (canonicalize bucket, make sure P.p is set)
1720      strat->P.GetP(strat->lmBin);
1721     
1722      // sig-safe computations may lead to wrong FDeg computation, thus we need
1723      // to recompute it to make sure everything is alright
1724      (strat->P).FDeg = (strat->P).pFDeg();
1725      // in the homogeneous case FDeg >= pFDeg (sugar/honey)
1726      // but now, for entering S, T, we reset it
1727      // in the inhomogeneous case: FDeg == pFDeg
1728      if (strat->homog) strat->initEcart(&(strat->P));
1729
1730      /* statistic */
1731      if (TEST_OPT_PROT) PrintS("s");
1732
1733      //int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1734      // in F5E we know that the last reduced element is already the
1735      // the one with highest signature
1736      int pos = strat->sl+1;
1737
1738#ifdef KDEBUG
1739#if MYTEST
1740      PrintS("New S: "); pDebugPrint(strat->P.p); PrintLn();
1741#endif /* MYTEST */
1742#endif /* KDEBUG */
1743
1744      // reduce the tail and normalize poly
1745      // in the ring case we cannot expect LC(f) = 1,
1746      // therefore we call pContent instead of pNorm
1747      /*
1748      if ((TEST_OPT_INTSTRATEGY) || (rField_is_Ring(currRing)))
1749      {
1750        strat->P.pCleardenom();
1751        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1752        {
1753          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1754          strat->P.pCleardenom();
1755        }
1756      }
1757      else
1758      {
1759        strat->P.pNorm();
1760        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1761          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1762      }
1763      */
1764#ifdef KDEBUG
1765      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1766#if MYTEST
1767//#if 1
1768      PrintS("New (reduced) S: "); pDebugPrint(strat->P.p); PrintLn();
1769#endif /* MYTEST */
1770#endif /* KDEBUG */
1771
1772      // min_std stuff
1773      if ((strat->P.p1==NULL) && (strat->minim>0))
1774      {
1775        if (strat->minim==1)
1776        {
1777          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1778          p_Delete(&strat->P.p2, currRing, strat->tailRing);
1779        }
1780        else
1781        {
1782          strat->M->m[minimcnt]=strat->P.p2;
1783          strat->P.p2=NULL;
1784        }
1785        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1786          pNext(strat->M->m[minimcnt])
1787            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1788                                           strat->tailRing, currRing,
1789                                           currRing->PolyBin);
1790        minimcnt++;
1791      }
1792
1793      // enter into S, L, and T
1794      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1795      if(!strat->incremental)
1796      {
1797        BOOLEAN overwrite = TRUE;
1798        for (int tk=0; tk<strat->sl+1; tk++)
1799        {
1800          if (pGetComp(strat->sig[tk]) == pGetComp(strat->P.sig))
1801          {
1802            //printf("TK %d / %d\n",tk,strat->sl);
1803            overwrite = FALSE;
1804            break;
1805          }
1806        }
1807        //printf("OVERWRITE %d\n",overwrite);
1808        if (overwrite)
1809        {
1810          int cmp = pGetComp(strat->P.sig);
1811          int* vv = (int*)omAlloc((currRing->N+1)*sizeof(int));
1812          pGetExpV (strat->P.p,vv);
1813          pSetExpV (strat->P.sig, vv);
1814          pSetComp (strat->P.sig,cmp);
1815
1816          strat->P.sevSig = pGetShortExpVector (strat->P.sig);
1817          for(int ps=0;ps<strat->sl+1;ps++)
1818          {
1819            int i = strat->syzl;
1820
1821            strat->newt = TRUE;
1822            if (strat->syzl == strat->syzmax)
1823            {
1824              pEnlargeSet(&strat->syz,strat->syzmax,setmaxTinc);
1825              strat->sevSyz = (unsigned long*) omRealloc0Size(strat->sevSyz,
1826                  (strat->syzmax)*sizeof(unsigned long),
1827                  ((strat->syzmax)+setmaxTinc)
1828                  *sizeof(unsigned long));
1829              strat->syzmax += setmaxTinc;
1830            }
1831            strat->syz[i] = pCopy(strat->P.sig);
1832            // add LM(F->m[i]) to the signature to get a Schreyer order
1833            // without changing the underlying polynomial ring at all
1834            p_ExpVectorAdd (strat->syz[i],strat->S[ps],currRing); 
1835            // since p_Add_q() destroys all input
1836            // data we need to recreate help
1837            // each time
1838            // ----------------------------------------------------------
1839            // in the Schreyer order we always know that the multiplied
1840            // module monomial strat->P.sig gives the leading monomial of
1841            // the corresponding principal syzygy
1842            // => we do not need to compute the "real" syzygy completely
1843            poly help = pCopy(strat->sig[ps]);
1844            p_ExpVectorAdd (help,strat->P.p,currRing); 
1845            strat->syz[i] = p_Add_q(strat->syz[i],help,currRing);
1846            //printf("%d. SYZ  ",i+1);
1847            //pWrite(strat->syz[i]);
1848            strat->sevSyz[i] = p_GetShortExpVector(strat->syz[i],currRing);
1849            strat->syzl++;
1850          }
1851        }
1852      }
1853        enterT(strat->P, strat);
1854        strat->T[strat->tl].is_sigsafe = FALSE;
1855#ifdef HAVE_RINGS
1856      if (rField_is_Ring(currRing))
1857        superenterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1858      else
1859#endif
1860        enterpairsSig(strat->P.p,strat->P.sig,strat->sl+1,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1861      // posInS only depends on the leading term
1862      strat->enterS(strat->P, pos, strat, strat->tl);
1863//#if 1
1864#if DEBUGF50
1865    printf("---------------------------\n");
1866    Print(" %d. ELEMENT ADDED TO GCURR:\n",strat->sl+1);
1867    Print("LEAD POLY:  "); pWrite(pHead(strat->S[strat->sl]));
1868    Print("SIGNATURE:  "); pWrite(strat->sig[strat->sl]);
1869#endif
1870      /*
1871      if (newrules)
1872      {
1873        newrules  = FALSE;
1874      }
1875      */
1876#if 0
1877      int pl=pLength(strat->P.p);
1878      if (pl==1)
1879      {
1880        //if (TEST_OPT_PROT)
1881        //PrintS("<1>");
1882      }
1883      else if (pl==2)
1884      {
1885        //if (TEST_OPT_PROT)
1886        //PrintS("<2>");
1887      }
1888#endif
1889      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1890//      Print("[%d]",hilbeledeg);
1891      if (strat->P.lcm!=NULL)
1892#ifdef HAVE_RINGS
1893        pLmDelete(strat->P.lcm);
1894#else
1895        pLmFree(strat->P.lcm);
1896#endif
1897      if (strat->sl>srmax) srmax = strat->sl;
1898    }
1899    else
1900    {
1901      // adds signature of the zero reduction to
1902      // strat->syz. This is the leading term of
1903      // syzygy and can be used in syzCriterion()
1904      // the signature is added if and only if the
1905      // pair was not detected by the rewritten criterion in strat->red = redSig
1906      if (red_result!=2) {
1907        zeroreductions++;
1908        enterSyz(strat->P,strat);
1909//#if 1
1910#ifdef DEBUGF5
1911        Print("ADDING STUFF TO SYZ :  ");
1912        pWrite(strat->P.p);
1913        pWrite(strat->P.sig);
1914#endif
1915      }
1916      if (strat->P.p1 == NULL && strat->minim > 0)
1917      {
1918        p_Delete(&strat->P.p2, currRing, strat->tailRing);
1919      }
1920    }
1921
1922#ifdef KDEBUG
1923    memset(&(strat->P), 0, sizeof(strat->P));
1924#endif /* KDEBUG */
1925    kTest_TS(strat);
1926  }
1927#ifdef KDEBUG
1928#if MYTEST
1929  PrintS("bba finish GB: currRing: "); rWrite(currRing);
1930#endif /* MYTEST */
1931  if (TEST_OPT_DEBUG) messageSets(strat);
1932#endif /* KDEBUG */
1933
1934  if (TEST_OPT_SB_1)
1935  {
1936    int k=1;
1937    int j;
1938    while(k<=strat->sl)
1939    {
1940      j=0;
1941      loop
1942      {
1943        if (j>=k) break;
1944        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1945        j++;
1946      }
1947      k++;
1948    }
1949  }
1950
1951  /* complete reduction of the standard basis--------- */
1952  if (TEST_OPT_REDSB)
1953  {
1954    completeReduce(strat);
1955#ifdef HAVE_TAIL_RING
1956    if (strat->completeReduce_retry)
1957    {
1958      // completeReduce needed larger exponents, retry
1959      // to reduce with S (instead of T)
1960      // and in currRing (instead of strat->tailRing)
1961      cleanT(strat);strat->tailRing=currRing;
1962      int i;
1963      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1964      completeReduce(strat);
1965    }
1966#endif
1967  }
1968  else if (TEST_OPT_PROT) PrintLn();
1969
1970  exitSba(strat);
1971//  if (TEST_OPT_WEIGHTM)
1972//  {
1973//    pRestoreDegProcs(pFDegOld, pLDegOld);
1974//    if (ecartWeights)
1975//    {
1976//      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1977//      ecartWeights=NULL;
1978//    }
1979//  }
1980  if (TEST_OPT_PROT) messageStat(hilbcount,strat);
1981  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1982
1983#ifdef KDEBUG
1984#if MYTEST
1985  PrintS("bba_end: currRing: "); rWrite(currRing);
1986#endif /* MYTEST */
1987#endif /* KDEBUG */
1988  // using F5C it is possible that there is some data stored in the last
1989  // entries of strat->Shdl which are dirty, i.e. not correct, but also not NULL
1990  // => we need to delete them before return the ideal
1991#if F5C
1992  for(int i=strat->sl+1;i<IDELEMS(strat->Shdl);i++)
1993  {
1994    //pDelete (&strat->Shdl->m[i]);
1995    strat->Shdl->m[i] = NULL;
1996  }
1997#endif
1998  if (strat->incremental && sRing!=currRingOld)
1999  {
2000    rChangeCurrRing (currRingOld);
2001    F0          = idrMoveR (F, sRing, currRing);
2002    strat->Shdl = idrMoveR_NoSort (strat->Shdl, sRing, currRing);
2003    rDelete (sRing);
2004  }
2005  idTest(strat->Shdl);
2006
2007#ifdef DEBUGF5
2008  printf("SIZE OF SHDL: %d\n",IDELEMS(strat->Shdl));
2009  int oo = 0;
2010  while (oo<IDELEMS(strat->Shdl))
2011  {
2012    printf(" %d.   ",oo+1);
2013    pWrite(pHead(strat->Shdl->m[oo]));
2014    oo++;
2015  }
2016#endif
2017  printf("ZERO REDUCTIONS: %ld\n",zeroreductions);
2018  zeroreductions  = 0;
2019  return (strat->Shdl);
2020}
2021
2022poly kNF2 (ideal F,ideal Q,poly q,kStrategy strat, int lazyReduce)
2023{
2024  assume(q!=NULL);
2025  assume(!(idIs0(F)&&(Q==NULL))); // NF(q, std(0) in polynomial ring?
2026
2027// lazy_reduce flags: can be combined by |
2028//#define KSTD_NF_LAZY   1
2029  // do only a reduction of the leading term
2030//#define KSTD_NF_NONORM 4
2031  // only global: avoid normalization, return a multiply of NF
2032  poly   p;
2033  int   i;
2034
2035  //if ((idIs0(F))&&(Q==NULL))
2036  //  return pCopy(q); /*F=0*/
2037  //strat->ak = idRankFreeModule(F);
2038  /*- creating temp data structures------------------- -*/
2039  BITSET save_test=test;
2040  test|=Sy_bit(OPT_REDTAIL);
2041  initBuchMoraCrit(strat);
2042  strat->initEcart = initEcartBBA;
2043  strat->enterS = enterSBba;
2044#ifndef NO_BUCKETS
2045  strat->use_buckets = (!TEST_OPT_NOT_BUCKETS) && (!rIsPluralRing(currRing));
2046#endif
2047  /*- set S -*/
2048  strat->sl = -1;
2049  /*- init local data struct.---------------------------------------- -*/
2050  /*Shdl=*/initS(F,Q,strat);
2051  /*- compute------------------------------------------------------- -*/
2052  //if ((TEST_OPT_INTSTRATEGY)&&(lazyReduce==0))
2053  //{
2054  //  for (i=strat->sl;i>=0;i--)
2055  //    pNorm(strat->S[i]);
2056  //}
2057  kTest(strat);
2058  if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
2059  if (BVERBOSE(23)) kDebugPrint(strat);
2060  int max_ind;
2061  p = redNF(pCopy(q),max_ind,lazyReduce & KSTD_NF_NONORM,strat);
2062  if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
2063  {
2064    if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
2065    #ifdef HAVE_RINGS
2066    if (rField_is_Ring(currRing))
2067    {
2068      p = redtailBba_Z(p,max_ind,strat);
2069    }
2070    else
2071    #endif
2072    {
2073      BITSET save=test;
2074      test &= ~Sy_bit(OPT_INTSTRATEGY);
2075      p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
2076      test=save;
2077    }
2078  }
2079  /*- release temp data------------------------------- -*/
2080  omfree(strat->sevS);
2081  omfree(strat->ecartS);
2082  omfree(strat->T);
2083  omfree(strat->sevT);
2084  omfree(strat->R);
2085  omfree(strat->S_2_R);
2086  omfree(strat->L);
2087  omfree(strat->B);
2088  omfree(strat->fromQ);
2089  idDelete(&strat->Shdl);
2090  test=save_test;
2091  if (TEST_OPT_PROT) PrintLn();
2092  return p;
2093}
2094
2095ideal kNF2 (ideal F,ideal Q,ideal q,kStrategy strat, int lazyReduce)
2096{
2097  assume(!idIs0(q));
2098  assume(!(idIs0(F)&&(Q==NULL)));
2099// lazy_reduce flags: can be combined by |
2100//#define KSTD_NF_LAZY   1
2101  // do only a reduction of the leading term
2102//#define KSTD_NF_NONORM 4
2103  // only global: avoid normalization, return a multiply of NF
2104  poly   p;
2105  int   i;
2106  ideal res;
2107  int max_ind;
2108
2109  //if (idIs0(q))
2110  //  return idInit(IDELEMS(q),si_max(q->rank,F->rank));
2111  //if ((idIs0(F))&&(Q==NULL))
2112  //  return idCopy(q); /*F=0*/
2113  //strat->ak = idRankFreeModule(F);
2114  /*- creating temp data structures------------------- -*/
2115  BITSET save_test=test;
2116  test|=Sy_bit(OPT_REDTAIL);
2117  initBuchMoraCrit(strat);
2118  strat->initEcart = initEcartBBA;
2119  strat->enterS = enterSBba;
2120  /*- set S -*/
2121  strat->sl = -1;
2122#ifndef NO_BUCKETS
2123  strat->use_buckets = (!TEST_OPT_NOT_BUCKETS) && (!rIsPluralRing(currRing));
2124#endif
2125  /*- init local data struct.---------------------------------------- -*/
2126  /*Shdl=*/initS(F,Q,strat);
2127  /*- compute------------------------------------------------------- -*/
2128  res=idInit(IDELEMS(q),si_max(q->rank,F->rank));
2129  BITSET save=test;
2130  test &= ~Sy_bit(OPT_INTSTRATEGY);
2131  for (i=IDELEMS(q)-1; i>=0; i--)
2132  {
2133    if (q->m[i]!=NULL)
2134    {
2135      if (TEST_OPT_PROT) { PrintS("r");mflush(); }
2136      p = redNF(pCopy(q->m[i]),max_ind,lazyReduce & KSTD_NF_NONORM,strat);
2137      if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
2138      {
2139        if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
2140        #ifdef HAVE_RINGS
2141        if (rField_is_Ring(currRing))
2142        {
2143          p = redtailBba_Z(p,max_ind,strat);
2144        }
2145        else
2146        #endif
2147        {
2148          p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
2149        }
2150      }
2151      res->m[i]=p;
2152    }
2153    //else
2154    //  res->m[i]=NULL;
2155  }
2156  /*- release temp data------------------------------- -*/
2157  test=save;
2158  omfree(strat->sevS);
2159  omfree(strat->ecartS);
2160  omfree(strat->T);
2161  omfree(strat->sevT);
2162  omfree(strat->R);
2163  omfree(strat->S_2_R);
2164  omfree(strat->L);
2165  omfree(strat->B);
2166  omfree(strat->fromQ);
2167  idDelete(&strat->Shdl);
2168  test=save_test;
2169  if (TEST_OPT_PROT) PrintLn();
2170  return res;
2171}
2172
2173#if F5C
2174/*********************************************************************
2175* interrreduction step of the signature-based algorithm:
2176* 1. all strat->S are interpreted as new critical pairs
2177* 2. those pairs need to be completely reduced by the usual (non sig-
2178*    safe) reduction process (including tail reductions)
2179* 3. strat->S and strat->T are completely new computed in these steps
2180********************************************************************/
2181void f5c (kStrategy strat, int& olddeg, int& minimcnt, int& hilbeledeg, 
2182          int& hilbcount, int& srmax, int& lrmax, int& reduc, ideal Q,
2183          intvec *w,intvec *hilb )
2184{
2185  int Ll_old, red_result = 1;
2186  BOOLEAN withT = FALSE;
2187  int pos  = 0;
2188  hilbeledeg=1;
2189  hilbcount=0;
2190  minimcnt=0;
2191  srmax = 0; // strat->sl is 0 at this point
2192  reduc = olddeg = lrmax = 0;
2193  // we cannot use strat->T anymore
2194  //cleanT(strat);
2195  //strat->tl = -1;
2196  Ll_old    = strat->Ll;
2197  while (strat->tl >= 0)
2198  {
2199    if(!strat->T[strat->tl].is_redundant)
2200    {
2201      LObject h;
2202      h.p = strat->T[strat->tl].p;
2203      h.tailRing = strat->T[strat->tl].tailRing;
2204      h.t_p = strat->T[strat->tl].t_p;
2205      if (h.p!=NULL)
2206      {
2207        if (currRing->OrdSgn==-1)
2208        {
2209          cancelunit(&h); 
2210          deleteHC(&h, strat);
2211        }
2212        if (h.p!=NULL)
2213        {
2214          if (TEST_OPT_INTSTRATEGY)
2215          {
2216            //pContent(h.p);
2217            h.pCleardenom(); // also does a pContent
2218          }
2219          else
2220          {
2221            h.pNorm();
2222          }
2223          strat->initEcart(&h);
2224          pos = strat->Ll+1;
2225          h.sev = pGetShortExpVector(h.p);
2226          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
2227        }
2228      }
2229    }
2230    strat->tl--;
2231  }
2232  strat->sl = -1;
2233#if 0
2234//#ifdef HAVE_TAIL_RING
2235  if(!rField_is_Ring())  // create strong gcd poly computes with tailring and S[i] ->to be fixed
2236    kStratInitChangeTailRing(strat);
2237#endif
2238  //enterpairs(pOne(),0,0,-1,strat,strat->tl);
2239  //strat->sl = -1;
2240  /* picks the last element from the lazyset L */
2241  while (strat->Ll>Ll_old)
2242  {
2243    strat->P = strat->L[strat->Ll];
2244    strat->Ll--;
2245//#if 1
2246#ifdef DEBUGF5
2247    Print("NEXT PAIR TO HANDLE IN INTERRED ALGORITHM\n");
2248    Print("-------------------------------------------------\n");
2249    pWrite(pHead(strat->P.p));
2250    pWrite(pHead(strat->P.p1));
2251    pWrite(pHead(strat->P.p2));
2252    printf("%d\n",strat->tl);
2253    Print("-------------------------------------------------\n");
2254#endif
2255    if (pNext(strat->P.p) == strat->tail)
2256    {
2257      // deletes the short spoly
2258#ifdef HAVE_RINGS
2259      if (rField_is_Ring(currRing))
2260        pLmDelete(strat->P.p);
2261      else
2262#endif
2263        pLmFree(strat->P.p);
2264
2265      // TODO: needs some masking
2266      // TODO: masking needs to vanish once the signature
2267      //       sutff is completely implemented
2268      strat->P.p = NULL;
2269      poly m1 = NULL, m2 = NULL;
2270
2271      // check that spoly creation is ok
2272      while (strat->tailRing != currRing &&
2273          !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
2274      {
2275        assume(m1 == NULL && m2 == NULL);
2276        // if not, change to a ring where exponents are at least
2277        // large enough
2278        if (!kStratChangeTailRing(strat))
2279        {
2280          WerrorS("OVERFLOW...");
2281          break;
2282        }
2283      }
2284      // create the real one
2285      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
2286          strat->tailRing, m1, m2, strat->R);
2287    }
2288    else if (strat->P.p1 == NULL)
2289    {
2290      if (strat->minim > 0)
2291        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
2292      // for input polys, prepare reduction
2293      strat->P.PrepareRed(strat->use_buckets);
2294    }
2295
2296    if (strat->P.p == NULL && strat->P.t_p == NULL)
2297    {
2298      red_result = 0;
2299    }
2300    else
2301    {
2302      if (TEST_OPT_PROT)
2303        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
2304            &olddeg,&reduc,strat, red_result);
2305
2306#ifdef DEBUGF5
2307      Print("Poly before red: ");
2308      pWrite(strat->P.p);
2309#endif
2310      /* complete reduction of the element choosen from L */
2311      red_result = strat->red2(&strat->P,strat);
2312      if (errorreported)  break;
2313    }
2314
2315    if (strat->overflow)
2316    {
2317      if (!kStratChangeTailRing(strat)) { Werror("OVERFLOW.."); break;}
2318    }
2319
2320    // reduction to non-zero new poly
2321    if (red_result == 1)
2322    {
2323      // get the polynomial (canonicalize bucket, make sure P.p is set)
2324      strat->P.GetP(strat->lmBin);
2325      // in the homogeneous case FDeg >= pFDeg (sugar/honey)
2326      // but now, for entering S, T, we reset it
2327      // in the inhomogeneous case: FDeg == pFDeg
2328      if (strat->homog) strat->initEcart(&(strat->P));
2329
2330      /* statistic */
2331      if (TEST_OPT_PROT) PrintS("s");
2332
2333      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
2334
2335#ifdef KDEBUG
2336#if MYTEST
2337      PrintS("New S: "); pDebugPrint(strat->P.p); PrintLn();
2338#endif /* MYTEST */
2339#endif /* KDEBUG */
2340
2341      // reduce the tail and normalize poly
2342      // in the ring case we cannot expect LC(f) = 1,
2343      // therefore we call pContent instead of pNorm
2344#if F5CTAILRED
2345      if ((TEST_OPT_INTSTRATEGY) || (rField_is_Ring(currRing)))
2346      {
2347        strat->P.pCleardenom();
2348        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
2349        {
2350          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
2351          strat->P.pCleardenom();
2352        }
2353      }
2354      else
2355      {
2356        strat->P.pNorm();
2357        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
2358          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
2359      }
2360#endif
2361#ifdef KDEBUG
2362      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
2363#if MYTEST
2364//#if 1
2365      PrintS("New (reduced) S: "); pDebugPrint(strat->P.p); PrintLn();
2366#endif /* MYTEST */
2367#endif /* KDEBUG */
2368
2369      // min_std stuff
2370      if ((strat->P.p1==NULL) && (strat->minim>0))
2371      {
2372        if (strat->minim==1)
2373        {
2374          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
2375          p_Delete(&strat->P.p2, currRing, strat->tailRing);
2376        }
2377        else
2378        {
2379          strat->M->m[minimcnt]=strat->P.p2;
2380          strat->P.p2=NULL;
2381        }
2382        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
2383          pNext(strat->M->m[minimcnt])
2384            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
2385                strat->tailRing, currRing,
2386                currRing->PolyBin);
2387        minimcnt++;
2388      }
2389
2390      // enter into S, L, and T
2391      // here we need to recompute new signatures, but those are trivial ones
2392      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
2393      enterT(strat->P, strat);
2394      // posInS only depends on the leading term
2395      strat->enterS(strat->P, pos, strat, strat->tl);
2396//#if 1
2397#ifdef DEBUGF5
2398      Print("ELEMENT ADDED TO GCURR DURING INTERRED: ");
2399      pWrite(pHead(strat->S[strat->sl]));
2400      pWrite(strat->sig[strat->sl]);
2401#endif
2402      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
2403      //      Print("[%d]",hilbeledeg);
2404      if (strat->P.lcm!=NULL)
2405#ifdef HAVE_RINGS
2406        pLmDelete(strat->P.lcm);
2407#else
2408      pLmFree(strat->P.lcm);
2409#endif
2410      if (strat->sl>srmax) srmax = strat->sl;
2411    }
2412    else
2413    {
2414      // adds signature of the zero reduction to
2415      // strat->syz. This is the leading term of
2416      // syzygy and can be used in syzCriterion()
2417      // the signature is added if and only if the
2418      // pair was not detected by the rewritten criterion in strat->red = redSig
2419      if (strat->P.p1 == NULL && strat->minim > 0)
2420      {
2421        p_Delete(&strat->P.p2, currRing, strat->tailRing);
2422      }
2423    }
2424
2425#ifdef KDEBUG
2426    memset(&(strat->P), 0, sizeof(strat->P));
2427#endif /* KDEBUG */
2428  }
2429  int cc = 0;
2430  while (cc<strat->tl+1)
2431  {
2432    strat->T[cc].sig        = pOne();
2433    p_SetComp(strat->T[cc].sig,cc+1,currRing);
2434    strat->T[cc].sevSig     = pGetShortExpVector(strat->T[cc].sig);
2435    strat->sig[cc]          = strat->T[cc].sig;
2436    strat->sevSig[cc]       = strat->T[cc].sevSig;
2437    strat->T[cc].is_sigsafe = TRUE; 
2438    cc++;
2439  }
2440  strat->max_lower_index = strat->tl;
2441  // set current signature index of upcoming iteration step
2442  // NOTE:  this needs to be set here, as otherwise initSyzRules cannot compute
2443  //        the corresponding syzygy rules correctly
2444  strat->currIdx = cc+1;
2445  for (int cd=strat->Ll; cd>=0; cd--)
2446  {
2447    p_SetComp(strat->L[cd].sig,cc+1,currRing);
2448    cc++;
2449  }
2450//#if 1
2451#if DEBUGF5
2452  Print("------------------- STRAT S ---------------------\n");
2453  cc = 0;
2454  while (cc<strat->tl+1)
2455  {
2456    pWrite(pHead(strat->S[cc]));
2457    pWrite(strat->sig[cc]);
2458    printf("- - - - - -\n");
2459    cc++;
2460  }
2461  Print("-------------------------------------------------\n");
2462  Print("------------------- STRAT T ---------------------\n");
2463  cc = 0;
2464  while (cc<strat->tl+1)
2465  {
2466    pWrite(pHead(strat->T[cc].p));
2467    pWrite(strat->T[cc].sig);
2468    printf("- - - - - -\n");
2469    cc++;
2470  }
2471  Print("-------------------------------------------------\n");
2472  Print("------------------- STRAT L ---------------------\n");
2473  cc = 0;
2474  while (cc<strat->Ll+1)
2475  {
2476    pWrite(pHead(strat->L[cc].p));
2477    pWrite(pHead(strat->L[cc].p1));
2478    pWrite(pHead(strat->L[cc].p2));
2479    pWrite(strat->L[cc].sig);
2480    printf("- - - - - -\n");
2481    cc++;
2482  }
2483  Print("-------------------------------------------------\n");
2484  printf("F5C DONE\nSTRAT SL: %d -- %d\n",strat->sl, strat->currIdx);
2485#endif
2486
2487}
2488#endif
2489
2490/* shiftgb stuff */
2491#ifdef HAVE_SHIFTBBA
2492
2493
2494ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, int uptodeg, int lV)
2495{
2496#ifdef KDEBUG
2497  bba_count++;
2498  int loop_count = 0;
2499#endif
2500  om_Opts.MinTrack = 5;
2501  int   red_result = 1;
2502  int   olddeg,reduc;
2503  int hilbeledeg=1,hilbcount=0,minimcnt=0;
2504  BOOLEAN withT = TRUE; // very important for shifts
2505
2506  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit, NO CHANGES */
2507  initBuchMoraPos(strat); /*NO CHANGES YET: perhaps later*/
2508  initHilbCrit(F,Q,&hilb,strat); /*NO CHANGES*/
2509  initBbaShift(F,strat); /* DONE */
2510  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
2511  /*Shdl=*/initBuchMoraShift(F, Q,strat); /* updateS with no toT, i.e. no init for T */
2512  updateSShift(strat,uptodeg,lV); /* initializes T */
2513
2514  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
2515  reduc = olddeg = 0;
2516  strat->lV=lV;
2517
2518#ifndef NO_BUCKETS
2519  if (!TEST_OPT_NOT_BUCKETS)
2520    strat->use_buckets = 1;
2521#endif
2522
2523  // redtailBBa against T for inhomogenous input
2524  //  if (!TEST_OPT_OLDSTD)
2525  //    withT = ! strat->homog;
2526
2527  // strat->posInT = posInT_pLength;
2528  kTest_TS(strat);
2529
2530#ifdef HAVE_TAIL_RING
2531  kStratInitChangeTailRing(strat);
2532#endif
2533
2534  /* compute------------------------------------------------------- */
2535  while (strat->Ll >= 0)
2536  {
2537#ifdef KDEBUG
2538    loop_count++;
2539    if (TEST_OPT_DEBUG) messageSets(strat);
2540#endif
2541    if (strat->Ll== 0) strat->interpt=TRUE;
2542    if (TEST_OPT_DEGBOUND
2543        && ((strat->honey && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
2544            || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
2545    {
2546      /*
2547       *stops computation if
2548       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
2549       *a predefined number Kstd1_deg
2550       */
2551      while ((strat->Ll >= 0)
2552        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
2553        && ((strat->honey && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
2554            || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
2555        )
2556        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
2557      if (strat->Ll<0) break;
2558      else strat->noClearS=TRUE;
2559    }
2560    /* picks the last element from the lazyset L */
2561    strat->P = strat->L[strat->Ll];
2562    strat->Ll--;
2563
2564    if (pNext(strat->P.p) == strat->tail)
2565    {
2566      // deletes the short spoly
2567      pLmFree(strat->P.p);
2568      strat->P.p = NULL;
2569      poly m1 = NULL, m2 = NULL;
2570
2571      // check that spoly creation is ok
2572      while (strat->tailRing != currRing &&
2573             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
2574      {
2575        assume(m1 == NULL && m2 == NULL);
2576        // if not, change to a ring where exponents are at least
2577        // large enough
2578        kStratChangeTailRing(strat);
2579      }
2580      // create the real one
2581      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
2582                    strat->tailRing, m1, m2, strat->R);
2583    }
2584    else if (strat->P.p1 == NULL)
2585    {
2586      if (strat->minim > 0)
2587        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
2588      // for input polys, prepare reduction
2589      strat->P.PrepareRed(strat->use_buckets);
2590    }
2591
2592    poly qq;
2593
2594    /* here in the nonhomog case we shrink the new spoly */
2595
2596    if ( ! strat->homog)
2597    {
2598      strat->P.GetP(strat->lmBin); // because shifts are counted with .p structure
2599      /* in the nonhomog case we have to shrink the polynomial */
2600      assume(strat->P.t_p!=NULL);
2601      qq = p_Shrink(strat->P.t_p, lV, strat->tailRing); // direct shrink
2602      if (qq != NULL)
2603      {
2604         /* we're here if Shrink is nonzero */
2605        //         strat->P.p =  NULL;
2606        //        strat->P.Delete(); /* deletes P.p and P.t_p */ //error
2607        strat->P.p   =  NULL; // is not set by Delete
2608        strat->P.t_p =  qq;
2609        strat->P.GetP(strat->lmBin);
2610        // update sev and length
2611        strat->initEcart(&(strat->P));
2612        strat->P.sev = pGetShortExpVector(strat->P.p);
2613//         strat->P.FDeg = strat->P.pFDeg();
2614//         strat->P.length = strat->P.pLDeg();
2615//         strat->P.pLength =strat->P.GetpLength(); //pLength(strat->P.p);
2616      }
2617      else
2618      {
2619         /* Shrink is zero, like y(1)*y(2) - y(1)*y(3)*/
2620#ifdef KDEBUG
2621         if (TEST_OPT_DEBUG){PrintS("nonzero s shrinks to 0");PrintLn();}
2622#endif
2623         //         strat->P.Delete();  // cause error
2624         strat->P.p = NULL;
2625         strat->P.t_p = NULL;
2626           //         strat->P.p = NULL; // or delete strat->P.p ?
2627       }
2628    }
2629      /* end shrinking poly in the nonhomog case */
2630
2631    if (strat->P.p == NULL && strat->P.t_p == NULL)
2632    {
2633      red_result = 0;
2634    }
2635    else
2636    {
2637      if (TEST_OPT_PROT)
2638        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
2639                &olddeg,&reduc,strat, red_result);
2640
2641      /* reduction of the element choosen from L */
2642      red_result = strat->red(&strat->P,strat);
2643    }
2644
2645    // reduction to non-zero new poly
2646    if (red_result == 1)
2647    {
2648      /* statistic */
2649      if (TEST_OPT_PROT) PrintS("s");
2650
2651      // get the polynomial (canonicalize bucket, make sure P.p is set)
2652      strat->P.GetP(strat->lmBin);
2653
2654      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
2655
2656      // reduce the tail and normalize poly
2657      if (TEST_OPT_INTSTRATEGY)
2658      {
2659        strat->P.pCleardenom();
2660        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
2661        {
2662          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
2663          strat->P.pCleardenom();
2664        }
2665      }
2666      else
2667      {
2668        strat->P.pNorm();
2669        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
2670          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
2671      }
2672
2673      // here we must shrink again! and optionally reduce again
2674      // or build shrink into redtailBba!
2675
2676#ifdef KDEBUG
2677      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
2678#endif
2679
2680      // min_std stuff
2681      if ((strat->P.p1==NULL) && (strat->minim>0))
2682      {
2683        if (strat->minim==1)
2684        {
2685          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
2686          p_Delete(&strat->P.p2, currRing, strat->tailRing);
2687        }
2688        else
2689        {
2690          strat->M->m[minimcnt]=strat->P.p2;
2691          strat->P.p2=NULL;
2692        }
2693        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
2694          pNext(strat->M->m[minimcnt])
2695            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
2696                                           strat->tailRing, currRing,
2697                                           currRing->PolyBin);
2698        minimcnt++;
2699      }
2700
2701    /* here in the nonhomog case we shrink the reduced poly AGAIN */
2702
2703    if ( ! strat->homog)
2704    {
2705      strat->P.GetP(strat->lmBin); // because shifts are counted with .p structure
2706      /* assume strat->P.t_p != NULL */
2707      /* in the nonhomog case we have to shrink the polynomial */
2708      assume(strat->P.t_p!=NULL); // poly qq defined above
2709      qq = p_Shrink(strat->P.t_p, lV, strat->tailRing); // direct shrink
2710      if (qq != NULL)
2711      {
2712         /* we're here if Shrink is nonzero */
2713        //         strat->P.p =  NULL;
2714        //        strat->P.Delete(); /* deletes P.p and P.t_p */ //error
2715        strat->P.p   =  NULL; // is not set by Delete
2716        strat->P.t_p =  qq;
2717        strat->P.GetP(strat->lmBin);
2718        // update sev and length
2719        strat->initEcart(&(strat->P));
2720        strat->P.sev = pGetShortExpVector(strat->P.p);
2721      }
2722      else
2723      {
2724         /* Shrink is zero, like y(1)*y(2) - y(1)*y(3)*/
2725#ifdef PDEBUG
2726         if (TEST_OPT_DEBUG){PrintS("nonzero s shrinks to 0");PrintLn();}
2727#endif
2728         //         strat->P.Delete();  // cause error
2729         strat->P.p = NULL;
2730         strat->P.t_p = NULL;
2731           //         strat->P.p = NULL; // or delete strat->P.p ?
2732         goto     red_shrink2zero;
2733       }
2734    }
2735      /* end shrinking poly AGAIN in the nonhomog case */
2736
2737
2738      // enter into S, L, and T
2739      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
2740      //        enterT(strat->P, strat); // this was here before Shift stuff
2741      //enterTShift(LObject p, kStrategy strat, int atT, int uptodeg, int lV); // syntax
2742      // the default value for atT = -1 as in bba
2743      /*   strat->P.GetP(); */
2744      // because shifts are counted with .p structure // done before, but ?
2745      enterTShift(strat->P,strat,-1,uptodeg, lV);
2746      enterpairsShift(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl,uptodeg,lV);
2747      //      enterpairsShift(vw,strat->sl,strat->P.ecart,pos,strat, strat->tl,uptodeg,lV);
2748      // posInS only depends on the leading term
2749      strat->enterS(strat->P, pos, strat, strat->tl);
2750
2751      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
2752//      Print("[%d]",hilbeledeg);
2753      if (strat->P.lcm!=NULL) pLmFree(strat->P.lcm);
2754    }
2755    else
2756    {
2757    red_shrink2zero:
2758      if (strat->P.p1 == NULL && strat->minim > 0)
2759      {
2760        p_Delete(&strat->P.p2, currRing, strat->tailRing);
2761      }
2762    }
2763#ifdef KDEBUG
2764    memset(&(strat->P), 0, sizeof(strat->P));
2765#endif
2766    kTest_TS(strat);
2767  }
2768#ifdef KDEBUG
2769  if (TEST_OPT_DEBUG) messageSets(strat);
2770#endif
2771  /* complete reduction of the standard basis--------- */
2772  /*  shift case: look for elt's in S such that they are divisible by elt in T */
2773  //  if (TEST_OPT_SB_1)
2774  if (TEST_OPT_REDSB)
2775  {
2776    int k=0;
2777    int j=-1;
2778    while(k<=strat->sl)
2779    {
2780//       loop
2781//       {
2782//         if (j>=k) break;
2783//         clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
2784//         j++;
2785//       }
2786      LObject Ln (strat->S[k],currRing, strat->tailRing);
2787      Ln.SetShortExpVector();
2788      j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln, j+1);
2789      if (j<0) {  k++; j=-1;}
2790      else
2791      {
2792        if ( pLmCmp(strat->S[k],strat->T[j].p) == 0)
2793        {
2794          j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln, j+1);
2795          if (j<0) {  k++; j=-1;}
2796          else
2797          {
2798            deleteInS(k,strat);
2799          }
2800        }
2801        else
2802        {
2803          deleteInS(k,strat);
2804        }
2805      }
2806    }
2807  }
2808
2809  if (TEST_OPT_REDSB)
2810  {    completeReduce(strat, TRUE); //shift: withT = TRUE
2811    if (strat->completeReduce_retry)
2812    {
2813      // completeReduce needed larger exponents, retry
2814      // to reduce with S (instead of T)
2815      // and in currRing (instead of strat->tailRing)
2816      cleanT(strat);strat->tailRing=currRing;
2817      int i;
2818      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
2819      completeReduce(strat, TRUE);
2820    }
2821  }
2822  else if (TEST_OPT_PROT) PrintLn();
2823
2824  /* release temp data-------------------------------- */
2825  exitBuchMora(strat);
2826//  if (TEST_OPT_WEIGHTM)
2827//  {
2828//    pRestoreDegProcs(currRing,pFDegOld, pLDegOld);
2829//    if (ecartWeights)
2830//    {
2831//      omFreeSize((ADDRESS)ecartWeights,((currRing->N)+1)*sizeof(short));
2832//      ecartWeights=NULL;
2833//    }
2834//  }
2835  if (TEST_OPT_PROT) messageStat(hilbcount,strat);
2836  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
2837  return (strat->Shdl);
2838}
2839
2840
2841ideal freegb(ideal I, int uptodeg, int lVblock)
2842{
2843  /* todo main call */
2844
2845  /* assume: ring is prepared, ideal is copied into shifted ring */
2846  /* uptodeg and lVblock are correct - test them! */
2847
2848  /* check whether the ideal is in V */
2849
2850//  if (0)
2851  if (! ideal_isInV(I,lVblock) )
2852  {
2853    WerrorS("The input ideal contains incorrectly encoded elements! ");
2854    return(NULL);
2855  }
2856
2857  //  kStrategy strat = new skStrategy;
2858  /* ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, int uptodeg, int lV) */
2859  /* at the moment:
2860- no quotient (check)
2861- no *w, no *hilb
2862  */
2863  /* ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
2864     int newIdeal, intvec *vw) */
2865  ideal RS = kStdShift(I,NULL, testHomog, NULL,NULL,0,0,NULL, uptodeg, lVblock);
2866    //bbaShift(I,NULL, NULL, NULL, strat, uptodeg, lVblock);
2867  idSkipZeroes(RS);
2868  return(RS);
2869}
2870
2871/*2
2872*reduces h with elements from T choosing  the first possible
2873* element in t with respect to the given pDivisibleBy
2874*/
2875int redFirstShift (LObject* h,kStrategy strat)
2876{
2877  if (h->IsNull()) return 0;
2878
2879  int at, reddeg,d;
2880  int pass = 0;
2881  int j = 0;
2882
2883  if (! strat->homog)
2884  {
2885    d = h->GetpFDeg() + h->ecart;
2886    reddeg = strat->LazyDegree+d;
2887  }
2888  h->SetShortExpVector();
2889  loop
2890  {
2891    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
2892    if (j < 0)
2893    {
2894      h->SetDegStuffReturnLDeg(strat->LDegLast);
2895      return 1;
2896    }
2897
2898    if (!TEST_OPT_INTSTRATEGY)
2899      strat->T[j].pNorm();
2900#ifdef KDEBUG
2901    if (TEST_OPT_DEBUG)
2902    {
2903      PrintS("reduce ");
2904      h->wrp();
2905      PrintS(" with ");
2906      strat->T[j].wrp();
2907    }
2908#endif
2909    ksReducePoly(h, &(strat->T[j]), strat->kNoetherTail(), NULL, strat);
2910    if (!h->IsNull())
2911    {
2912      poly qq=p_Shrink(h->GetTP(),strat->lV,strat->tailRing);
2913      h->p=NULL;
2914      h->t_p=qq;
2915      if (qq!=NULL) h->GetP(strat->lmBin);
2916    }
2917
2918#ifdef KDEBUG
2919    if (TEST_OPT_DEBUG)
2920    {
2921      PrintS(" to ");
2922      wrp(h->p);
2923      PrintLn();
2924    }
2925#endif
2926    if (h->IsNull())
2927    {
2928      if (h->lcm!=NULL) pLmFree(h->lcm);
2929      h->Clear();
2930      return 0;
2931    }
2932    h->SetShortExpVector();
2933
2934#if 0
2935    if ((strat->syzComp!=0) && !strat->honey)
2936    {
2937      if ((strat->syzComp>0) &&
2938          (h->Comp() > strat->syzComp))
2939      {
2940        assume(h->MinComp() > strat->syzComp);
2941#ifdef KDEBUG
2942        if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
2943#endif
2944        if (strat->homog)
2945          h->SetDegStuffReturnLDeg(strat->LDegLast);
2946        return -2;
2947      }
2948    }
2949#endif
2950    if (!strat->homog)
2951    {
2952      if (!TEST_OPT_OLDSTD && strat->honey)
2953      {
2954        h->SetpFDeg();
2955        if (strat->T[j].ecart <= h->ecart)
2956          h->ecart = d - h->GetpFDeg();
2957        else
2958          h->ecart = d - h->GetpFDeg() + strat->T[j].ecart - h->ecart;
2959
2960        d = h->GetpFDeg() + h->ecart;
2961      }
2962      else
2963        d = h->SetDegStuffReturnLDeg(strat->LDegLast);
2964      /*- try to reduce the s-polynomial -*/
2965      pass++;
2966      /*
2967       *test whether the polynomial should go to the lazyset L
2968       *-if the degree jumps
2969       *-if the number of pre-defined reductions jumps
2970       */
2971      if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
2972          && ((d >= reddeg) || (pass > strat->LazyPass)))
2973      {
2974        h->SetLmCurrRing();
2975        if (strat->posInLDependsOnLength)
2976          h->SetLength(strat->length_pLength);
2977        at = strat->posInL(strat->L,strat->Ll,h,strat);
2978        if (at <= strat->Ll)
2979        {
2980          int dummy=strat->sl;
2981          /*          if (kFindDivisibleByInS(strat,&dummy, h) < 0) */
2982          if (kFindDivisibleByInT(strat->T,strat->sevT, dummy, h) < 0)
2983            return 1;
2984          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
2985#ifdef KDEBUG
2986          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
2987#endif
2988          h->Clear();
2989          return -1;
2990        }
2991      }
2992      if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
2993      {
2994        reddeg = d+1;
2995        Print(".%d",d);mflush();
2996      }
2997    }
2998  }
2999}
3000
3001void initBbaShift(ideal F,kStrategy strat)
3002{
3003  int i;
3004//  idhdl h;
3005 /* setting global variables ------------------- */
3006  strat->enterS = enterSBba; /* remains as is, we change enterT! */
3007
3008  strat->red = redFirstShift; /* no redHomog ! */
3009
3010  if (currRing->pLexOrder && strat->honey)
3011    strat->initEcart = initEcartNormal;
3012  else
3013    strat->initEcart = initEcartBBA;
3014  if (strat->honey)
3015    strat->initEcartPair = initEcartPairMora;
3016  else
3017    strat->initEcartPair = initEcartPairBba;
3018//  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
3019//  {
3020//    //interred  machen   Aenderung
3021//    pFDegOld=currRing->pFDeg;
3022//    pLDegOld=pLDeg;
3023//    //h=ggetid("ecart");
3024//    //if ((h!=NULL) /*&& (IDTYP(h)==INTVEC_CMD)*/)
3025//    //{
3026//    //  ecartWeights=iv2array(IDINTVEC(h));
3027//    //}
3028//    //else
3029//    {
3030//      ecartWeights=(short *)omAlloc(((currRing->N)+1)*sizeof(short));
3031//      /*uses automatic computation of the ecartWeights to set them*/
3032//      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights,currRing);
3033//    }
3034//    pRestoreDegProcs(currRing,totaldegreeWecart, maxdegreeWecart);
3035//    if (TEST_OPT_PROT)
3036//    {
3037//      for(i=1; i<=(currRing->N); i++)
3038//        Print(" %d",ecartWeights[i]);
3039//      PrintLn();
3040//      mflush();
3041//    }
3042//  }
3043}
3044#endif
Note: See TracBrowser for help on using the repository browser.