source: git/kernel/kstd2.cc @ abe5c8

spielwiese
Last change on this file since abe5c8 was fee33e, checked in by Christian Eder, 12 years ago
fixes signature-based stuff in kstd2.cc for spielwiese
  • Property mode set to 100644
File size: 80.5 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          h->last=NULL;
903          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
904#ifdef KDEBUG
905          if (TEST_OPT_DEBUG) Print(" ecart too big: -> L%d\n",at);
906#endif
907          h->Clear();
908          return -1;
909        }
910      }
911    }
912#ifdef KDEBUG
913    if (TEST_OPT_DEBUG)
914    {
915      PrintS("red:");
916      h->wrp();
917      PrintS(" with ");
918      strat->T[ii].wrp();
919    }
920#endif
921    assume(strat->fromT == FALSE);
922
923    number coef;
924    ksReducePoly(h,&(strat->T[ii]),strat->kNoetherTail(),&coef,strat);
925#ifdef KDEBUG
926    if (TEST_OPT_DEBUG)
927    {
928      PrintS("\nto:");
929      h->wrp();
930      PrintLn();
931    }
932#endif
933    if(h->IsNull())
934    {
935      h->Clear();
936      if (h->lcm!=NULL) pLmFree(h->lcm);
937      #ifdef KDEBUG
938      h->lcm=NULL;
939      #endif
940      return 0;
941    }
942    h->SetShortExpVector();
943    not_sev = ~ h->sev;
944    h_d = h->SetpFDeg();
945    /* compute the ecart */
946    if (ei <= h->ecart)
947      h->ecart = d-h_d;
948    else
949      h->ecart = d-h_d+ei-h->ecart;
950
951    /*
952     * try to reduce the s-polynomial h
953     *test first whether h should go to the lazyset L
954     *-if the degree jumps
955     *-if the number of pre-defined reductions jumps
956     */
957    pass++;
958    d = h_d + h->ecart;
959    if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
960    {
961      h->GetTP(); // clear bucket
962      h->SetLmCurrRing();
963      at = strat->posInL(strat->L,strat->Ll,h,strat);
964      if (at <= strat->Ll)
965      {
966        int dummy=strat->sl;
967        h->last=NULL;
968        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
969          return 1;
970        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
971#ifdef KDEBUG
972        if (TEST_OPT_DEBUG)
973          Print(" degree jumped: -> L%d\n",at);
974#endif
975        h->Clear();
976        return -1;
977      }
978    }
979    else if (d > reddeg)
980    {
981      if (d>=strat->tailRing->bitmask)
982      {
983        if (h->pTotalDeg()+h->ecart >= strat->tailRing->bitmask)
984        {
985          strat->overflow=TRUE;
986          //Print("OVERFLOW in redHoney d=%ld, max=%ld\n",d,strat->tailRing->bitmask);
987          h->GetP();
988          at = strat->posInL(strat->L,strat->Ll,h,strat);
989          h->last=NULL;
990          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
991          h->Clear();
992          return -1;
993        }
994      }
995      else if (TEST_OPT_PROT && (strat->Ll < 0) )
996      {
997        //h->wrp(); Print("<%d>\n",h->GetpLength());
998        reddeg = d;
999        Print(".%ld",d); mflush();
1000      }
1001    }
1002  }
1003}
1004
1005/*2
1006*  reduction procedure for the normal form
1007*/
1008
1009poly redNF (poly h,int &max_ind,int nonorm,kStrategy strat)
1010{
1011  if (h==NULL) return NULL;
1012  int j;
1013  max_ind=strat->sl;
1014
1015  if (0 > strat->sl)
1016  {
1017    return h;
1018  }
1019  LObject P(h);
1020  P.SetShortExpVector();
1021  P.bucket = kBucketCreate(currRing);
1022  kBucketInit(P.bucket,P.p,pLength(P.p));
1023  kbTest(P.bucket);
1024#ifdef HAVE_RINGS
1025  BOOLEAN is_ring = rField_is_Ring(currRing);
1026#endif
1027#ifdef KDEBUG
1028  if (TEST_OPT_DEBUG)
1029  {
1030    PrintS("redNF: starting S: ");
1031    for( j = 0; j <= max_ind; j++ )
1032    {
1033      Print("S[%d] (of size: %d): ", j, pSize(strat->S[j]));
1034      pWrite(strat->S[j]);
1035    }
1036  };
1037#endif
1038
1039  loop
1040  {
1041    j=kFindDivisibleByInS(strat,&max_ind,&P);
1042    if (j>=0)
1043    {
1044#ifdef HAVE_RINGS
1045      if (!is_ring)
1046      {
1047#endif
1048        int sl=pSize(strat->S[j]);
1049        int jj=j;
1050        loop
1051        {
1052          int sll;
1053          jj=kFindNextDivisibleByInS(strat,jj+1,max_ind,&P);
1054          if (jj<0) break;
1055          sll=pSize(strat->S[jj]);
1056          if (sll<sl)
1057          {
1058            #ifdef KDEBUG
1059            if (TEST_OPT_DEBUG) Print("better(S%d:%d -> S%d:%d)\n",j,sl,jj,sll);
1060            #endif
1061            //else if (TEST_OPT_PROT) { PrintS("b"); mflush(); }
1062            j=jj;
1063            sl=sll;
1064          }
1065        }
1066        if ((nonorm==0) && (!nIsOne(pGetCoeff(strat->S[j]))))
1067        {
1068          pNorm(strat->S[j]);
1069          //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
1070        }
1071#ifdef HAVE_RINGS
1072      }
1073#endif
1074      nNormalize(pGetCoeff(P.p));
1075#ifdef KDEBUG
1076      if (TEST_OPT_DEBUG)
1077      {
1078        PrintS("red:");
1079        wrp(h);
1080        PrintS(" with ");
1081        wrp(strat->S[j]);
1082      }
1083#endif
1084#ifdef HAVE_PLURAL
1085      if (rIsPluralRing(currRing))
1086      {
1087        number coef;
1088        nc_kBucketPolyRed(P.bucket,strat->S[j],&coef);
1089        nDelete(&coef);
1090      }
1091      else
1092#endif
1093      {
1094        number coef;
1095        coef=kBucketPolyRed(P.bucket,strat->S[j],pLength(strat->S[j]),strat->kNoether);
1096        nDelete(&coef);
1097      }
1098      h = kBucketGetLm(P.bucket);   // FRAGE OLIVER
1099      if (h==NULL)
1100      {
1101        kBucketDestroy(&P.bucket);
1102
1103#ifdef KDEBUG
1104        if (TEST_OPT_DEBUG)
1105        {
1106          PrintS("redNF: starting S: ");
1107          for( j = 0; j <= max_ind; j++ )
1108          {
1109            Print("S[%d] (of size: %d): ", j, pSize(strat->S[j]));
1110            pWrite(strat->S[j]);
1111          }
1112        };
1113#endif
1114
1115        return NULL;
1116      }
1117      kbTest(P.bucket);
1118      P.p=h;
1119      P.t_p=NULL;
1120      P.SetShortExpVector();
1121#ifdef KDEBUG
1122      if (TEST_OPT_DEBUG)
1123      {
1124        PrintS("\nto:");
1125        wrp(h);
1126        PrintLn();
1127      }
1128#endif
1129    }
1130    else
1131    {
1132      P.p=kBucketClear(P.bucket);
1133      kBucketDestroy(&P.bucket);
1134      pNormalize(P.p);
1135
1136#ifdef KDEBUG
1137      if (TEST_OPT_DEBUG)
1138      {
1139        PrintS("redNF: starting S: ");
1140        for( j = 0; j <= max_ind; j++ )
1141        {
1142          Print("S[%d] (of size: %d): ", j, pSize(strat->S[j]));
1143          pWrite(strat->S[j]);
1144        }
1145      };
1146#endif
1147
1148      return P.p;
1149    }
1150  }
1151}
1152
1153#ifdef KDEBUG
1154static int bba_count = 0;
1155#endif /* KDEBUG */
1156void kDebugPrint(kStrategy strat);
1157
1158ideal bba (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
1159{
1160#ifdef KDEBUG
1161  bba_count++;
1162  int loop_count = 0;
1163#endif /* KDEBUG */
1164  om_Opts.MinTrack = 5;
1165  int   red_result = 1;
1166  int   olddeg,reduc;
1167  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1168  BOOLEAN withT = FALSE;
1169
1170  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1171  initBuchMoraPos(strat);
1172  initHilbCrit(F,Q,&hilb,strat);
1173  initBba(F,strat);
1174  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1175  /*Shdl=*/initBuchMora(F, Q,strat);
1176  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
1177  reduc = olddeg = 0;
1178
1179#ifndef NO_BUCKETS
1180  if (!TEST_OPT_NOT_BUCKETS)
1181    strat->use_buckets = 1;
1182#endif
1183
1184  // redtailBBa against T for inhomogenous input
1185  if (!TEST_OPT_OLDSTD)
1186    withT = ! strat->homog;
1187
1188  // strat->posInT = posInT_pLength;
1189  kTest_TS(strat);
1190
1191#ifdef KDEBUG
1192#if MYTEST
1193  if (TEST_OPT_DEBUG)
1194  {
1195    PrintS("bba start GB: currRing: ");
1196    // rWrite(currRing);PrintLn();
1197    rDebugPrint(currRing);
1198    PrintLn();
1199  }
1200#endif /* MYTEST */
1201#endif /* KDEBUG */
1202
1203#ifdef HAVE_TAIL_RING
1204  if(!idIs0(F) &&(!rField_is_Ring(currRing)))  // create strong gcd poly computes with tailring and S[i] ->to be fixed
1205    kStratInitChangeTailRing(strat);
1206#endif
1207  if (BVERBOSE(23))
1208  {
1209    if (test_PosInT!=NULL) strat->posInT=test_PosInT;
1210    if (test_PosInL!=NULL) strat->posInL=test_PosInL;
1211    kDebugPrint(strat);
1212  }
1213
1214
1215#ifdef KDEBUG
1216  //kDebugPrint(strat);
1217#endif
1218  /* compute------------------------------------------------------- */
1219  while (strat->Ll >= 0)
1220  {
1221    #ifdef KDEBUG
1222      loop_count++;
1223      if (TEST_OPT_DEBUG) messageSets(strat);
1224    #endif
1225    if (strat->Ll== 0) strat->interpt=TRUE;
1226    if (TEST_OPT_DEGBOUND
1227        && ((strat->honey && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1228            || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1229    {
1230      /*
1231       *stops computation if
1232       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1233       *a predefined number Kstd1_deg
1234       */
1235      while ((strat->Ll >= 0)
1236        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1237        && ((strat->honey && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1238            || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1239        )
1240        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1241      if (strat->Ll<0) break;
1242      else strat->noClearS=TRUE;
1243    }
1244    /* picks the last element from the lazyset L */
1245    strat->P = strat->L[strat->Ll];
1246    strat->Ll--;
1247
1248    if (pNext(strat->P.p) == strat->tail)
1249    {
1250      // deletes the short spoly
1251#ifdef HAVE_RINGS
1252      if (rField_is_Ring(currRing))
1253        pLmDelete(strat->P.p);
1254      else
1255#endif
1256        pLmFree(strat->P.p);
1257      strat->P.p = NULL;
1258      poly m1 = NULL, m2 = NULL;
1259
1260      // check that spoly creation is ok
1261      while (strat->tailRing != currRing &&
1262             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1263      {
1264        assume(m1 == NULL && m2 == NULL);
1265        // if not, change to a ring where exponents are at least
1266        // large enough
1267        if (!kStratChangeTailRing(strat))
1268        {
1269          WerrorS("OVERFLOW...");
1270          break;
1271        }
1272      }
1273      // create the real one
1274      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
1275                    strat->tailRing, m1, m2, strat->R);
1276    }
1277    else if (strat->P.p1 == NULL)
1278    {
1279      if (strat->minim > 0)
1280        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1281      // for input polys, prepare reduction
1282      strat->P.PrepareRed(strat->use_buckets);
1283    }
1284
1285    if (strat->P.p == NULL && strat->P.t_p == NULL)
1286    {
1287      red_result = 0;
1288    }
1289    else
1290    {
1291      if (TEST_OPT_PROT)
1292        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1293                &olddeg,&reduc,strat, red_result);
1294
1295      /* reduction of the element choosen from L */
1296      red_result = strat->red(&strat->P,strat);
1297      if (errorreported)  break;
1298    }
1299
1300    if (strat->overflow)
1301    {
1302        if (!kStratChangeTailRing(strat)) { Werror("OVERFLOW.."); break;}
1303    }
1304
1305    // reduction to non-zero new poly
1306    if (red_result == 1)
1307    {
1308      // get the polynomial (canonicalize bucket, make sure P.p is set)
1309      strat->P.GetP(strat->lmBin);
1310      // in the homogeneous case FDeg >= pFDeg (sugar/honey)
1311      // but now, for entering S, T, we reset it
1312      // in the inhomogeneous case: FDeg == pFDeg
1313      if (strat->homog) strat->initEcart(&(strat->P));
1314
1315      /* statistic */
1316      if (TEST_OPT_PROT) PrintS("s");
1317
1318      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1319
1320#ifdef KDEBUG
1321#if MYTEST
1322      PrintS("New S: "); p_DebugPrint(strat->P.p, currRing); PrintLn();
1323#endif /* MYTEST */
1324#endif /* KDEBUG */
1325
1326      // reduce the tail and normalize poly
1327      // in the ring case we cannot expect LC(f) = 1,
1328      // therefore we call pContent instead of pNorm
1329      if ((TEST_OPT_INTSTRATEGY) || (rField_is_Ring(currRing)))
1330      {
1331        strat->P.pCleardenom();
1332        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1333        {
1334          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1335          strat->P.pCleardenom();
1336        }
1337      }
1338      else
1339      {
1340        strat->P.pNorm();
1341        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1342          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1343      }
1344
1345#ifdef KDEBUG
1346      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1347#if MYTEST
1348      PrintS("New (reduced) S: "); p_DebugPrint(strat->P.p, currRing); PrintLn();
1349#endif /* MYTEST */
1350#endif /* KDEBUG */
1351
1352      // min_std stuff
1353      if ((strat->P.p1==NULL) && (strat->minim>0))
1354      {
1355        if (strat->minim==1)
1356        {
1357          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1358          p_Delete(&strat->P.p2, currRing, strat->tailRing);
1359        }
1360        else
1361        {
1362          strat->M->m[minimcnt]=strat->P.p2;
1363          strat->P.p2=NULL;
1364        }
1365        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1366          pNext(strat->M->m[minimcnt])
1367            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1368                                           strat->tailRing, currRing,
1369                                           currRing->PolyBin);
1370        minimcnt++;
1371      }
1372
1373      // enter into S, L, and T
1374      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1375        enterT(strat->P, strat);
1376#ifdef HAVE_RINGS
1377      if (rField_is_Ring(currRing))
1378        superenterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1379      else
1380#endif
1381        enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1382      // posInS only depends on the leading term
1383      strat->enterS(strat->P, pos, strat, strat->tl);
1384#if 0
1385      int pl=pLength(strat->P.p);
1386      if (pl==1)
1387      {
1388        //if (TEST_OPT_PROT)
1389        //PrintS("<1>");
1390      }
1391      else if (pl==2)
1392      {
1393        //if (TEST_OPT_PROT)
1394        //PrintS("<2>");
1395      }
1396#endif
1397      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1398//      Print("[%d]",hilbeledeg);
1399      if (strat->P.lcm!=NULL)
1400#ifdef HAVE_RINGS
1401        pLmDelete(strat->P.lcm);
1402#else
1403        pLmFree(strat->P.lcm);
1404#endif
1405    }
1406    else if (strat->P.p1 == NULL && strat->minim > 0)
1407    {
1408      p_Delete(&strat->P.p2, currRing, strat->tailRing);
1409    }
1410
1411#ifdef KDEBUG
1412    memset(&(strat->P), 0, sizeof(strat->P));
1413#endif /* KDEBUG */
1414    kTest_TS(strat);
1415  }
1416#ifdef KDEBUG
1417#if MYTEST
1418  PrintS("bba finish GB: currRing: "); rWrite(currRing);
1419#endif /* MYTEST */
1420  if (TEST_OPT_DEBUG) messageSets(strat);
1421#endif /* KDEBUG */
1422
1423  if (TEST_OPT_SB_1)
1424  {
1425    int k=1;
1426    int j;
1427    while(k<=strat->sl)
1428    {
1429      j=0;
1430      loop
1431      {
1432        if (j>=k) break;
1433        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1434        j++;
1435      }
1436      k++;
1437    }
1438  }
1439
1440  /* complete reduction of the standard basis--------- */
1441  if (TEST_OPT_REDSB)
1442  {
1443    completeReduce(strat);
1444#ifdef HAVE_TAIL_RING
1445    if (strat->completeReduce_retry)
1446    {
1447      // completeReduce needed larger exponents, retry
1448      // to reduce with S (instead of T)
1449      // and in currRing (instead of strat->tailRing)
1450      cleanT(strat);strat->tailRing=currRing;
1451      int i;
1452      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1453      completeReduce(strat);
1454    }
1455#endif
1456  }
1457  else if (TEST_OPT_PROT) PrintLn();
1458
1459  /* release temp data-------------------------------- */
1460  exitBuchMora(strat);
1461//  if (TEST_OPT_WEIGHTM)
1462//  {
1463//    pRestoreDegProcs(currRing,pFDegOld, pLDegOld);
1464//    if (ecartWeights)
1465//    {
1466//      omFreeSize((ADDRESS)ecartWeights,((currRing->N)+1)*sizeof(short));
1467//      ecartWeights=NULL;
1468//    }
1469//  }
1470  if (TEST_OPT_PROT) messageStat(hilbcount,strat);
1471  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1472
1473#ifdef KDEBUG
1474#if MYTEST
1475  PrintS("bba_end: currRing: "); rWrite(currRing);
1476#endif /* MYTEST */
1477#endif /* KDEBUG */
1478  idTest(strat->Shdl);
1479
1480  return (strat->Shdl);
1481}
1482ideal sba (ideal F0, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
1483{
1484  // ring order stuff:
1485  // in sba we have (until now) two possibilities:
1486  // 1. an incremental computation w.r.t. (C,monomial order)
1487  // 2. a (possibly non-incremental) computation w.r.t. the
1488  //    induced Schreyer order.
1489  // The corresponding orders are computed in sbaRing(), depending
1490  // on the flag strat->incremental
1491  ideal F = F0;
1492  ring sRing, currRingOld;
1493  currRingOld  = currRing; 
1494  if (strat->incremental)
1495  {
1496    sRing = sbaRing(strat);
1497    if (sRing!=currRingOld)
1498    {
1499      rChangeCurrRing (sRing);
1500      F = idrMoveR (F0, currRingOld, currRing);
1501    }
1502  }
1503#if 0
1504  printf("SBA COMPUTATIONS DONE IN THE FOLLOWING RING:\n");
1505  rWrite (currRing);
1506  printf("\n");
1507#endif
1508#ifdef KDEBUG
1509  bba_count++;
1510  int loop_count = 0;
1511#endif /* KDEBUG */
1512  om_Opts.MinTrack = 5;
1513  int   srmax,lrmax, red_result = 1;
1514  int   olddeg,reduc;
1515  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1516  long zeroreductions = 0;
1517  LObject L;
1518  BOOLEAN withT     = FALSE;
1519  BOOLEAN newrules  = FALSE;
1520  strat->max_lower_index = 0;
1521
1522  //initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1523  initSbaCrit(strat); /*set Gebauer, honey, sugarCrit*/
1524  initSbaPos(strat);
1525  //initBuchMoraPos(strat);
1526  initHilbCrit(F,Q,&hilb,strat);
1527  initSba(F,strat);
1528  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1529  /*Shdl=*/initSbaBuchMora(F, Q,strat);
1530  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
1531  srmax = strat->sl;
1532  reduc = olddeg = lrmax = 0;
1533
1534#ifndef NO_BUCKETS
1535  if (!TEST_OPT_NOT_BUCKETS)
1536    strat->use_buckets = 1;
1537#endif
1538
1539  // redtailBBa against T for inhomogenous input
1540  if (!TEST_OPT_OLDSTD)
1541    withT = ! strat->homog;
1542
1543  // strat->posInT = posInT_pLength;
1544  kTest_TS(strat);
1545
1546#ifdef KDEBUG
1547#if MYTEST
1548  if (TEST_OPT_DEBUG)
1549  {
1550    PrintS("bba start GB: currRing: ");
1551    // rWrite(currRing);PrintLn();
1552    rDebugPrint(currRing);
1553    PrintLn();
1554  }
1555#endif /* MYTEST */
1556#endif /* KDEBUG */
1557
1558#ifdef HAVE_TAIL_RING
1559  if(!idIs0(F) &&(!rField_is_Ring(currRing)))  // create strong gcd poly computes with tailring and S[i] ->to be fixed
1560    kStratInitChangeTailRing(strat);
1561#endif
1562  if (BVERBOSE(23))
1563  {
1564    if (test_PosInT!=NULL) strat->posInT=test_PosInT;
1565    if (test_PosInL!=NULL) strat->posInL=test_PosInL;
1566    kDebugPrint(strat);
1567  }
1568
1569
1570#ifdef KDEBUG
1571  //kDebugPrint(strat);
1572#endif
1573  /* compute------------------------------------------------------- */
1574  arriAgain:
1575  while (strat->Ll >= 0)
1576  {
1577    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1578    #ifdef KDEBUG
1579      loop_count++;
1580      if (TEST_OPT_DEBUG) messageSets(strat);
1581    #endif
1582    if (strat->Ll== 0) strat->interpt=TRUE;
1583    if (TEST_OPT_DEGBOUND
1584        && ((strat->honey && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1585            || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1586    {
1587      /*
1588       *stops computation if
1589       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1590       *a predefined number Kstd1_deg
1591       */
1592      while ((strat->Ll >= 0)
1593        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1594        && ((strat->honey && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1595            || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1596        )
1597        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1598      if (strat->Ll<0) break;
1599      else strat->noClearS=TRUE;
1600    }
1601    if (strat->incremental && pGetComp(strat->L[strat->Ll].sig) != strat->currIdx)
1602    {
1603      strat->currIdx  = pGetComp(strat->L[strat->Ll].sig);
1604#if F5C
1605      // 1. interreduction of the current standard basis
1606      // 2. generation of new principal syzygy rules for syzCriterion
1607      f5c ( strat, olddeg, minimcnt, hilbeledeg, hilbcount, srmax, 
1608            lrmax, reduc, Q, w, hilb );
1609#endif
1610      // initialize new syzygy rules for the next iteration step 
1611      initSyzRules(strat);
1612    }
1613    /*********************************************************************
1614     * interrreduction step is done, we can go on with the next iteration
1615     * step of the signature-based algorithm
1616     ********************************************************************/
1617    /* picks the last element from the lazyset L */
1618    strat->P = strat->L[strat->Ll];
1619    strat->Ll--;
1620//#if 1
1621#ifdef DEBUGF5
1622    Print("SIG OF NEXT PAIR TO HANDLE IN SIG-BASED ALGORITHM\n");
1623    Print("-------------------------------------------------\n");
1624    pWrite(strat->P.sig);
1625    pWrite(pHead(strat->P.p));
1626    pWrite(pHead(strat->P.p1));
1627    pWrite(pHead(strat->P.p2));
1628    Print("-------------------------------------------------\n");
1629#endif
1630    if (pNext(strat->P.p) == strat->tail)
1631    {
1632      // deletes the short spoly
1633#ifdef HAVE_RINGS
1634      if (rField_is_Ring(currRing))
1635        pLmDelete(strat->P.p);
1636      else
1637#endif
1638        pLmFree(strat->P.p);
1639
1640      // TODO: needs some masking
1641      // TODO: masking needs to vanish once the signature
1642      //       sutff is completely implemented
1643      strat->P.p = NULL;
1644      poly m1 = NULL, m2 = NULL;
1645
1646      // check that spoly creation is ok
1647      while (strat->tailRing != currRing &&
1648             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1649      {
1650        assume(m1 == NULL && m2 == NULL);
1651        // if not, change to a ring where exponents are at least
1652        // large enough
1653        if (!kStratChangeTailRing(strat))
1654        {
1655          WerrorS("OVERFLOW...");
1656          break;
1657        }
1658      }
1659      // create the real one
1660      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
1661                    strat->tailRing, m1, m2, strat->R);
1662
1663    }
1664    else if (strat->P.p1 == NULL)
1665    {
1666      if (strat->minim > 0)
1667        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1668      // for input polys, prepare reduction
1669      strat->P.PrepareRed(strat->use_buckets);
1670    }
1671
1672    if (strat->P.p == NULL && strat->P.t_p == NULL)
1673    {
1674      red_result = 0;
1675    }
1676    else
1677    {
1678      if (TEST_OPT_PROT)
1679        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1680                &olddeg,&reduc,strat, red_result);
1681
1682//#if 1
1683#ifdef DEBUGF5
1684      Print("Poly before red: ");
1685      pWrite(strat->P.p);
1686#endif
1687      /* reduction of the element choosen from L */
1688      if (!strat->rewCrit2(strat->P.sig, ~strat->P.sevSig, strat, strat->P.checked+1))
1689        red_result = strat->red(&strat->P,strat);
1690      else
1691      {
1692        if (strat->P.lcm!=NULL)
1693          pLmFree(strat->P.lcm);
1694        red_result = 2;
1695      }
1696      if (errorreported)  break;
1697    }
1698
1699    if (strat->overflow)
1700    {
1701        if (!kStratChangeTailRing(strat)) { Werror("OVERFLOW.."); break;}
1702    }
1703    if (strat->incremental)
1704    {
1705      for (int jj = 0; jj<strat->tl+1; jj++)
1706      {
1707        if (pGetComp(strat->T[jj].sig) == strat->currIdx)
1708        {
1709          strat->T[jj].is_sigsafe = FALSE;
1710        }
1711      }
1712    }
1713    else
1714    {
1715      for (int jj = 0; jj<strat->tl+1; jj++)
1716      {
1717        strat->T[jj].is_sigsafe = FALSE;
1718      }
1719    }
1720
1721    // reduction to non-zero new poly
1722    if (red_result == 1)
1723    {
1724      // get the polynomial (canonicalize bucket, make sure P.p is set)
1725      strat->P.GetP(strat->lmBin);
1726     
1727      // sig-safe computations may lead to wrong FDeg computation, thus we need
1728      // to recompute it to make sure everything is alright
1729      (strat->P).FDeg = (strat->P).pFDeg();
1730      // in the homogeneous case FDeg >= pFDeg (sugar/honey)
1731      // but now, for entering S, T, we reset it
1732      // in the inhomogeneous case: FDeg == pFDeg
1733      if (strat->homog) strat->initEcart(&(strat->P));
1734
1735      /* statistic */
1736      if (TEST_OPT_PROT) PrintS("s");
1737
1738      //int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1739      // in F5E we know that the last reduced element is already the
1740      // the one with highest signature
1741      int pos = strat->sl+1;
1742
1743#ifdef KDEBUG
1744#if MYTEST
1745      PrintS("New S: "); pDebugPrint(strat->P.p); PrintLn();
1746#endif /* MYTEST */
1747#endif /* KDEBUG */
1748
1749      // reduce the tail and normalize poly
1750      // in the ring case we cannot expect LC(f) = 1,
1751      // therefore we call pContent instead of pNorm
1752      /*
1753      if ((TEST_OPT_INTSTRATEGY) || (rField_is_Ring(currRing)))
1754      {
1755        strat->P.pCleardenom();
1756        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1757        {
1758          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1759          strat->P.pCleardenom();
1760        }
1761      }
1762      else
1763      {
1764        strat->P.pNorm();
1765        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1766          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1767      }
1768      */
1769#ifdef KDEBUG
1770      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1771#if MYTEST
1772//#if 1
1773      PrintS("New (reduced) S: "); pDebugPrint(strat->P.p); PrintLn();
1774#endif /* MYTEST */
1775#endif /* KDEBUG */
1776
1777      // min_std stuff
1778      if ((strat->P.p1==NULL) && (strat->minim>0))
1779      {
1780        if (strat->minim==1)
1781        {
1782          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1783          p_Delete(&strat->P.p2, currRing, strat->tailRing);
1784        }
1785        else
1786        {
1787          strat->M->m[minimcnt]=strat->P.p2;
1788          strat->P.p2=NULL;
1789        }
1790        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1791          pNext(strat->M->m[minimcnt])
1792            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1793                                           strat->tailRing, currRing,
1794                                           currRing->PolyBin);
1795        minimcnt++;
1796      }
1797
1798      // enter into S, L, and T
1799      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1800      if(!strat->incremental)
1801      {
1802        BOOLEAN overwrite = TRUE;
1803        for (int tk=0; tk<strat->sl+1; tk++)
1804        {
1805          if (pGetComp(strat->sig[tk]) == pGetComp(strat->P.sig))
1806          {
1807            //printf("TK %d / %d\n",tk,strat->sl);
1808            overwrite = FALSE;
1809            break;
1810          }
1811        }
1812        //printf("OVERWRITE %d\n",overwrite);
1813        if (overwrite)
1814        {
1815          int cmp = pGetComp(strat->P.sig);
1816          int* vv = (int*)omAlloc((currRing->N+1)*sizeof(int));
1817          pGetExpV (strat->P.p,vv);
1818          pSetExpV (strat->P.sig, vv);
1819          pSetComp (strat->P.sig,cmp);
1820
1821          strat->P.sevSig = pGetShortExpVector (strat->P.sig);
1822          for(int ps=0;ps<strat->sl+1;ps++)
1823          {
1824            int i = strat->syzl;
1825
1826            strat->newt = TRUE;
1827            if (strat->syzl == strat->syzmax)
1828            {
1829              pEnlargeSet(&strat->syz,strat->syzmax,setmaxTinc);
1830              strat->sevSyz = (unsigned long*) omRealloc0Size(strat->sevSyz,
1831                  (strat->syzmax)*sizeof(unsigned long),
1832                  ((strat->syzmax)+setmaxTinc)
1833                  *sizeof(unsigned long));
1834              strat->syzmax += setmaxTinc;
1835            }
1836            strat->syz[i] = pCopy(strat->P.sig);
1837            // add LM(F->m[i]) to the signature to get a Schreyer order
1838            // without changing the underlying polynomial ring at all
1839            p_ExpVectorAdd (strat->syz[i],strat->S[ps],currRing); 
1840            // since p_Add_q() destroys all input
1841            // data we need to recreate help
1842            // each time
1843            // ----------------------------------------------------------
1844            // in the Schreyer order we always know that the multiplied
1845            // module monomial strat->P.sig gives the leading monomial of
1846            // the corresponding principal syzygy
1847            // => we do not need to compute the "real" syzygy completely
1848            poly help = pCopy(strat->sig[ps]);
1849            p_ExpVectorAdd (help,strat->P.p,currRing); 
1850            strat->syz[i] = p_Add_q(strat->syz[i],help,currRing);
1851            //printf("%d. SYZ  ",i+1);
1852            //pWrite(strat->syz[i]);
1853            strat->sevSyz[i] = p_GetShortExpVector(strat->syz[i],currRing);
1854            strat->syzl++;
1855          }
1856        }
1857      }
1858        enterT(strat->P, strat);
1859        strat->T[strat->tl].is_sigsafe = FALSE;
1860#ifdef HAVE_RINGS
1861      if (rField_is_Ring(currRing))
1862        superenterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1863      else
1864#endif
1865        enterpairsSig(strat->P.p,strat->P.sig,strat->sl+1,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1866      // posInS only depends on the leading term
1867      strat->enterS(strat->P, pos, strat, strat->tl);
1868//#if 1
1869#if DEBUGF50
1870    printf("---------------------------\n");
1871    Print(" %d. ELEMENT ADDED TO GCURR:\n",strat->sl+1);
1872    Print("LEAD POLY:  "); pWrite(pHead(strat->S[strat->sl]));
1873    Print("SIGNATURE:  "); pWrite(strat->sig[strat->sl]);
1874#endif
1875      /*
1876      if (newrules)
1877      {
1878        newrules  = FALSE;
1879      }
1880      */
1881#if 0
1882      int pl=pLength(strat->P.p);
1883      if (pl==1)
1884      {
1885        //if (TEST_OPT_PROT)
1886        //PrintS("<1>");
1887      }
1888      else if (pl==2)
1889      {
1890        //if (TEST_OPT_PROT)
1891        //PrintS("<2>");
1892      }
1893#endif
1894      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1895//      Print("[%d]",hilbeledeg);
1896      if (strat->P.lcm!=NULL)
1897#ifdef HAVE_RINGS
1898        pLmDelete(strat->P.lcm);
1899#else
1900        pLmFree(strat->P.lcm);
1901#endif
1902      if (strat->sl>srmax) srmax = strat->sl;
1903    }
1904    else
1905    {
1906      // adds signature of the zero reduction to
1907      // strat->syz. This is the leading term of
1908      // syzygy and can be used in syzCriterion()
1909      // the signature is added if and only if the
1910      // pair was not detected by the rewritten criterion in strat->red = redSig
1911      if (red_result!=2) {
1912        zeroreductions++;
1913        enterSyz(strat->P,strat);
1914//#if 1
1915#ifdef DEBUGF5
1916        Print("ADDING STUFF TO SYZ :  ");
1917        pWrite(strat->P.p);
1918        pWrite(strat->P.sig);
1919#endif
1920      }
1921      if (strat->P.p1 == NULL && strat->minim > 0)
1922      {
1923        p_Delete(&strat->P.p2, currRing, strat->tailRing);
1924      }
1925    }
1926
1927#ifdef KDEBUG
1928    memset(&(strat->P), 0, sizeof(strat->P));
1929#endif /* KDEBUG */
1930    kTest_TS(strat);
1931  }
1932#ifdef KDEBUG
1933#if MYTEST
1934  PrintS("bba finish GB: currRing: "); rWrite(currRing);
1935#endif /* MYTEST */
1936  if (TEST_OPT_DEBUG) messageSets(strat);
1937#endif /* KDEBUG */
1938
1939  if (TEST_OPT_SB_1)
1940  {
1941    int k=1;
1942    int j;
1943    while(k<=strat->sl)
1944    {
1945      j=0;
1946      loop
1947      {
1948        if (j>=k) break;
1949        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1950        j++;
1951      }
1952      k++;
1953    }
1954  }
1955
1956  /* complete reduction of the standard basis--------- */
1957  if (TEST_OPT_REDSB)
1958  {
1959    completeReduce(strat);
1960#ifdef HAVE_TAIL_RING
1961    if (strat->completeReduce_retry)
1962    {
1963      // completeReduce needed larger exponents, retry
1964      // to reduce with S (instead of T)
1965      // and in currRing (instead of strat->tailRing)
1966      cleanT(strat);strat->tailRing=currRing;
1967      int i;
1968      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1969      completeReduce(strat);
1970    }
1971#endif
1972  }
1973  else if (TEST_OPT_PROT) PrintLn();
1974
1975  exitSba(strat);
1976//  if (TEST_OPT_WEIGHTM)
1977//  {
1978//    pRestoreDegProcs(pFDegOld, pLDegOld);
1979//    if (ecartWeights)
1980//    {
1981//      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1982//      ecartWeights=NULL;
1983//    }
1984//  }
1985  if (TEST_OPT_PROT) messageStat(hilbcount,strat);
1986  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1987
1988#ifdef KDEBUG
1989#if MYTEST
1990  PrintS("bba_end: currRing: "); rWrite(currRing);
1991#endif /* MYTEST */
1992#endif /* KDEBUG */
1993  // using F5C it is possible that there is some data stored in the last
1994  // entries of strat->Shdl which are dirty, i.e. not correct, but also not NULL
1995  // => we need to delete them before return the ideal
1996#if F5C
1997  for(int i=strat->sl+1;i<IDELEMS(strat->Shdl);i++)
1998  {
1999    //pDelete (&strat->Shdl->m[i]);
2000    strat->Shdl->m[i] = NULL;
2001  }
2002#endif
2003  if (strat->incremental && sRing!=currRingOld)
2004  {
2005    rChangeCurrRing (currRingOld);
2006    F0          = idrMoveR (F, sRing, currRing);
2007    strat->Shdl = idrMoveR_NoSort (strat->Shdl, sRing, currRing);
2008    rDelete (sRing);
2009  }
2010  idTest(strat->Shdl);
2011
2012#ifdef DEBUGF5
2013  printf("SIZE OF SHDL: %d\n",IDELEMS(strat->Shdl));
2014  int oo = 0;
2015  while (oo<IDELEMS(strat->Shdl))
2016  {
2017    printf(" %d.   ",oo+1);
2018    pWrite(pHead(strat->Shdl->m[oo]));
2019    oo++;
2020  }
2021#endif
2022  printf("ZERO REDUCTIONS: %ld\n",zeroreductions);
2023  zeroreductions  = 0;
2024  return (strat->Shdl);
2025}
2026
2027poly kNF2 (ideal F,ideal Q,poly q,kStrategy strat, int lazyReduce)
2028{
2029  assume(q!=NULL);
2030  assume(!(idIs0(F)&&(Q==NULL))); // NF(q, std(0) in polynomial ring?
2031
2032// lazy_reduce flags: can be combined by |
2033//#define KSTD_NF_LAZY   1
2034  // do only a reduction of the leading term
2035//#define KSTD_NF_NONORM 4
2036  // only global: avoid normalization, return a multiply of NF
2037  poly   p;
2038  int   i;
2039
2040  //if ((idIs0(F))&&(Q==NULL))
2041  //  return pCopy(q); /*F=0*/
2042  //strat->ak = idRankFreeModule(F);
2043  /*- creating temp data structures------------------- -*/
2044  BITSET save_test=test;
2045  test|=Sy_bit(OPT_REDTAIL);
2046  initBuchMoraCrit(strat);
2047  strat->initEcart = initEcartBBA;
2048  strat->enterS = enterSBba;
2049#ifndef NO_BUCKETS
2050  strat->use_buckets = (!TEST_OPT_NOT_BUCKETS) && (!rIsPluralRing(currRing));
2051#endif
2052  /*- set S -*/
2053  strat->sl = -1;
2054  /*- init local data struct.---------------------------------------- -*/
2055  /*Shdl=*/initS(F,Q,strat);
2056  /*- compute------------------------------------------------------- -*/
2057  //if ((TEST_OPT_INTSTRATEGY)&&(lazyReduce==0))
2058  //{
2059  //  for (i=strat->sl;i>=0;i--)
2060  //    pNorm(strat->S[i]);
2061  //}
2062  kTest(strat);
2063  if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
2064  if (BVERBOSE(23)) kDebugPrint(strat);
2065  int max_ind;
2066  p = redNF(pCopy(q),max_ind,lazyReduce & KSTD_NF_NONORM,strat);
2067  if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
2068  {
2069    if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
2070    #ifdef HAVE_RINGS
2071    if (rField_is_Ring(currRing))
2072    {
2073      p = redtailBba_Z(p,max_ind,strat);
2074    }
2075    else
2076    #endif
2077    {
2078      BITSET save=test;
2079      test &= ~Sy_bit(OPT_INTSTRATEGY);
2080      p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
2081      test=save;
2082    }
2083  }
2084  /*- release temp data------------------------------- -*/
2085  omfree(strat->sevS);
2086  omfree(strat->ecartS);
2087  omfree(strat->T);
2088  omfree(strat->sevT);
2089  omfree(strat->R);
2090  omfree(strat->S_2_R);
2091  omfree(strat->L);
2092  omfree(strat->B);
2093  omfree(strat->fromQ);
2094  idDelete(&strat->Shdl);
2095  test=save_test;
2096  if (TEST_OPT_PROT) PrintLn();
2097  return p;
2098}
2099
2100ideal kNF2 (ideal F,ideal Q,ideal q,kStrategy strat, int lazyReduce)
2101{
2102  assume(!idIs0(q));
2103  assume(!(idIs0(F)&&(Q==NULL)));
2104// lazy_reduce flags: can be combined by |
2105//#define KSTD_NF_LAZY   1
2106  // do only a reduction of the leading term
2107//#define KSTD_NF_NONORM 4
2108  // only global: avoid normalization, return a multiply of NF
2109  poly   p;
2110  int   i;
2111  ideal res;
2112  int max_ind;
2113
2114  //if (idIs0(q))
2115  //  return idInit(IDELEMS(q),si_max(q->rank,F->rank));
2116  //if ((idIs0(F))&&(Q==NULL))
2117  //  return idCopy(q); /*F=0*/
2118  //strat->ak = idRankFreeModule(F);
2119  /*- creating temp data structures------------------- -*/
2120  BITSET save_test=test;
2121  test|=Sy_bit(OPT_REDTAIL);
2122  initBuchMoraCrit(strat);
2123  strat->initEcart = initEcartBBA;
2124  strat->enterS = enterSBba;
2125  /*- set S -*/
2126  strat->sl = -1;
2127#ifndef NO_BUCKETS
2128  strat->use_buckets = (!TEST_OPT_NOT_BUCKETS) && (!rIsPluralRing(currRing));
2129#endif
2130  /*- init local data struct.---------------------------------------- -*/
2131  /*Shdl=*/initS(F,Q,strat);
2132  /*- compute------------------------------------------------------- -*/
2133  res=idInit(IDELEMS(q),si_max(q->rank,F->rank));
2134  BITSET save=test;
2135  test &= ~Sy_bit(OPT_INTSTRATEGY);
2136  for (i=IDELEMS(q)-1; i>=0; i--)
2137  {
2138    if (q->m[i]!=NULL)
2139    {
2140      if (TEST_OPT_PROT) { PrintS("r");mflush(); }
2141      p = redNF(pCopy(q->m[i]),max_ind,lazyReduce & KSTD_NF_NONORM,strat);
2142      if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
2143      {
2144        if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
2145        #ifdef HAVE_RINGS
2146        if (rField_is_Ring(currRing))
2147        {
2148          p = redtailBba_Z(p,max_ind,strat);
2149        }
2150        else
2151        #endif
2152        {
2153          p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
2154        }
2155      }
2156      res->m[i]=p;
2157    }
2158    //else
2159    //  res->m[i]=NULL;
2160  }
2161  /*- release temp data------------------------------- -*/
2162  test=save;
2163  omfree(strat->sevS);
2164  omfree(strat->ecartS);
2165  omfree(strat->T);
2166  omfree(strat->sevT);
2167  omfree(strat->R);
2168  omfree(strat->S_2_R);
2169  omfree(strat->L);
2170  omfree(strat->B);
2171  omfree(strat->fromQ);
2172  idDelete(&strat->Shdl);
2173  test=save_test;
2174  if (TEST_OPT_PROT) PrintLn();
2175  return res;
2176}
2177
2178#if F5C
2179/*********************************************************************
2180* interrreduction step of the signature-based algorithm:
2181* 1. all strat->S are interpreted as new critical pairs
2182* 2. those pairs need to be completely reduced by the usual (non sig-
2183*    safe) reduction process (including tail reductions)
2184* 3. strat->S and strat->T are completely new computed in these steps
2185********************************************************************/
2186void f5c (kStrategy strat, int& olddeg, int& minimcnt, int& hilbeledeg, 
2187          int& hilbcount, int& srmax, int& lrmax, int& reduc, ideal Q,
2188          intvec *w,intvec *hilb )
2189{
2190  int Ll_old, red_result = 1;
2191  BOOLEAN withT = FALSE;
2192  int pos  = 0;
2193  hilbeledeg=1;
2194  hilbcount=0;
2195  minimcnt=0;
2196  srmax = 0; // strat->sl is 0 at this point
2197  reduc = olddeg = lrmax = 0;
2198  // we cannot use strat->T anymore
2199  //cleanT(strat);
2200  //strat->tl = -1;
2201  Ll_old    = strat->Ll;
2202  while (strat->tl >= 0)
2203  {
2204    if(!strat->T[strat->tl].is_redundant)
2205    {
2206      LObject h;
2207      h.p = strat->T[strat->tl].p;
2208      h.tailRing = strat->T[strat->tl].tailRing;
2209      h.t_p = strat->T[strat->tl].t_p;
2210      if (h.p!=NULL)
2211      {
2212        if (currRing->OrdSgn==-1)
2213        {
2214          cancelunit(&h); 
2215          deleteHC(&h, strat);
2216        }
2217        if (h.p!=NULL)
2218        {
2219          if (TEST_OPT_INTSTRATEGY)
2220          {
2221            //pContent(h.p);
2222            h.pCleardenom(); // also does a pContent
2223          }
2224          else
2225          {
2226            h.pNorm();
2227          }
2228          strat->initEcart(&h);
2229          pos = strat->Ll+1;
2230          h.sev = pGetShortExpVector(h.p);
2231          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
2232        }
2233      }
2234    }
2235    strat->tl--;
2236  }
2237  strat->sl = -1;
2238#if 0
2239//#ifdef HAVE_TAIL_RING
2240  if(!rField_is_Ring())  // create strong gcd poly computes with tailring and S[i] ->to be fixed
2241    kStratInitChangeTailRing(strat);
2242#endif
2243  //enterpairs(pOne(),0,0,-1,strat,strat->tl);
2244  //strat->sl = -1;
2245  /* picks the last element from the lazyset L */
2246  while (strat->Ll>Ll_old)
2247  {
2248    strat->P = strat->L[strat->Ll];
2249    strat->Ll--;
2250//#if 1
2251#ifdef DEBUGF5
2252    Print("NEXT PAIR TO HANDLE IN INTERRED ALGORITHM\n");
2253    Print("-------------------------------------------------\n");
2254    pWrite(pHead(strat->P.p));
2255    pWrite(pHead(strat->P.p1));
2256    pWrite(pHead(strat->P.p2));
2257    printf("%d\n",strat->tl);
2258    Print("-------------------------------------------------\n");
2259#endif
2260    if (pNext(strat->P.p) == strat->tail)
2261    {
2262      // deletes the short spoly
2263#ifdef HAVE_RINGS
2264      if (rField_is_Ring(currRing))
2265        pLmDelete(strat->P.p);
2266      else
2267#endif
2268        pLmFree(strat->P.p);
2269
2270      // TODO: needs some masking
2271      // TODO: masking needs to vanish once the signature
2272      //       sutff is completely implemented
2273      strat->P.p = NULL;
2274      poly m1 = NULL, m2 = NULL;
2275
2276      // check that spoly creation is ok
2277      while (strat->tailRing != currRing &&
2278          !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
2279      {
2280        assume(m1 == NULL && m2 == NULL);
2281        // if not, change to a ring where exponents are at least
2282        // large enough
2283        if (!kStratChangeTailRing(strat))
2284        {
2285          WerrorS("OVERFLOW...");
2286          break;
2287        }
2288      }
2289      // create the real one
2290      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
2291          strat->tailRing, m1, m2, strat->R);
2292    }
2293    else if (strat->P.p1 == NULL)
2294    {
2295      if (strat->minim > 0)
2296        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
2297      // for input polys, prepare reduction
2298      strat->P.PrepareRed(strat->use_buckets);
2299    }
2300
2301    if (strat->P.p == NULL && strat->P.t_p == NULL)
2302    {
2303      red_result = 0;
2304    }
2305    else
2306    {
2307      if (TEST_OPT_PROT)
2308        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
2309            &olddeg,&reduc,strat, red_result);
2310
2311#ifdef DEBUGF5
2312      Print("Poly before red: ");
2313      pWrite(strat->P.p);
2314#endif
2315      /* complete reduction of the element choosen from L */
2316      red_result = strat->red2(&strat->P,strat);
2317      if (errorreported)  break;
2318    }
2319
2320    if (strat->overflow)
2321    {
2322      if (!kStratChangeTailRing(strat)) { Werror("OVERFLOW.."); break;}
2323    }
2324
2325    // reduction to non-zero new poly
2326    if (red_result == 1)
2327    {
2328      // get the polynomial (canonicalize bucket, make sure P.p is set)
2329      strat->P.GetP(strat->lmBin);
2330      // in the homogeneous case FDeg >= pFDeg (sugar/honey)
2331      // but now, for entering S, T, we reset it
2332      // in the inhomogeneous case: FDeg == pFDeg
2333      if (strat->homog) strat->initEcart(&(strat->P));
2334
2335      /* statistic */
2336      if (TEST_OPT_PROT) PrintS("s");
2337
2338      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
2339
2340#ifdef KDEBUG
2341#if MYTEST
2342      PrintS("New S: "); pDebugPrint(strat->P.p); PrintLn();
2343#endif /* MYTEST */
2344#endif /* KDEBUG */
2345
2346      // reduce the tail and normalize poly
2347      // in the ring case we cannot expect LC(f) = 1,
2348      // therefore we call pContent instead of pNorm
2349#if F5CTAILRED
2350      if ((TEST_OPT_INTSTRATEGY) || (rField_is_Ring(currRing)))
2351      {
2352        strat->P.pCleardenom();
2353        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
2354        {
2355          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
2356          strat->P.pCleardenom();
2357        }
2358      }
2359      else
2360      {
2361        strat->P.pNorm();
2362        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
2363          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
2364      }
2365#endif
2366#ifdef KDEBUG
2367      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
2368#if MYTEST
2369//#if 1
2370      PrintS("New (reduced) S: "); pDebugPrint(strat->P.p); PrintLn();
2371#endif /* MYTEST */
2372#endif /* KDEBUG */
2373
2374      // min_std stuff
2375      if ((strat->P.p1==NULL) && (strat->minim>0))
2376      {
2377        if (strat->minim==1)
2378        {
2379          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
2380          p_Delete(&strat->P.p2, currRing, strat->tailRing);
2381        }
2382        else
2383        {
2384          strat->M->m[minimcnt]=strat->P.p2;
2385          strat->P.p2=NULL;
2386        }
2387        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
2388          pNext(strat->M->m[minimcnt])
2389            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
2390                strat->tailRing, currRing,
2391                currRing->PolyBin);
2392        minimcnt++;
2393      }
2394
2395      // enter into S, L, and T
2396      // here we need to recompute new signatures, but those are trivial ones
2397      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
2398      enterT(strat->P, strat);
2399      // posInS only depends on the leading term
2400      strat->enterS(strat->P, pos, strat, strat->tl);
2401//#if 1
2402#ifdef DEBUGF5
2403      Print("ELEMENT ADDED TO GCURR DURING INTERRED: ");
2404      pWrite(pHead(strat->S[strat->sl]));
2405      pWrite(strat->sig[strat->sl]);
2406#endif
2407      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
2408      //      Print("[%d]",hilbeledeg);
2409      if (strat->P.lcm!=NULL)
2410#ifdef HAVE_RINGS
2411        pLmDelete(strat->P.lcm);
2412#else
2413      pLmFree(strat->P.lcm);
2414#endif
2415      if (strat->sl>srmax) srmax = strat->sl;
2416    }
2417    else
2418    {
2419      // adds signature of the zero reduction to
2420      // strat->syz. This is the leading term of
2421      // syzygy and can be used in syzCriterion()
2422      // the signature is added if and only if the
2423      // pair was not detected by the rewritten criterion in strat->red = redSig
2424      if (strat->P.p1 == NULL && strat->minim > 0)
2425      {
2426        p_Delete(&strat->P.p2, currRing, strat->tailRing);
2427      }
2428    }
2429
2430#ifdef KDEBUG
2431    memset(&(strat->P), 0, sizeof(strat->P));
2432#endif /* KDEBUG */
2433  }
2434  int cc = 0;
2435  while (cc<strat->tl+1)
2436  {
2437    strat->T[cc].sig        = pOne();
2438    p_SetComp(strat->T[cc].sig,cc+1,currRing);
2439    strat->T[cc].sevSig     = pGetShortExpVector(strat->T[cc].sig);
2440    strat->sig[cc]          = strat->T[cc].sig;
2441    strat->sevSig[cc]       = strat->T[cc].sevSig;
2442    strat->T[cc].is_sigsafe = TRUE; 
2443    cc++;
2444  }
2445  strat->max_lower_index = strat->tl;
2446  // set current signature index of upcoming iteration step
2447  // NOTE:  this needs to be set here, as otherwise initSyzRules cannot compute
2448  //        the corresponding syzygy rules correctly
2449  strat->currIdx = cc+1;
2450  for (int cd=strat->Ll; cd>=0; cd--)
2451  {
2452    p_SetComp(strat->L[cd].sig,cc+1,currRing);
2453    cc++;
2454  }
2455//#if 1
2456#if DEBUGF5
2457  Print("------------------- STRAT S ---------------------\n");
2458  cc = 0;
2459  while (cc<strat->tl+1)
2460  {
2461    pWrite(pHead(strat->S[cc]));
2462    pWrite(strat->sig[cc]);
2463    printf("- - - - - -\n");
2464    cc++;
2465  }
2466  Print("-------------------------------------------------\n");
2467  Print("------------------- STRAT T ---------------------\n");
2468  cc = 0;
2469  while (cc<strat->tl+1)
2470  {
2471    pWrite(pHead(strat->T[cc].p));
2472    pWrite(strat->T[cc].sig);
2473    printf("- - - - - -\n");
2474    cc++;
2475  }
2476  Print("-------------------------------------------------\n");
2477  Print("------------------- STRAT L ---------------------\n");
2478  cc = 0;
2479  while (cc<strat->Ll+1)
2480  {
2481    pWrite(pHead(strat->L[cc].p));
2482    pWrite(pHead(strat->L[cc].p1));
2483    pWrite(pHead(strat->L[cc].p2));
2484    pWrite(strat->L[cc].sig);
2485    printf("- - - - - -\n");
2486    cc++;
2487  }
2488  Print("-------------------------------------------------\n");
2489  printf("F5C DONE\nSTRAT SL: %d -- %d\n",strat->sl, strat->currIdx);
2490#endif
2491
2492}
2493#endif
2494
2495/* shiftgb stuff */
2496#ifdef HAVE_SHIFTBBA
2497
2498
2499ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, int uptodeg, int lV)
2500{
2501#ifdef KDEBUG
2502  bba_count++;
2503  int loop_count = 0;
2504#endif
2505  om_Opts.MinTrack = 5;
2506  int   red_result = 1;
2507  int   olddeg,reduc;
2508  int hilbeledeg=1,hilbcount=0,minimcnt=0;
2509  BOOLEAN withT = TRUE; // very important for shifts
2510
2511  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit, NO CHANGES */
2512  initBuchMoraPos(strat); /*NO CHANGES YET: perhaps later*/
2513  initHilbCrit(F,Q,&hilb,strat); /*NO CHANGES*/
2514  initBbaShift(F,strat); /* DONE */
2515  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
2516  /*Shdl=*/initBuchMoraShift(F, Q,strat); /* updateS with no toT, i.e. no init for T */
2517  updateSShift(strat,uptodeg,lV); /* initializes T */
2518
2519  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
2520  reduc = olddeg = 0;
2521  strat->lV=lV;
2522
2523#ifndef NO_BUCKETS
2524  if (!TEST_OPT_NOT_BUCKETS)
2525    strat->use_buckets = 1;
2526#endif
2527
2528  // redtailBBa against T for inhomogenous input
2529  //  if (!TEST_OPT_OLDSTD)
2530  //    withT = ! strat->homog;
2531
2532  // strat->posInT = posInT_pLength;
2533  kTest_TS(strat);
2534
2535#ifdef HAVE_TAIL_RING
2536  kStratInitChangeTailRing(strat);
2537#endif
2538
2539  /* compute------------------------------------------------------- */
2540  while (strat->Ll >= 0)
2541  {
2542#ifdef KDEBUG
2543    loop_count++;
2544    if (TEST_OPT_DEBUG) messageSets(strat);
2545#endif
2546    if (strat->Ll== 0) strat->interpt=TRUE;
2547    if (TEST_OPT_DEGBOUND
2548        && ((strat->honey && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
2549            || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
2550    {
2551      /*
2552       *stops computation if
2553       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
2554       *a predefined number Kstd1_deg
2555       */
2556      while ((strat->Ll >= 0)
2557        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
2558        && ((strat->honey && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
2559            || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
2560        )
2561        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
2562      if (strat->Ll<0) break;
2563      else strat->noClearS=TRUE;
2564    }
2565    /* picks the last element from the lazyset L */
2566    strat->P = strat->L[strat->Ll];
2567    strat->Ll--;
2568
2569    if (pNext(strat->P.p) == strat->tail)
2570    {
2571      // deletes the short spoly
2572      pLmFree(strat->P.p);
2573      strat->P.p = NULL;
2574      poly m1 = NULL, m2 = NULL;
2575
2576      // check that spoly creation is ok
2577      while (strat->tailRing != currRing &&
2578             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
2579      {
2580        assume(m1 == NULL && m2 == NULL);
2581        // if not, change to a ring where exponents are at least
2582        // large enough
2583        kStratChangeTailRing(strat);
2584      }
2585      // create the real one
2586      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
2587                    strat->tailRing, m1, m2, strat->R);
2588    }
2589    else if (strat->P.p1 == NULL)
2590    {
2591      if (strat->minim > 0)
2592        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
2593      // for input polys, prepare reduction
2594      strat->P.PrepareRed(strat->use_buckets);
2595    }
2596
2597    poly qq;
2598
2599    /* here in the nonhomog case we shrink the new spoly */
2600
2601    if ( ! strat->homog)
2602    {
2603      strat->P.GetP(strat->lmBin); // because shifts are counted with .p structure
2604      /* in the nonhomog case we have to shrink the polynomial */
2605      assume(strat->P.t_p!=NULL);
2606      qq = p_Shrink(strat->P.t_p, lV, strat->tailRing); // direct shrink
2607      if (qq != NULL)
2608      {
2609         /* we're here if Shrink is nonzero */
2610        //         strat->P.p =  NULL;
2611        //        strat->P.Delete(); /* deletes P.p and P.t_p */ //error
2612        strat->P.p   =  NULL; // is not set by Delete
2613        strat->P.t_p =  qq;
2614        strat->P.GetP(strat->lmBin);
2615        // update sev and length
2616        strat->initEcart(&(strat->P));
2617        strat->P.sev = pGetShortExpVector(strat->P.p);
2618//         strat->P.FDeg = strat->P.pFDeg();
2619//         strat->P.length = strat->P.pLDeg();
2620//         strat->P.pLength =strat->P.GetpLength(); //pLength(strat->P.p);
2621      }
2622      else
2623      {
2624         /* Shrink is zero, like y(1)*y(2) - y(1)*y(3)*/
2625#ifdef KDEBUG
2626         if (TEST_OPT_DEBUG){PrintS("nonzero s shrinks to 0");PrintLn();}
2627#endif
2628         //         strat->P.Delete();  // cause error
2629         strat->P.p = NULL;
2630         strat->P.t_p = NULL;
2631           //         strat->P.p = NULL; // or delete strat->P.p ?
2632       }
2633    }
2634      /* end shrinking poly in the nonhomog case */
2635
2636    if (strat->P.p == NULL && strat->P.t_p == NULL)
2637    {
2638      red_result = 0;
2639    }
2640    else
2641    {
2642      if (TEST_OPT_PROT)
2643        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
2644                &olddeg,&reduc,strat, red_result);
2645
2646      /* reduction of the element choosen from L */
2647      red_result = strat->red(&strat->P,strat);
2648    }
2649
2650    // reduction to non-zero new poly
2651    if (red_result == 1)
2652    {
2653      /* statistic */
2654      if (TEST_OPT_PROT) PrintS("s");
2655
2656      // get the polynomial (canonicalize bucket, make sure P.p is set)
2657      strat->P.GetP(strat->lmBin);
2658
2659      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
2660
2661      // reduce the tail and normalize poly
2662      if (TEST_OPT_INTSTRATEGY)
2663      {
2664        strat->P.pCleardenom();
2665        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
2666        {
2667          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
2668          strat->P.pCleardenom();
2669        }
2670      }
2671      else
2672      {
2673        strat->P.pNorm();
2674        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
2675          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
2676      }
2677
2678      // here we must shrink again! and optionally reduce again
2679      // or build shrink into redtailBba!
2680
2681#ifdef KDEBUG
2682      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
2683#endif
2684
2685      // min_std stuff
2686      if ((strat->P.p1==NULL) && (strat->minim>0))
2687      {
2688        if (strat->minim==1)
2689        {
2690          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
2691          p_Delete(&strat->P.p2, currRing, strat->tailRing);
2692        }
2693        else
2694        {
2695          strat->M->m[minimcnt]=strat->P.p2;
2696          strat->P.p2=NULL;
2697        }
2698        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
2699          pNext(strat->M->m[minimcnt])
2700            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
2701                                           strat->tailRing, currRing,
2702                                           currRing->PolyBin);
2703        minimcnt++;
2704      }
2705
2706    /* here in the nonhomog case we shrink the reduced poly AGAIN */
2707
2708    if ( ! strat->homog)
2709    {
2710      strat->P.GetP(strat->lmBin); // because shifts are counted with .p structure
2711      /* assume strat->P.t_p != NULL */
2712      /* in the nonhomog case we have to shrink the polynomial */
2713      assume(strat->P.t_p!=NULL); // poly qq defined above
2714      qq = p_Shrink(strat->P.t_p, lV, strat->tailRing); // direct shrink
2715      if (qq != NULL)
2716      {
2717         /* we're here if Shrink is nonzero */
2718        //         strat->P.p =  NULL;
2719        //        strat->P.Delete(); /* deletes P.p and P.t_p */ //error
2720        strat->P.p   =  NULL; // is not set by Delete
2721        strat->P.t_p =  qq;
2722        strat->P.GetP(strat->lmBin);
2723        // update sev and length
2724        strat->initEcart(&(strat->P));
2725        strat->P.sev = pGetShortExpVector(strat->P.p);
2726      }
2727      else
2728      {
2729         /* Shrink is zero, like y(1)*y(2) - y(1)*y(3)*/
2730#ifdef PDEBUG
2731         if (TEST_OPT_DEBUG){PrintS("nonzero s shrinks to 0");PrintLn();}
2732#endif
2733         //         strat->P.Delete();  // cause error
2734         strat->P.p = NULL;
2735         strat->P.t_p = NULL;
2736           //         strat->P.p = NULL; // or delete strat->P.p ?
2737         goto     red_shrink2zero;
2738       }
2739    }
2740      /* end shrinking poly AGAIN in the nonhomog case */
2741
2742
2743      // enter into S, L, and T
2744      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
2745      //        enterT(strat->P, strat); // this was here before Shift stuff
2746      //enterTShift(LObject p, kStrategy strat, int atT, int uptodeg, int lV); // syntax
2747      // the default value for atT = -1 as in bba
2748      /*   strat->P.GetP(); */
2749      // because shifts are counted with .p structure // done before, but ?
2750      enterTShift(strat->P,strat,-1,uptodeg, lV);
2751      enterpairsShift(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl,uptodeg,lV);
2752      //      enterpairsShift(vw,strat->sl,strat->P.ecart,pos,strat, strat->tl,uptodeg,lV);
2753      // posInS only depends on the leading term
2754      strat->enterS(strat->P, pos, strat, strat->tl);
2755
2756      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
2757//      Print("[%d]",hilbeledeg);
2758      if (strat->P.lcm!=NULL) pLmFree(strat->P.lcm);
2759    }
2760    else
2761    {
2762    red_shrink2zero:
2763      if (strat->P.p1 == NULL && strat->minim > 0)
2764      {
2765        p_Delete(&strat->P.p2, currRing, strat->tailRing);
2766      }
2767    }
2768#ifdef KDEBUG
2769    memset(&(strat->P), 0, sizeof(strat->P));
2770#endif
2771    kTest_TS(strat);
2772  }
2773#ifdef KDEBUG
2774  if (TEST_OPT_DEBUG) messageSets(strat);
2775#endif
2776  /* complete reduction of the standard basis--------- */
2777  /*  shift case: look for elt's in S such that they are divisible by elt in T */
2778  //  if (TEST_OPT_SB_1)
2779  if (TEST_OPT_REDSB)
2780  {
2781    int k=0;
2782    int j=-1;
2783    while(k<=strat->sl)
2784    {
2785//       loop
2786//       {
2787//         if (j>=k) break;
2788//         clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
2789//         j++;
2790//       }
2791      LObject Ln (strat->S[k],currRing, strat->tailRing);
2792      Ln.SetShortExpVector();
2793      j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln, j+1);
2794      if (j<0) {  k++; j=-1;}
2795      else
2796      {
2797        if ( pLmCmp(strat->S[k],strat->T[j].p) == 0)
2798        {
2799          j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln, j+1);
2800          if (j<0) {  k++; j=-1;}
2801          else
2802          {
2803            deleteInS(k,strat);
2804          }
2805        }
2806        else
2807        {
2808          deleteInS(k,strat);
2809        }
2810      }
2811    }
2812  }
2813
2814  if (TEST_OPT_REDSB)
2815  {    completeReduce(strat, TRUE); //shift: withT = TRUE
2816    if (strat->completeReduce_retry)
2817    {
2818      // completeReduce needed larger exponents, retry
2819      // to reduce with S (instead of T)
2820      // and in currRing (instead of strat->tailRing)
2821      cleanT(strat);strat->tailRing=currRing;
2822      int i;
2823      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
2824      completeReduce(strat, TRUE);
2825    }
2826  }
2827  else if (TEST_OPT_PROT) PrintLn();
2828
2829  /* release temp data-------------------------------- */
2830  exitBuchMora(strat);
2831//  if (TEST_OPT_WEIGHTM)
2832//  {
2833//    pRestoreDegProcs(currRing,pFDegOld, pLDegOld);
2834//    if (ecartWeights)
2835//    {
2836//      omFreeSize((ADDRESS)ecartWeights,((currRing->N)+1)*sizeof(short));
2837//      ecartWeights=NULL;
2838//    }
2839//  }
2840  if (TEST_OPT_PROT) messageStat(hilbcount,strat);
2841  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
2842  return (strat->Shdl);
2843}
2844
2845
2846ideal freegb(ideal I, int uptodeg, int lVblock)
2847{
2848  /* todo main call */
2849
2850  /* assume: ring is prepared, ideal is copied into shifted ring */
2851  /* uptodeg and lVblock are correct - test them! */
2852
2853  /* check whether the ideal is in V */
2854
2855//  if (0)
2856  if (! ideal_isInV(I,lVblock) )
2857  {
2858    WerrorS("The input ideal contains incorrectly encoded elements! ");
2859    return(NULL);
2860  }
2861
2862  //  kStrategy strat = new skStrategy;
2863  /* ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, int uptodeg, int lV) */
2864  /* at the moment:
2865- no quotient (check)
2866- no *w, no *hilb
2867  */
2868  /* ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
2869     int newIdeal, intvec *vw) */
2870  ideal RS = kStdShift(I,NULL, testHomog, NULL,NULL,0,0,NULL, uptodeg, lVblock);
2871    //bbaShift(I,NULL, NULL, NULL, strat, uptodeg, lVblock);
2872  idSkipZeroes(RS);
2873  return(RS);
2874}
2875
2876/*2
2877*reduces h with elements from T choosing  the first possible
2878* element in t with respect to the given pDivisibleBy
2879*/
2880int redFirstShift (LObject* h,kStrategy strat)
2881{
2882  if (h->IsNull()) return 0;
2883
2884  int at, reddeg,d;
2885  int pass = 0;
2886  int j = 0;
2887
2888  if (! strat->homog)
2889  {
2890    d = h->GetpFDeg() + h->ecart;
2891    reddeg = strat->LazyDegree+d;
2892  }
2893  h->SetShortExpVector();
2894  loop
2895  {
2896    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
2897    if (j < 0)
2898    {
2899      h->SetDegStuffReturnLDeg(strat->LDegLast);
2900      return 1;
2901    }
2902
2903    if (!TEST_OPT_INTSTRATEGY)
2904      strat->T[j].pNorm();
2905#ifdef KDEBUG
2906    if (TEST_OPT_DEBUG)
2907    {
2908      PrintS("reduce ");
2909      h->wrp();
2910      PrintS(" with ");
2911      strat->T[j].wrp();
2912    }
2913#endif
2914    ksReducePoly(h, &(strat->T[j]), strat->kNoetherTail(), NULL, strat);
2915    if (!h->IsNull())
2916    {
2917      poly qq=p_Shrink(h->GetTP(),strat->lV,strat->tailRing);
2918      h->p=NULL;
2919      h->t_p=qq;
2920      if (qq!=NULL) h->GetP(strat->lmBin);
2921    }
2922
2923#ifdef KDEBUG
2924    if (TEST_OPT_DEBUG)
2925    {
2926      PrintS(" to ");
2927      wrp(h->p);
2928      PrintLn();
2929    }
2930#endif
2931    if (h->IsNull())
2932    {
2933      if (h->lcm!=NULL) pLmFree(h->lcm);
2934      h->Clear();
2935      return 0;
2936    }
2937    h->SetShortExpVector();
2938
2939#if 0
2940    if ((strat->syzComp!=0) && !strat->honey)
2941    {
2942      if ((strat->syzComp>0) &&
2943          (h->Comp() > strat->syzComp))
2944      {
2945        assume(h->MinComp() > strat->syzComp);
2946#ifdef KDEBUG
2947        if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
2948#endif
2949        if (strat->homog)
2950          h->SetDegStuffReturnLDeg(strat->LDegLast);
2951        return -2;
2952      }
2953    }
2954#endif
2955    if (!strat->homog)
2956    {
2957      if (!TEST_OPT_OLDSTD && strat->honey)
2958      {
2959        h->SetpFDeg();
2960        if (strat->T[j].ecart <= h->ecart)
2961          h->ecart = d - h->GetpFDeg();
2962        else
2963          h->ecart = d - h->GetpFDeg() + strat->T[j].ecart - h->ecart;
2964
2965        d = h->GetpFDeg() + h->ecart;
2966      }
2967      else
2968        d = h->SetDegStuffReturnLDeg(strat->LDegLast);
2969      /*- try to reduce the s-polynomial -*/
2970      pass++;
2971      /*
2972       *test whether the polynomial should go to the lazyset L
2973       *-if the degree jumps
2974       *-if the number of pre-defined reductions jumps
2975       */
2976      if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
2977          && ((d >= reddeg) || (pass > strat->LazyPass)))
2978      {
2979        h->SetLmCurrRing();
2980        if (strat->posInLDependsOnLength)
2981          h->SetLength(strat->length_pLength);
2982        at = strat->posInL(strat->L,strat->Ll,h,strat);
2983        if (at <= strat->Ll)
2984        {
2985          int dummy=strat->sl;
2986          /*          if (kFindDivisibleByInS(strat,&dummy, h) < 0) */
2987          if (kFindDivisibleByInT(strat->T,strat->sevT, dummy, h) < 0)
2988            return 1;
2989          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
2990#ifdef KDEBUG
2991          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
2992#endif
2993          h->Clear();
2994          return -1;
2995        }
2996      }
2997      if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
2998      {
2999        reddeg = d+1;
3000        Print(".%d",d);mflush();
3001      }
3002    }
3003  }
3004}
3005
3006void initBbaShift(ideal F,kStrategy strat)
3007{
3008  int i;
3009//  idhdl h;
3010 /* setting global variables ------------------- */
3011  strat->enterS = enterSBba; /* remains as is, we change enterT! */
3012
3013  strat->red = redFirstShift; /* no redHomog ! */
3014
3015  if (currRing->pLexOrder && strat->honey)
3016    strat->initEcart = initEcartNormal;
3017  else
3018    strat->initEcart = initEcartBBA;
3019  if (strat->honey)
3020    strat->initEcartPair = initEcartPairMora;
3021  else
3022    strat->initEcartPair = initEcartPairBba;
3023//  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
3024//  {
3025//    //interred  machen   Aenderung
3026//    pFDegOld=currRing->pFDeg;
3027//    pLDegOld=pLDeg;
3028//    //h=ggetid("ecart");
3029//    //if ((h!=NULL) /*&& (IDTYP(h)==INTVEC_CMD)*/)
3030//    //{
3031//    //  ecartWeights=iv2array(IDINTVEC(h));
3032//    //}
3033//    //else
3034//    {
3035//      ecartWeights=(short *)omAlloc(((currRing->N)+1)*sizeof(short));
3036//      /*uses automatic computation of the ecartWeights to set them*/
3037//      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights,currRing);
3038//    }
3039//    pRestoreDegProcs(currRing,totaldegreeWecart, maxdegreeWecart);
3040//    if (TEST_OPT_PROT)
3041//    {
3042//      for(i=1; i<=(currRing->N); i++)
3043//        Print(" %d",ecartWeights[i]);
3044//      PrintLn();
3045//      mflush();
3046//    }
3047//  }
3048}
3049#endif
Note: See TracBrowser for help on using the repository browser.