source: git/kernel/kstd2.cc @ f59aaa

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