source: git/kernel/kstd2.cc @ 3772383

spielwiese
Last change on this file since 3772383 was 3772383, checked in by Hans Schoenemann <hannes@…>, 11 years ago
fix: restore options after bba (possible ring change)
  • 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  BITSET save;
1167  SI_SAVE_OPT1(save);
1168
1169  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1170  initBuchMoraPos(strat);
1171  initHilbCrit(F,Q,&hilb,strat);
1172  initBba(F,strat);
1173  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1174  /*Shdl=*/initBuchMora(F, Q,strat);
1175  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
1176  reduc = olddeg = 0;
1177
1178#ifndef NO_BUCKETS
1179  if (!TEST_OPT_NOT_BUCKETS)
1180    strat->use_buckets = 1;
1181#endif
1182
1183  // redtailBBa against T for inhomogenous input
1184  if (!TEST_OPT_OLDSTD)
1185    withT = ! strat->homog;
1186
1187  // strat->posInT = posInT_pLength;
1188  kTest_TS(strat);
1189
1190#ifdef KDEBUG
1191#if MYTEST
1192  if (TEST_OPT_DEBUG)
1193  {
1194    PrintS("bba start GB: currRing: ");
1195    // rWrite(currRing);PrintLn();
1196    rDebugPrint(currRing);
1197    PrintLn();
1198  }
1199#endif /* MYTEST */
1200#endif /* KDEBUG */
1201
1202#ifdef HAVE_TAIL_RING
1203  if(!idIs0(F) &&(!rField_is_Ring(currRing)))  // create strong gcd poly computes with tailring and S[i] ->to be fixed
1204    kStratInitChangeTailRing(strat);
1205#endif
1206  if (BVERBOSE(23))
1207  {
1208    if (test_PosInT!=NULL) strat->posInT=test_PosInT;
1209    if (test_PosInL!=NULL) strat->posInL=test_PosInL;
1210    kDebugPrint(strat);
1211  }
1212
1213
1214#ifdef KDEBUG
1215  //kDebugPrint(strat);
1216#endif
1217  /* compute------------------------------------------------------- */
1218  while (strat->Ll >= 0)
1219  {
1220    #ifdef KDEBUG
1221      loop_count++;
1222      if (TEST_OPT_DEBUG) messageSets(strat);
1223    #endif
1224    if (strat->Ll== 0) strat->interpt=TRUE;
1225    if (TEST_OPT_DEGBOUND
1226        && ((strat->honey && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1227            || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1228    {
1229      /*
1230       *stops computation if
1231       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1232       *a predefined number Kstd1_deg
1233       */
1234      while ((strat->Ll >= 0)
1235        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1236        && ((strat->honey && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1237            || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1238        )
1239        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1240      if (strat->Ll<0) break;
1241      else strat->noClearS=TRUE;
1242    }
1243    /* picks the last element from the lazyset L */
1244    strat->P = strat->L[strat->Ll];
1245    strat->Ll--;
1246
1247    if (pNext(strat->P.p) == strat->tail)
1248    {
1249      // deletes the short spoly
1250#ifdef HAVE_RINGS
1251      if (rField_is_Ring(currRing))
1252        pLmDelete(strat->P.p);
1253      else
1254#endif
1255        pLmFree(strat->P.p);
1256      strat->P.p = NULL;
1257      poly m1 = NULL, m2 = NULL;
1258
1259      // check that spoly creation is ok
1260      while (strat->tailRing != currRing &&
1261             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1262      {
1263        assume(m1 == NULL && m2 == NULL);
1264        // if not, change to a ring where exponents are at least
1265        // large enough
1266        if (!kStratChangeTailRing(strat))
1267        {
1268          WerrorS("OVERFLOW...");
1269          break;
1270        }
1271      }
1272      // create the real one
1273      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
1274                    strat->tailRing, m1, m2, strat->R);
1275    }
1276    else if (strat->P.p1 == NULL)
1277    {
1278      if (strat->minim > 0)
1279        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1280      // for input polys, prepare reduction
1281      strat->P.PrepareRed(strat->use_buckets);
1282    }
1283
1284    if (strat->P.p == NULL && strat->P.t_p == NULL)
1285    {
1286      red_result = 0;
1287    }
1288    else
1289    {
1290      if (TEST_OPT_PROT)
1291        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1292                &olddeg,&reduc,strat, red_result);
1293
1294      /* reduction of the element choosen from L */
1295      red_result = strat->red(&strat->P,strat);
1296      if (errorreported)  break;
1297    }
1298
1299    if (strat->overflow)
1300    {
1301        if (!kStratChangeTailRing(strat)) { Werror("OVERFLOW.."); break;}
1302    }
1303
1304    // reduction to non-zero new poly
1305    if (red_result == 1)
1306    {
1307      // get the polynomial (canonicalize bucket, make sure P.p is set)
1308      strat->P.GetP(strat->lmBin);
1309      // in the homogeneous case FDeg >= pFDeg (sugar/honey)
1310      // but now, for entering S, T, we reset it
1311      // in the inhomogeneous case: FDeg == pFDeg
1312      if (strat->homog) strat->initEcart(&(strat->P));
1313
1314      /* statistic */
1315      if (TEST_OPT_PROT) PrintS("s");
1316
1317      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1318
1319#ifdef KDEBUG
1320#if MYTEST
1321      PrintS("New S: "); p_DebugPrint(strat->P.p, currRing); PrintLn();
1322#endif /* MYTEST */
1323#endif /* KDEBUG */
1324
1325      // reduce the tail and normalize poly
1326      // in the ring case we cannot expect LC(f) = 1,
1327      // therefore we call pContent instead of pNorm
1328      if ((TEST_OPT_INTSTRATEGY) || (rField_is_Ring(currRing)))
1329      {
1330        strat->P.pCleardenom();
1331        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1332        {
1333          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1334          strat->P.pCleardenom();
1335        }
1336      }
1337      else
1338      {
1339        strat->P.pNorm();
1340        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1341          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1342      }
1343
1344#ifdef KDEBUG
1345      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1346#if MYTEST
1347      PrintS("New (reduced) S: "); p_DebugPrint(strat->P.p, currRing); PrintLn();
1348#endif /* MYTEST */
1349#endif /* KDEBUG */
1350
1351      // min_std stuff
1352      if ((strat->P.p1==NULL) && (strat->minim>0))
1353      {
1354        if (strat->minim==1)
1355        {
1356          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1357          p_Delete(&strat->P.p2, currRing, strat->tailRing);
1358        }
1359        else
1360        {
1361          strat->M->m[minimcnt]=strat->P.p2;
1362          strat->P.p2=NULL;
1363        }
1364        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1365          pNext(strat->M->m[minimcnt])
1366            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1367                                           strat->tailRing, currRing,
1368                                           currRing->PolyBin);
1369        minimcnt++;
1370      }
1371
1372      // enter into S, L, and T
1373      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1374        enterT(strat->P, strat);
1375#ifdef HAVE_RINGS
1376      if (rField_is_Ring(currRing))
1377        superenterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1378      else
1379#endif
1380        enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1381      // posInS only depends on the leading term
1382      strat->enterS(strat->P, pos, strat, strat->tl);
1383#if 0
1384      int pl=pLength(strat->P.p);
1385      if (pl==1)
1386      {
1387        //if (TEST_OPT_PROT)
1388        //PrintS("<1>");
1389      }
1390      else if (pl==2)
1391      {
1392        //if (TEST_OPT_PROT)
1393        //PrintS("<2>");
1394      }
1395#endif
1396      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1397//      Print("[%d]",hilbeledeg);
1398      if (strat->P.lcm!=NULL)
1399#ifdef HAVE_RINGS
1400        pLmDelete(strat->P.lcm);
1401#else
1402        pLmFree(strat->P.lcm);
1403#endif
1404    }
1405    else if (strat->P.p1 == NULL && strat->minim > 0)
1406    {
1407      p_Delete(&strat->P.p2, currRing, strat->tailRing);
1408    }
1409
1410#ifdef KDEBUG
1411    memset(&(strat->P), 0, sizeof(strat->P));
1412#endif /* KDEBUG */
1413    kTest_TS(strat);
1414  }
1415#ifdef KDEBUG
1416#if MYTEST
1417  PrintS("bba finish GB: currRing: "); rWrite(currRing);
1418#endif /* MYTEST */
1419  if (TEST_OPT_DEBUG) messageSets(strat);
1420#endif /* KDEBUG */
1421
1422  if (TEST_OPT_SB_1)
1423  {
1424    int k=1;
1425    int j;
1426    while(k<=strat->sl)
1427    {
1428      j=0;
1429      loop
1430      {
1431        if (j>=k) break;
1432        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1433        j++;
1434      }
1435      k++;
1436    }
1437  }
1438
1439  /* complete reduction of the standard basis--------- */
1440  if (TEST_OPT_REDSB)
1441  {
1442    completeReduce(strat);
1443#ifdef HAVE_TAIL_RING
1444    if (strat->completeReduce_retry)
1445    {
1446      // completeReduce needed larger exponents, retry
1447      // to reduce with S (instead of T)
1448      // and in currRing (instead of strat->tailRing)
1449      cleanT(strat);strat->tailRing=currRing;
1450      int i;
1451      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1452      completeReduce(strat);
1453    }
1454#endif
1455  }
1456  else if (TEST_OPT_PROT) PrintLn();
1457
1458  /* release temp data-------------------------------- */
1459  exitBuchMora(strat);
1460//  if (TEST_OPT_WEIGHTM)
1461//  {
1462//    pRestoreDegProcs(currRing,pFDegOld, pLDegOld);
1463//    if (ecartWeights)
1464//    {
1465//      omFreeSize((ADDRESS)ecartWeights,((currRing->N)+1)*sizeof(short));
1466//      ecartWeights=NULL;
1467//    }
1468//  }
1469  if (TEST_OPT_PROT) messageStat(hilbcount,strat);
1470  SI_RESTORE_OPT1(save);
1471  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1472
1473#ifdef KDEBUG
1474#if MYTEST
1475  PrintS("bba_end: currRing: "); rWrite(currRing);
1476#endif /* MYTEST */
1477#endif /* KDEBUG */
1478  idTest(strat->Shdl);
1479
1480  return (strat->Shdl);
1481}
1482ideal sba (ideal F0, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
1483{
1484  // ring order stuff:
1485  // in sba we have (until now) two possibilities:
1486  // 1. an incremental computation w.r.t. (C,monomial order)
1487  // 2. a (possibly non-incremental) computation w.r.t. the
1488  //    induced Schreyer order.
1489  // The corresponding orders are computed in sbaRing(), depending
1490  // on the flag strat->incremental
1491  ideal F = F0;
1492  ring sRing, currRingOld;
1493  currRingOld  = currRing; 
1494  if (strat->incremental)
1495  {
1496    sRing = sbaRing(strat);
1497    if (sRing!=currRingOld)
1498    {
1499      rChangeCurrRing (sRing);
1500      F = idrMoveR (F0, currRingOld, currRing);
1501    }
1502  }
1503#if 0
1504  printf("SBA COMPUTATIONS DONE IN THE FOLLOWING RING:\n");
1505  rWrite (currRing);
1506  printf("\n");
1507#endif
1508#ifdef KDEBUG
1509  bba_count++;
1510  int loop_count = 0;
1511#endif /* KDEBUG */
1512  om_Opts.MinTrack = 5;
1513  int   srmax,lrmax, red_result = 1;
1514  int   olddeg,reduc;
1515  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1516  long zeroreductions = 0;
1517  LObject L;
1518  BOOLEAN withT     = FALSE;
1519  strat->max_lower_index = 0;
1520
1521  //initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1522  initSbaCrit(strat); /*set Gebauer, honey, sugarCrit*/
1523  initSbaPos(strat);
1524  //initBuchMoraPos(strat);
1525  initHilbCrit(F,Q,&hilb,strat);
1526  initSba(F,strat);
1527  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1528  /*Shdl=*/initSbaBuchMora(F, Q,strat);
1529  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
1530  srmax = strat->sl;
1531  reduc = olddeg = lrmax = 0;
1532
1533#ifndef NO_BUCKETS
1534  if (!TEST_OPT_NOT_BUCKETS)
1535    strat->use_buckets = 1;
1536#endif
1537
1538  // redtailBBa against T for inhomogenous input
1539  if (!TEST_OPT_OLDSTD)
1540    withT = ! strat->homog;
1541
1542  // strat->posInT = posInT_pLength;
1543  kTest_TS(strat);
1544
1545#ifdef KDEBUG
1546#if MYTEST
1547  if (TEST_OPT_DEBUG)
1548  {
1549    PrintS("bba start GB: currRing: ");
1550    // rWrite(currRing);PrintLn();
1551    rDebugPrint(currRing);
1552    PrintLn();
1553  }
1554#endif /* MYTEST */
1555#endif /* KDEBUG */
1556
1557#ifdef HAVE_TAIL_RING
1558  if(!idIs0(F) &&(!rField_is_Ring(currRing)))  // create strong gcd poly computes with tailring and S[i] ->to be fixed
1559    kStratInitChangeTailRing(strat);
1560#endif
1561  if (BVERBOSE(23))
1562  {
1563    if (test_PosInT!=NULL) strat->posInT=test_PosInT;
1564    if (test_PosInL!=NULL) strat->posInL=test_PosInL;
1565    kDebugPrint(strat);
1566  }
1567
1568
1569#ifdef KDEBUG
1570  //kDebugPrint(strat);
1571#endif
1572  /* compute------------------------------------------------------- */
1573  while (strat->Ll >= 0)
1574  {
1575    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1576    #ifdef KDEBUG
1577      loop_count++;
1578      if (TEST_OPT_DEBUG) messageSets(strat);
1579    #endif
1580    if (strat->Ll== 0) strat->interpt=TRUE;
1581    if (TEST_OPT_DEGBOUND
1582        && ((strat->honey && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1583            || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1584    {
1585      /*
1586       *stops computation if
1587       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1588       *a predefined number Kstd1_deg
1589       */
1590      while ((strat->Ll >= 0)
1591        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1592        && ((strat->honey && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1593            || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1594        )
1595        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1596      if (strat->Ll<0) break;
1597      else strat->noClearS=TRUE;
1598    }
1599    if (strat->incremental && pGetComp(strat->L[strat->Ll].sig) != strat->currIdx)
1600    {
1601      strat->currIdx  = pGetComp(strat->L[strat->Ll].sig);
1602#if F5C
1603      // 1. interreduction of the current standard basis
1604      // 2. generation of new principal syzygy rules for syzCriterion
1605      f5c ( strat, olddeg, minimcnt, hilbeledeg, hilbcount, srmax, 
1606            lrmax, reduc, Q, w, hilb );
1607#endif
1608      // initialize new syzygy rules for the next iteration step 
1609      initSyzRules(strat);
1610    }
1611    /*********************************************************************
1612     * interrreduction step is done, we can go on with the next iteration
1613     * step of the signature-based algorithm
1614     ********************************************************************/
1615    /* picks the last element from the lazyset L */
1616    strat->P = strat->L[strat->Ll];
1617    strat->Ll--;
1618//#if 1
1619#ifdef DEBUGF5
1620    Print("SIG OF NEXT PAIR TO HANDLE IN SIG-BASED ALGORITHM\n");
1621    Print("-------------------------------------------------\n");
1622    pWrite(strat->P.sig);
1623    pWrite(pHead(strat->P.p));
1624    pWrite(pHead(strat->P.p1));
1625    pWrite(pHead(strat->P.p2));
1626    Print("-------------------------------------------------\n");
1627#endif
1628    if (pNext(strat->P.p) == strat->tail)
1629    {
1630      // deletes the short spoly
1631#ifdef HAVE_RINGS
1632      if (rField_is_Ring(currRing))
1633        pLmDelete(strat->P.p);
1634      else
1635#endif
1636        pLmFree(strat->P.p);
1637
1638      // TODO: needs some masking
1639      // TODO: masking needs to vanish once the signature
1640      //       sutff is completely implemented
1641      strat->P.p = NULL;
1642      poly m1 = NULL, m2 = NULL;
1643
1644      // check that spoly creation is ok
1645      while (strat->tailRing != currRing &&
1646             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1647      {
1648        assume(m1 == NULL && m2 == NULL);
1649        // if not, change to a ring where exponents are at least
1650        // large enough
1651        if (!kStratChangeTailRing(strat))
1652        {
1653          WerrorS("OVERFLOW...");
1654          break;
1655        }
1656      }
1657      // create the real one
1658      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
1659                    strat->tailRing, m1, m2, strat->R);
1660
1661    }
1662    else if (strat->P.p1 == NULL)
1663    {
1664      if (strat->minim > 0)
1665        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1666      // for input polys, prepare reduction
1667      strat->P.PrepareRed(strat->use_buckets);
1668    }
1669
1670    if (strat->P.p == NULL && strat->P.t_p == NULL)
1671    {
1672      red_result = 0;
1673    }
1674    else
1675    {
1676      if (TEST_OPT_PROT)
1677        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1678                &olddeg,&reduc,strat, red_result);
1679
1680//#if 1
1681#ifdef DEBUGF5
1682      Print("Poly before red: ");
1683      pWrite(strat->P.p);
1684#endif
1685      /* reduction of the element choosen from L */
1686      if (!strat->rewCrit2(strat->P.sig, ~strat->P.sevSig, strat, strat->P.checked+1))
1687        red_result = strat->red(&strat->P,strat);
1688      else
1689      {
1690        if (strat->P.lcm!=NULL)
1691          pLmFree(strat->P.lcm);
1692        red_result = 2;
1693      }
1694      if (errorreported)  break;
1695    }
1696
1697    if (strat->overflow)
1698    {
1699        if (!kStratChangeTailRing(strat)) { Werror("OVERFLOW.."); break;}
1700    }
1701    if (strat->incremental)
1702    {
1703      for (int jj = 0; jj<strat->tl+1; jj++)
1704      {
1705        if (pGetComp(strat->T[jj].sig) == strat->currIdx)
1706        {
1707          strat->T[jj].is_sigsafe = FALSE;
1708        }
1709      }
1710    }
1711    else
1712    {
1713      for (int jj = 0; jj<strat->tl+1; jj++)
1714      {
1715        strat->T[jj].is_sigsafe = FALSE;
1716      }
1717    }
1718
1719    // reduction to non-zero new poly
1720    if (red_result == 1)
1721    {
1722      // get the polynomial (canonicalize bucket, make sure P.p is set)
1723      strat->P.GetP(strat->lmBin);
1724     
1725      // sig-safe computations may lead to wrong FDeg computation, thus we need
1726      // to recompute it to make sure everything is alright
1727      (strat->P).FDeg = (strat->P).pFDeg();
1728      // in the homogeneous case FDeg >= pFDeg (sugar/honey)
1729      // but now, for entering S, T, we reset it
1730      // in the inhomogeneous case: FDeg == pFDeg
1731      if (strat->homog) strat->initEcart(&(strat->P));
1732
1733      /* statistic */
1734      if (TEST_OPT_PROT) PrintS("s");
1735
1736      //int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1737      // in F5E we know that the last reduced element is already the
1738      // the one with highest signature
1739      int pos = strat->sl+1;
1740
1741#ifdef KDEBUG
1742#if MYTEST
1743      PrintS("New S: "); pDebugPrint(strat->P.p); PrintLn();
1744#endif /* MYTEST */
1745#endif /* KDEBUG */
1746
1747      // reduce the tail and normalize poly
1748      // in the ring case we cannot expect LC(f) = 1,
1749      // therefore we call pContent instead of pNorm
1750      /*
1751      if ((TEST_OPT_INTSTRATEGY) || (rField_is_Ring(currRing)))
1752      {
1753        strat->P.pCleardenom();
1754        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1755        {
1756          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1757          strat->P.pCleardenom();
1758        }
1759      }
1760      else
1761      {
1762        strat->P.pNorm();
1763        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1764          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1765      }
1766      */
1767#ifdef KDEBUG
1768      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1769#if MYTEST
1770//#if 1
1771      PrintS("New (reduced) S: "); pDebugPrint(strat->P.p); PrintLn();
1772#endif /* MYTEST */
1773#endif /* KDEBUG */
1774
1775      // min_std stuff
1776      if ((strat->P.p1==NULL) && (strat->minim>0))
1777      {
1778        if (strat->minim==1)
1779        {
1780          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1781          p_Delete(&strat->P.p2, currRing, strat->tailRing);
1782        }
1783        else
1784        {
1785          strat->M->m[minimcnt]=strat->P.p2;
1786          strat->P.p2=NULL;
1787        }
1788        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1789          pNext(strat->M->m[minimcnt])
1790            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1791                                           strat->tailRing, currRing,
1792                                           currRing->PolyBin);
1793        minimcnt++;
1794      }
1795
1796      // enter into S, L, and T
1797      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1798      if(!strat->incremental)
1799      {
1800        BOOLEAN overwrite = TRUE;
1801        for (int tk=0; tk<strat->sl+1; tk++)
1802        {
1803          if (pGetComp(strat->sig[tk]) == pGetComp(strat->P.sig))
1804          {
1805            //printf("TK %d / %d\n",tk,strat->sl);
1806            overwrite = FALSE;
1807            break;
1808          }
1809        }
1810        //printf("OVERWRITE %d\n",overwrite);
1811        if (overwrite)
1812        {
1813          int cmp = pGetComp(strat->P.sig);
1814          int* vv = (int*)omAlloc((currRing->N+1)*sizeof(int));
1815          pGetExpV (strat->P.p,vv);
1816          pSetExpV (strat->P.sig, vv);
1817          pSetComp (strat->P.sig,cmp);
1818
1819          strat->P.sevSig = pGetShortExpVector (strat->P.sig);
1820          for(int ps=0;ps<strat->sl+1;ps++)
1821          {
1822            int i = strat->syzl;
1823
1824            strat->newt = TRUE;
1825            if (strat->syzl == strat->syzmax)
1826            {
1827              pEnlargeSet(&strat->syz,strat->syzmax,setmaxTinc);
1828              strat->sevSyz = (unsigned long*) omRealloc0Size(strat->sevSyz,
1829                  (strat->syzmax)*sizeof(unsigned long),
1830                  ((strat->syzmax)+setmaxTinc)
1831                  *sizeof(unsigned long));
1832              strat->syzmax += setmaxTinc;
1833            }
1834            strat->syz[i] = pCopy(strat->P.sig);
1835            // add LM(F->m[i]) to the signature to get a Schreyer order
1836            // without changing the underlying polynomial ring at all
1837            p_ExpVectorAdd (strat->syz[i],strat->S[ps],currRing); 
1838            // since p_Add_q() destroys all input
1839            // data we need to recreate help
1840            // each time
1841            // ----------------------------------------------------------
1842            // in the Schreyer order we always know that the multiplied
1843            // module monomial strat->P.sig gives the leading monomial of
1844            // the corresponding principal syzygy
1845            // => we do not need to compute the "real" syzygy completely
1846            poly help = pCopy(strat->sig[ps]);
1847            p_ExpVectorAdd (help,strat->P.p,currRing); 
1848            strat->syz[i] = p_Add_q(strat->syz[i],help,currRing);
1849            //printf("%d. SYZ  ",i+1);
1850            //pWrite(strat->syz[i]);
1851            strat->sevSyz[i] = p_GetShortExpVector(strat->syz[i],currRing);
1852            strat->syzl++;
1853          }
1854        }
1855      }
1856        enterT(strat->P, strat);
1857        strat->T[strat->tl].is_sigsafe = FALSE;
1858#ifdef HAVE_RINGS
1859      if (rField_is_Ring(currRing))
1860        superenterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1861      else
1862#endif
1863        enterpairsSig(strat->P.p,strat->P.sig,strat->sl+1,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1864      // posInS only depends on the leading term
1865      strat->enterS(strat->P, pos, strat, strat->tl);
1866//#if 1
1867#if DEBUGF50
1868    printf("---------------------------\n");
1869    Print(" %d. ELEMENT ADDED TO GCURR:\n",strat->sl+1);
1870    Print("LEAD POLY:  "); pWrite(pHead(strat->S[strat->sl]));
1871    Print("SIGNATURE:  "); pWrite(strat->sig[strat->sl]);
1872#endif
1873      /*
1874      if (newrules)
1875      {
1876        newrules  = FALSE;
1877      }
1878      */
1879#if 0
1880      int pl=pLength(strat->P.p);
1881      if (pl==1)
1882      {
1883        //if (TEST_OPT_PROT)
1884        //PrintS("<1>");
1885      }
1886      else if (pl==2)
1887      {
1888        //if (TEST_OPT_PROT)
1889        //PrintS("<2>");
1890      }
1891#endif
1892      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1893//      Print("[%d]",hilbeledeg);
1894      if (strat->P.lcm!=NULL)
1895#ifdef HAVE_RINGS
1896        pLmDelete(strat->P.lcm);
1897#else
1898        pLmFree(strat->P.lcm);
1899#endif
1900      if (strat->sl>srmax) srmax = strat->sl;
1901    }
1902    else
1903    {
1904      // adds signature of the zero reduction to
1905      // strat->syz. This is the leading term of
1906      // syzygy and can be used in syzCriterion()
1907      // the signature is added if and only if the
1908      // pair was not detected by the rewritten criterion in strat->red = redSig
1909      if (red_result!=2) {
1910        zeroreductions++;
1911        enterSyz(strat->P,strat);
1912//#if 1
1913#ifdef DEBUGF5
1914        Print("ADDING STUFF TO SYZ :  ");
1915        pWrite(strat->P.p);
1916        pWrite(strat->P.sig);
1917#endif
1918      }
1919      if (strat->P.p1 == NULL && strat->minim > 0)
1920      {
1921        p_Delete(&strat->P.p2, currRing, strat->tailRing);
1922      }
1923    }
1924
1925#ifdef KDEBUG
1926    memset(&(strat->P), 0, sizeof(strat->P));
1927#endif /* KDEBUG */
1928    kTest_TS(strat);
1929  }
1930#ifdef KDEBUG
1931#if MYTEST
1932  PrintS("bba finish GB: currRing: "); rWrite(currRing);
1933#endif /* MYTEST */
1934  if (TEST_OPT_DEBUG) messageSets(strat);
1935#endif /* KDEBUG */
1936
1937  if (TEST_OPT_SB_1)
1938  {
1939    int k=1;
1940    int j;
1941    while(k<=strat->sl)
1942    {
1943      j=0;
1944      loop
1945      {
1946        if (j>=k) break;
1947        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1948        j++;
1949      }
1950      k++;
1951    }
1952  }
1953
1954  /* complete reduction of the standard basis--------- */
1955  if (TEST_OPT_REDSB)
1956  {
1957    completeReduce(strat);
1958#ifdef HAVE_TAIL_RING
1959    if (strat->completeReduce_retry)
1960    {
1961      // completeReduce needed larger exponents, retry
1962      // to reduce with S (instead of T)
1963      // and in currRing (instead of strat->tailRing)
1964      cleanT(strat);strat->tailRing=currRing;
1965      int i;
1966      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1967      completeReduce(strat);
1968    }
1969#endif
1970  }
1971  else if (TEST_OPT_PROT) PrintLn();
1972
1973  exitSba(strat);
1974//  if (TEST_OPT_WEIGHTM)
1975//  {
1976//    pRestoreDegProcs(pFDegOld, pLDegOld);
1977//    if (ecartWeights)
1978//    {
1979//      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1980//      ecartWeights=NULL;
1981//    }
1982//  }
1983  if (TEST_OPT_PROT) messageStat(hilbcount,strat);
1984  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1985
1986#ifdef KDEBUG
1987#if MYTEST
1988  PrintS("bba_end: currRing: "); rWrite(currRing);
1989#endif /* MYTEST */
1990#endif /* KDEBUG */
1991  // using F5C it is possible that there is some data stored in the last
1992  // entries of strat->Shdl which are dirty, i.e. not correct, but also not NULL
1993  // => we need to delete them before return the ideal
1994#if F5C
1995  for(int i=strat->sl+1;i<IDELEMS(strat->Shdl);i++)
1996  {
1997    //pDelete (&strat->Shdl->m[i]);
1998    strat->Shdl->m[i] = NULL;
1999  }
2000#endif
2001  if (strat->incremental && sRing!=currRingOld)
2002  {
2003    rChangeCurrRing (currRingOld);
2004    F0          = idrMoveR (F, sRing, currRing);
2005    strat->Shdl = idrMoveR_NoSort (strat->Shdl, sRing, currRing);
2006    rDelete (sRing);
2007  }
2008  idTest(strat->Shdl);
2009
2010#ifdef DEBUGF5
2011  printf("SIZE OF SHDL: %d\n",IDELEMS(strat->Shdl));
2012  int oo = 0;
2013  while (oo<IDELEMS(strat->Shdl))
2014  {
2015    printf(" %d.   ",oo+1);
2016    pWrite(pHead(strat->Shdl->m[oo]));
2017    oo++;
2018  }
2019#endif
2020  printf("ZERO REDUCTIONS: %ld\n",zeroreductions);
2021  zeroreductions  = 0;
2022  return (strat->Shdl);
2023}
2024
2025poly kNF2 (ideal F,ideal Q,poly q,kStrategy strat, int lazyReduce)
2026{
2027  assume(q!=NULL);
2028  assume(!(idIs0(F)&&(Q==NULL))); // NF(q, std(0) in polynomial ring?
2029
2030// lazy_reduce flags: can be combined by |
2031//#define KSTD_NF_LAZY   1
2032  // do only a reduction of the leading term
2033//#define KSTD_NF_NONORM 4
2034  // only global: avoid normalization, return a multiply of NF
2035  poly   p;
2036
2037  //if ((idIs0(F))&&(Q==NULL))
2038  //  return pCopy(q); /*F=0*/
2039  //strat->ak = idRankFreeModule(F);
2040  /*- creating temp data structures------------------- -*/
2041  BITSET save1;
2042  SI_SAVE_OPT1(save1);
2043  si_opt_1|=Sy_bit(OPT_REDTAIL);
2044  initBuchMoraCrit(strat);
2045  strat->initEcart = initEcartBBA;
2046  strat->enterS = enterSBba;
2047#ifndef NO_BUCKETS
2048  strat->use_buckets = (!TEST_OPT_NOT_BUCKETS) && (!rIsPluralRing(currRing));
2049#endif
2050  /*- set S -*/
2051  strat->sl = -1;
2052  /*- init local data struct.---------------------------------------- -*/
2053  /*Shdl=*/initS(F,Q,strat);
2054  /*- compute------------------------------------------------------- -*/
2055  //if ((TEST_OPT_INTSTRATEGY)&&(lazyReduce==0))
2056  //{
2057  //  for (i=strat->sl;i>=0;i--)
2058  //    pNorm(strat->S[i]);
2059  //}
2060  kTest(strat);
2061  if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
2062  if (BVERBOSE(23)) kDebugPrint(strat);
2063  int max_ind;
2064  p = redNF(pCopy(q),max_ind,lazyReduce & KSTD_NF_NONORM,strat);
2065  if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
2066  {
2067    if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
2068    #ifdef HAVE_RINGS
2069    if (rField_is_Ring(currRing))
2070    {
2071      p = redtailBba_Z(p,max_ind,strat);
2072    }
2073    else
2074    #endif
2075    {
2076      si_opt_1 &= ~Sy_bit(OPT_INTSTRATEGY);
2077      p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
2078    }
2079  }
2080  /*- release temp data------------------------------- -*/
2081  omfree(strat->sevS);
2082  omfree(strat->ecartS);
2083  omfree(strat->T);
2084  omfree(strat->sevT);
2085  omfree(strat->R);
2086  omfree(strat->S_2_R);
2087  omfree(strat->L);
2088  omfree(strat->B);
2089  omfree(strat->fromQ);
2090  idDelete(&strat->Shdl);
2091  SI_RESTORE_OPT1(save1);
2092  if (TEST_OPT_PROT) PrintLn();
2093  return p;
2094}
2095
2096ideal kNF2 (ideal F,ideal Q,ideal q,kStrategy strat, int lazyReduce)
2097{
2098  assume(!idIs0(q));
2099  assume(!(idIs0(F)&&(Q==NULL)));
2100// lazy_reduce flags: can be combined by |
2101//#define KSTD_NF_LAZY   1
2102  // do only a reduction of the leading term
2103//#define KSTD_NF_NONORM 4
2104  // only global: avoid normalization, return a multiply of NF
2105  poly   p;
2106  int   i;
2107  ideal res;
2108  int max_ind;
2109
2110  //if (idIs0(q))
2111  //  return idInit(IDELEMS(q),si_max(q->rank,F->rank));
2112  //if ((idIs0(F))&&(Q==NULL))
2113  //  return idCopy(q); /*F=0*/
2114  //strat->ak = idRankFreeModule(F);
2115  /*- creating temp data structures------------------- -*/
2116  BITSET save1;
2117  SI_SAVE_OPT1(save1);
2118  si_opt_1|=Sy_bit(OPT_REDTAIL);
2119  initBuchMoraCrit(strat);
2120  strat->initEcart = initEcartBBA;
2121  strat->enterS = enterSBba;
2122  /*- set S -*/
2123  strat->sl = -1;
2124#ifndef NO_BUCKETS
2125  strat->use_buckets = (!TEST_OPT_NOT_BUCKETS) && (!rIsPluralRing(currRing));
2126#endif
2127  /*- init local data struct.---------------------------------------- -*/
2128  /*Shdl=*/initS(F,Q,strat);
2129  /*- compute------------------------------------------------------- -*/
2130  res=idInit(IDELEMS(q),si_max(q->rank,F->rank));
2131  si_opt_1 &= ~Sy_bit(OPT_INTSTRATEGY);
2132  for (i=IDELEMS(q)-1; i>=0; i--)
2133  {
2134    if (q->m[i]!=NULL)
2135    {
2136      if (TEST_OPT_PROT) { PrintS("r");mflush(); }
2137      p = redNF(pCopy(q->m[i]),max_ind,lazyReduce & KSTD_NF_NONORM,strat);
2138      if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
2139      {
2140        if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
2141        #ifdef HAVE_RINGS
2142        if (rField_is_Ring(currRing))
2143        {
2144          p = redtailBba_Z(p,max_ind,strat);
2145        }
2146        else
2147        #endif
2148        {
2149          p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
2150        }
2151      }
2152      res->m[i]=p;
2153    }
2154    //else
2155    //  res->m[i]=NULL;
2156  }
2157  /*- release temp data------------------------------- -*/
2158  SI_RESTORE_OPT1(save1);
2159  omfree(strat->sevS);
2160  omfree(strat->ecartS);
2161  omfree(strat->T);
2162  omfree(strat->sevT);
2163  omfree(strat->R);
2164  omfree(strat->S_2_R);
2165  omfree(strat->L);
2166  omfree(strat->B);
2167  omfree(strat->fromQ);
2168  idDelete(&strat->Shdl);
2169  SI_RESTORE_OPT1(save1);
2170  if (TEST_OPT_PROT) PrintLn();
2171  return res;
2172}
2173
2174#if F5C
2175/*********************************************************************
2176* interrreduction step of the signature-based algorithm:
2177* 1. all strat->S are interpreted as new critical pairs
2178* 2. those pairs need to be completely reduced by the usual (non sig-
2179*    safe) reduction process (including tail reductions)
2180* 3. strat->S and strat->T are completely new computed in these steps
2181********************************************************************/
2182void f5c (kStrategy strat, int& olddeg, int& minimcnt, int& hilbeledeg, 
2183          int& hilbcount, int& srmax, int& lrmax, int& reduc, ideal Q,
2184          intvec *w,intvec *hilb )
2185{
2186  int Ll_old, red_result = 1;
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 /* setting global variables ------------------- */
3004  strat->enterS = enterSBba; /* remains as is, we change enterT! */
3005
3006  strat->red = redFirstShift; /* no redHomog ! */
3007
3008  if (currRing->pLexOrder && strat->honey)
3009    strat->initEcart = initEcartNormal;
3010  else
3011    strat->initEcart = initEcartBBA;
3012  if (strat->honey)
3013    strat->initEcartPair = initEcartPairMora;
3014  else
3015    strat->initEcartPair = initEcartPairBba;
3016//  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
3017//  {
3018//    //interred  machen   Aenderung
3019//    pFDegOld=currRing->pFDeg;
3020//    pLDegOld=pLDeg;
3021//    //h=ggetid("ecart");
3022//    //if ((h!=NULL) /*&& (IDTYP(h)==INTVEC_CMD)*/)
3023//    //{
3024//    //  ecartWeights=iv2array(IDINTVEC(h));
3025//    //}
3026//    //else
3027//    {
3028//      ecartWeights=(short *)omAlloc(((currRing->N)+1)*sizeof(short));
3029//      /*uses automatic computation of the ecartWeights to set them*/
3030//      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights,currRing);
3031//    }
3032//    pRestoreDegProcs(currRing,totaldegreeWecart, maxdegreeWecart);
3033//    if (TEST_OPT_PROT)
3034//    {
3035//      for(int i=1; i<=rVar(currRing); i++)
3036//        Print(" %d",ecartWeights[i]);
3037//      PrintLn();
3038//      mflush();
3039//    }
3040//  }
3041}
3042#endif
Note: See TracBrowser for help on using the repository browser.