source: git/kernel/GBEngine/kstd2.cc @ 3e5610

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