source: git/kernel/kstd2.cc @ ba5e9e

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