source: git/kernel/kstd2.cc @ b085fba

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