source: git/kernel/kstd2.cc @ e5ecb5

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