source: git/kernel/GBEngine/kstd2.cc @ 4d5a3e

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