source: git/kernel/kstd2.cc @ cbc616

spielwiese
Last change on this file since cbc616 was cbc616, checked in by Hans Schönemann <hannes@…>, 16 years ago
*hannes:bbaPart git-svn-id: file:///usr/local/Singular/svn/trunk@10906 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 56.8 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kstd2.cc,v 1.72 2008-07-25 10:23:09 Singular Exp $ */
5/*
6*  ABSTRACT -  Kernel: alg. of Buchberger
7*/
8
9// #define PDEBUG 2
10// define to enable tailRings
11#define HAVE_TAIL_RING
12// define if no buckets should be used
13// #define NO_BUCKETS
14
15#include "mod2.h"
16#ifdef HAVE_PLURAL
17#define PLURAL_INTERNAL_DECLARATIONS 1
18#endif
19#include "kutil.h"
20#include "structs.h"
21#include "omalloc.h"
22#include "polys.h"
23#include "ideals.h"
24#include "febase.h"
25#include "kstd1.h"
26#include "khstd.h"
27#include "kbuckets.h"
28//#include "cntrlc.h"
29#include "weight.h"
30#include "intvec.h"
31#ifdef HAVE_PLURAL
32#include "gring.h"
33#endif
34// #include "timer.h"
35
36/* shiftgb stuff */
37#include "shiftgb.h"
38
39// return -1 if no divisor is found
40//        number of first divisor, otherwise
41int kFindDivisibleByInT(const TSet &T, const unsigned long* sevT,
42                        const int tl, const LObject* L, const int start)
43{
44  unsigned long not_sev = ~L->sev;
45  int j = start;
46  poly p=L->p;
47  ring r=currRing;
48  if (p==NULL)  { r=L->tailRing; p=L->t_p; }
49  L->GetLm(p, r);
50
51  pAssume(~not_sev == p_GetShortExpVector(p, r));
52
53  if (r == currRing)
54  {
55    loop
56    {
57      if (j > tl) return -1;
58#if defined(PDEBUG) || defined(PDIV_DEBUG)
59      if (p_LmShortDivisibleBy(T[j].p, sevT[j],
60                               p, not_sev, r))
61        return j;
62#else
63      if (!(sevT[j] & not_sev) &&
64          p_LmDivisibleBy(T[j].p, p, r))
65        return j;
66#endif
67      j++;
68    }
69  }
70  else
71  {
72    loop
73    {
74      if (j > tl) return -1;
75#if defined(PDEBUG) || defined(PDIV_DEBUG)
76      if (p_LmShortDivisibleBy(T[j].t_p, sevT[j],
77                               p, not_sev, r))
78        return j;
79#else
80      if (!(sevT[j] & not_sev) &&
81          p_LmDivisibleBy(T[j].t_p, p, r))
82        return j;
83#endif
84      j++;
85    }
86  }
87}
88
89// same as above, only with set S
90int kFindDivisibleByInS(const kStrategy strat, int* max_ind, LObject* L)
91{
92  unsigned long not_sev = ~L->sev;
93  poly p = L->GetLmCurrRing();
94  int j = 0;
95
96  pAssume(~not_sev == p_GetShortExpVector(p, currRing));
97#if 1
98  int ende;
99  if (strat->ak>0) ende=strat->sl;
100  else ende=posInS(strat,*max_ind,p,0)+1;
101  if (ende>(*max_ind)) ende=(*max_ind);
102#else
103  int ende=strat->sl;
104#endif
105  (*max_ind)=ende;
106  loop
107  {
108    if (j > ende) return -1;
109#if defined(PDEBUG) || defined(PDIV_DEBUG)
110    if (p_LmShortDivisibleBy(strat->S[j], strat->sevS[j],
111                             p, not_sev, currRing))
112        return j;
113#else
114    if ( !(strat->sevS[j] & not_sev) &&
115         p_LmDivisibleBy(strat->S[j], p, currRing))
116      return j;
117#endif
118    j++;
119  }
120}
121
122int kFindNextDivisibleByInS(const kStrategy strat, int start,int max_ind, LObject* L)
123{
124  unsigned long not_sev = ~L->sev;
125  poly p = L->GetLmCurrRing();
126  int j = start;
127
128  pAssume(~not_sev == p_GetShortExpVector(p, currRing));
129#if 1
130  int ende=max_ind;
131#else
132  int ende=strat->sl;
133#endif
134  loop
135  {
136    if (j > ende) return -1;
137#if defined(PDEBUG) || defined(PDIV_DEBUG)
138    if (p_LmShortDivisibleBy(strat->S[j], strat->sevS[j],
139                             p, not_sev, currRing))
140        return j;
141#else
142    if ( !(strat->sevS[j] & not_sev) &&
143         p_LmDivisibleBy(strat->S[j], p, currRing))
144      return j;
145#endif
146    j++;
147  }
148}
149
150#ifdef HAVE_RING2TOM
151NATNUMBER factorial(NATNUMBER arg)
152{
153   NATNUMBER tmp = 1; arg++;
154   for (int i = 2; i < arg; i++)
155   {
156     tmp *= i;
157   }
158   return tmp;
159}
160
161poly kFindZeroPoly(poly input_p, ring leadRing, ring tailRing)
162{
163  // m = currRing->ch
164
165  if (input_p == NULL) return NULL;
166
167  poly p = input_p;
168  poly zeroPoly = NULL;
169  NATNUMBER a = (NATNUMBER) pGetCoeff(p);
170
171  int k_ind2 = 0;
172  int a_ind2 = ind2(a);
173
174  NATNUMBER k = 1;
175  // of interest is only k_ind2, special routine for improvement ... TODO OLIVER
176  for (int i = 1; i <= leadRing->N; i++)
177  {
178    k_ind2 = k_ind2 + ind_fact_2(p_GetExp(p, i, leadRing));
179  }
180
181  a = (NATNUMBER) pGetCoeff(p);
182
183  number tmp1;
184  poly tmp2, tmp3;
185  poly lead_mult = p_ISet(1, tailRing);
186  if (leadRing->ch <= k_ind2 + a_ind2)
187  {
188    int too_much = k_ind2 + a_ind2 - leadRing->ch;
189    int s_exp;
190    zeroPoly = p_ISet(a, tailRing);
191    for (int i = 1; i <= leadRing->N; i++)
192    {
193      s_exp = p_GetExp(p, i,leadRing);
194      if (s_exp % 2 != 0)
195      {
196        s_exp = s_exp - 1;
197      }
198      while ( (0 < ind2(s_exp)) && (ind2(s_exp) <= too_much) )
199      {
200        too_much = too_much - ind2(s_exp);
201        s_exp = s_exp - 2;
202      }
203      p_SetExp(lead_mult, i, p_GetExp(p, i,leadRing) - s_exp, tailRing);
204      for (NATNUMBER j = 1; j <= s_exp; j++)
205      {
206        tmp1 = nInit(j);
207        tmp2 = p_ISet(1, tailRing);
208        p_SetExp(tmp2, i, 1, tailRing);
209        p_Setm(tmp2, tailRing);
210        if (nIsZero(tmp1))
211        { // should nowbe obsolet, test ! TODO OLIVER
212          zeroPoly = p_Mult_q(zeroPoly, tmp2, tailRing);
213        }
214        else
215        {
216          tmp3 = p_NSet(nCopy(tmp1), tailRing);
217          zeroPoly = p_Mult_q(zeroPoly, p_Add_q(tmp3, tmp2, tailRing), tailRing);
218        }
219      }
220    }
221    p_Setm(lead_mult, tailRing);
222    zeroPoly = p_Mult_mm(zeroPoly, lead_mult, tailRing);
223    tmp2 = p_NSet(nCopy(pGetCoeff(zeroPoly)), leadRing);
224    for (int i = 1; i <= leadRing->N; i++)
225    {
226      pSetExp(tmp2, i, p_GetExp(zeroPoly, i, tailRing));
227    }
228    p_Setm(tmp2, leadRing);
229    zeroPoly = p_LmDeleteAndNext(zeroPoly, tailRing);
230    pNext(tmp2) = zeroPoly;
231    return tmp2;
232  }
233/*  NATNUMBER alpha_k = twoPow(leadRing->ch - k_ind2);
234  if (1 == 0 && alpha_k <= a)
235  {  // Temporarly disabled, reducing coefficients not compatible with std TODO Oliver
236    zeroPoly = p_ISet((a / alpha_k)*alpha_k, tailRing);
237    for (int i = 1; i <= leadRing->N; i++)
238    {
239      for (NATNUMBER j = 1; j <= p_GetExp(p, i, leadRing); j++)
240      {
241        tmp1 = nInit(j);
242        tmp2 = p_ISet(1, tailRing);
243        p_SetExp(tmp2, i, 1, tailRing);
244        p_Setm(tmp2, tailRing);
245        if (nIsZero(tmp1))
246        {
247          zeroPoly = p_Mult_q(zeroPoly, tmp2, tailRing);
248        }
249        else
250        {
251          tmp3 = p_ISet((NATNUMBER) tmp1, tailRing);
252          zeroPoly = p_Mult_q(zeroPoly, p_Add_q(tmp2, tmp3, tailRing), tailRing);
253        }
254      }
255    }
256    tmp2 = p_ISet((NATNUMBER) pGetCoeff(zeroPoly), leadRing);
257    for (int i = 1; i <= leadRing->N; i++)
258    {
259      pSetExp(tmp2, i, p_GetExp(zeroPoly, i, tailRing));
260    }
261    p_Setm(tmp2, leadRing);
262    zeroPoly = p_LmDeleteAndNext(zeroPoly, tailRing);
263    pNext(tmp2) = zeroPoly;
264    return tmp2;
265  } */
266  return NULL;
267}
268
269poly kFindDivisibleByZeroPoly(LObject* h)
270{
271  return kFindZeroPoly(h->GetLmCurrRing(), currRing, h->tailRing);
272}
273#endif
274
275
276#ifdef HAVE_RINGS
277/*2
278*  reduction procedure for the ring Z/2^m
279*/
280int redRing (LObject* h,kStrategy strat)
281{
282  if (h->p == NULL && h->t_p == NULL) return 0; // spoly is zero (can only occure with zero divisors)
283
284//  if (strat->tl<0) return 1;
285  int at,d,i;
286  int j = 0;
287  int pass = 0;
288  poly zeroPoly = NULL;
289
290// TODO warum SetpFDeg notwendig?
291  h->SetpFDeg();
292  assume(h->pFDeg() == h->FDeg);
293//  if (h->pFDeg() != h->FDeg)
294//  {
295//    Print("h->pFDeg()=%d =!= h->FDeg=%d\n", h->pFDeg(), h->FDeg);
296//  }
297  long reddeg = h->GetpFDeg();
298
299  h->SetShortExpVector();
300  loop
301  {
302      j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
303      if (j < 0) return 1;
304#ifdef KDEBUG
305      if (TEST_OPT_DEBUG)
306      {
307        PrintS("T red:");
308      }
309#endif
310#ifdef KDEBUG
311    if (TEST_OPT_DEBUG)
312    {
313      h->wrp();
314      PrintS(" with ");
315      strat->T[j].wrp();
316    }
317#endif
318
319    ksReducePoly(h, &(strat->T[j]), NULL, NULL, strat);
320
321#ifdef KDEBUG
322    if (TEST_OPT_DEBUG)
323    {
324      PrintS("\nto ");
325      h->wrp();
326      PrintLn();
327    }
328#endif
329
330    if (h->GetLmTailRing() == NULL)
331    {
332      if (h->lcm!=NULL) pLmDelete(h->lcm);
333#ifdef KDEBUG
334      h->lcm=NULL;
335#endif
336      return 0;
337    }
338    h->SetShortExpVector();
339    d = h->SetpFDeg();
340    /*- try to reduce the s-polynomial -*/
341    pass++;
342    if (!K_TEST_OPT_REDTHROUGH &&
343        (strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
344    {
345      h->SetLmCurrRing();
346      at = strat->posInL(strat->L,strat->Ll,h,strat);
347      if (at <= strat->Ll)
348      {
349#ifdef KDEBUG
350        if (TEST_OPT_DEBUG) Print(" ->L[%d]\n",at);
351#endif
352        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);     // NOT RING CHECKED OLIVER
353        h->Clear();
354        return -1;
355      }
356    }
357    else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d != reddeg))
358    {
359      Print(".%d",d);mflush();
360      reddeg = d;
361    }
362  }
363}
364#endif
365
366/*2
367*  reduction procedure for the homogeneous case
368*  and the case of a degree-ordering
369*/
370int redHomog (LObject* h,kStrategy strat)
371{
372  if (strat->tl<0) return 1;
373  //if (h->GetLmTailRing()==NULL) return 0; // HS: SHOULD NOT BE NEEDED!
374  assume(h->FDeg == h->pFDeg());
375
376  poly h_p;
377  int i,j,at,pass, ii;
378  unsigned long not_sev;
379  long reddeg,d;
380
381  pass = j = 0;
382  d = reddeg = h->GetpFDeg();
383  h->SetShortExpVector();
384  int li;
385  h_p = h->GetLmTailRing();
386  not_sev = ~ h->sev;
387  loop
388  {
389    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
390    if (j < 0) return 1;
391
392    li = strat->T[j].pLength;
393    ii = j;
394    /*
395     * the polynomial to reduce with (up to the moment) is;
396     * pi with length li
397     */
398    i = j;
399#if 1
400    if (TEST_OPT_LENGTH)
401    loop
402    {
403      /*- search the shortest possible with respect to length -*/
404      i++;
405      if (i > strat->tl)
406        break;
407      if (li<=1)
408        break;
409      if ((strat->T[i].pLength < li)
410         &&
411          p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i],
412                               h_p, not_sev, strat->tailRing))
413      {
414        /*
415         * the polynomial to reduce with is now;
416         */
417        li = strat->T[i].pLength;
418        ii = i;
419      }
420    }
421#endif
422
423    /*
424     * end of search: have to reduce with pi
425     */
426#ifdef KDEBUG
427    if (TEST_OPT_DEBUG)
428    {
429      PrintS("red:");
430      h->wrp();
431      PrintS(" with ");
432      strat->T[ii].wrp();
433    }
434#endif
435    assume(strat->fromT == FALSE);
436
437    ksReducePoly(h, &(strat->T[ii]), NULL, NULL, strat);
438
439#ifdef KDEBUG
440    if (TEST_OPT_DEBUG)
441    {
442      PrintS("\nto ");
443      h->wrp();
444      PrintLn();
445    }
446#endif
447
448    h_p = h->GetLmTailRing();
449    if (h_p == NULL)
450    {
451      if (h->lcm!=NULL) pLmFree(h->lcm);
452#ifdef KDEBUG
453      h->lcm=NULL;
454#endif
455      return 0;
456    }
457    h->SetShortExpVector();
458    not_sev = ~ h->sev;
459    /*
460     * try to reduce the s-polynomial h
461     *test first whether h should go to the lazyset L
462     *-if the degree jumps
463     *-if the number of pre-defined reductions jumps
464     */
465    pass++;
466    if (!K_TEST_OPT_REDTHROUGH && (strat->Ll >= 0) && (pass > strat->LazyPass))
467    {
468      h->SetLmCurrRing();
469      at = strat->posInL(strat->L,strat->Ll,h,strat);
470      if (at <= strat->Ll)
471      {
472        int dummy=strat->sl;
473        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
474          return 1;
475        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
476#ifdef KDEBUG
477        if (TEST_OPT_DEBUG)
478          Print(" lazy: -> L%d\n",at);
479#endif
480        h->Clear();
481        return -1;
482      }
483    }
484  }
485}
486
487/*2
488*  reduction procedure for the inhomogeneous case
489*  and not a degree-ordering
490*/
491int redLazy (LObject* h,kStrategy strat)
492{
493  if (strat->tl<0) return 1;
494  int at,d,i,ii,li;
495  int j = 0;
496  int pass = 0;
497  assume(h->pFDeg() == h->FDeg);
498  long reddeg = h->GetpFDeg();
499  unsigned long not_sev;
500
501  h->SetShortExpVector();
502  poly h_p = h->GetLmTailRing();
503  not_sev = ~ h->sev;
504  loop
505  {
506    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
507    if (j < 0) return 1;
508
509    li = strat->T[j].pLength;
510    #if 0
511    if (li==0)
512    {
513      li=strat->T[j].pLength=pLength(strat->T[j].p);
514    }
515    #endif
516    ii = j;
517    /*
518     * the polynomial to reduce with (up to the moment) is;
519     * pi with length li
520     */
521
522    i = j;
523#if 1
524    if (TEST_OPT_LENGTH)
525    loop
526    {
527      /*- search the shortest possible with respect to length -*/
528      i++;
529      if (i > strat->tl)
530        break;
531      if (li<=1)
532        break;
533    #if 0
534      if (strat->T[i].pLength==0)
535      {
536        PrintS("!");
537        strat->T[i].pLength=pLength(strat->T[i].p);
538      }
539   #endif
540      if ((strat->T[i].pLength < li)
541         &&
542          p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i],
543                               h_p, not_sev, strat->tailRing))
544      {
545        /*
546         * the polynomial to reduce with is now;
547         */
548        PrintS("+");
549        li = strat->T[i].pLength;
550        ii = i;
551      }
552    }
553#endif
554
555    /*
556     * end of search: have to reduce with pi
557     */
558
559
560#ifdef KDEBUG
561    if (TEST_OPT_DEBUG)
562    {
563      PrintS("red:");
564      h->wrp();
565      PrintS(" with ");
566      strat->T[ii].wrp();
567    }
568#endif
569
570    ksReducePoly(h, &(strat->T[ii]), NULL, NULL, strat);
571
572#ifdef KDEBUG
573    if (TEST_OPT_DEBUG)
574    {
575      PrintS("\nto ");
576      h->wrp();
577      PrintLn();
578    }
579#endif
580
581    h_p=h->GetLmTailRing();
582
583    if (h_p == NULL)
584    {
585      if (h->lcm!=NULL) pLmFree(h->lcm);
586#ifdef KDEBUG
587      h->lcm=NULL;
588#endif
589      return 0;
590    }
591    h->SetShortExpVector();
592    not_sev = ~ h->sev;
593    d = h->SetpFDeg();
594    /*- try to reduce the s-polynomial -*/
595    pass++;
596    if (//!K_TEST_OPT_REDTHROUGH &&
597        (strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
598    {
599      h->SetLmCurrRing();
600      at = strat->posInL(strat->L,strat->Ll,h,strat);
601      if (at <= strat->Ll)
602      {
603#if 1
604        int dummy=strat->sl;
605        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
606          return 1;
607#endif
608#ifdef KDEBUG
609        if (TEST_OPT_DEBUG) Print(" ->L[%d]\n",at);
610#endif
611        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
612        h->Clear();
613        return -1;
614      }
615    }
616    else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d != reddeg))
617    {
618      Print(".%d",d);mflush();
619      reddeg = d;
620    }
621  }
622}
623/*2
624*  reduction procedure for the sugar-strategy (honey)
625* reduces h with elements from T choosing first possible
626* element in T with respect to the given ecart
627*/
628int redHoney (LObject* h, kStrategy strat)
629{
630  if (strat->tl<0) return 1;
631  //if (h->GetLmTailRing()==NULL) return 0; // HS: SHOULD NOT BE NEEDED!
632  assume(h->FDeg == h->pFDeg());
633
634  poly h_p;
635  int i,j,at,pass,ei, ii, h_d;
636  unsigned long not_sev;
637  long reddeg,d;
638
639  pass = j = 0;
640  d = reddeg = h->GetpFDeg() + h->ecart;
641  h->SetShortExpVector();
642  int li;
643  h_p = h->GetLmTailRing();
644  not_sev = ~ h->sev;
645  loop
646  {
647    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
648    if (j < 0) return 1;
649
650    ei = strat->T[j].ecart;
651    li = strat->T[j].pLength;
652    #if 0
653    if (li==0)
654    {
655       //PrintS("!");
656       li=strat->T[j].pLength=pLength(strat->T[j].p);
657    }
658    #endif
659    ii = j;
660    /*
661     * the polynomial to reduce with (up to the moment) is;
662     * pi with ecart ei
663     */
664    i = j;
665    if (TEST_OPT_LENGTH)
666    loop
667    {
668      /*- takes the first possible with respect to ecart -*/
669      i++;
670      if (i > strat->tl)
671        break;
672      //if (ei < h->ecart)
673      //  break;
674      if (li<=1)
675        break;
676      if ((((strat->T[i].ecart < ei) && (ei> h->ecart))
677         || ((strat->T[i].ecart <= h->ecart) && (strat->T[i].pLength < li)))
678         &&
679          p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i],
680                               h_p, not_sev, strat->tailRing))
681      {
682        /*
683         * the polynomial to reduce with is now;
684         */
685        ei = strat->T[i].ecart;
686        li = strat->T[i].pLength;
687        ii = i;
688      }
689    }
690
691    /*
692     * end of search: have to reduce with pi
693     */
694    if (!K_TEST_OPT_REDTHROUGH && (pass!=0) && (ei > h->ecart))
695    {
696      h->SetLmCurrRing();
697      /*
698       * It is not possible to reduce h with smaller ecart;
699       * if possible h goes to the lazy-set L,i.e
700       * if its position in L would be not the last one
701       */
702      if (strat->Ll >= 0) /* L is not empty */
703      {
704        at = strat->posInL(strat->L,strat->Ll,h,strat);
705        if(at <= strat->Ll)
706          /*- h will not become the next element to reduce -*/
707        {
708          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
709#ifdef KDEBUG
710          if (TEST_OPT_DEBUG) Print(" ecart too big: -> L%d\n",at);
711#endif
712          h->Clear();
713          return -1;
714        }
715      }
716    }
717#ifdef KDEBUG
718    if (TEST_OPT_DEBUG)
719    {
720      PrintS("red:");
721      h->wrp();
722      PrintS(" with ");
723      strat->T[ii].wrp();
724    }
725#endif
726    assume(strat->fromT == FALSE);
727
728#if 0 // test poly exchange
729    if (strat->inStdFac==0)
730    {
731      int ll;
732      poly t_p;
733      if (strat->tailRing==currRing)
734        t_p=strat->T[ii].p;
735      else
736        t_p=strat->T[ii].t_p;
737      if ((p_LmCmp(h_p,t_p,strat->tailRing)==0)
738      && ((ll=h->GuessLength()) < strat->T[ii].pLength))
739      {
740        h->GetP();
741        if ((h->pLength=h->GetpLength()) < strat->T[ii].pLength)
742        {
743          if (TEST_OPT_PROT)  PrintS("e");
744          h->GetP();
745          if (h->p!=NULL)
746          {
747            if (strat->T[ii].p!=NULL)
748            {
749              poly swap;
750              omTypeAlloc0Bin(poly,swap,currRing->PolyBin);
751              memcpy(swap,h->p,currRing->PolyBin->sizeW*sizeof(long));
752              memcpy(h->p,strat->T[ii].p,currRing->PolyBin->sizeW*sizeof(long));
753              memcpy(strat->T[ii].p,swap,currRing->PolyBin->sizeW*sizeof(long));
754              omFreeBinAddr(swap);
755            }
756            else
757            {
758              strat->T[ii].p=h->p;
759              h->p=NULL;
760            }
761          }
762          else
763          {
764            if (strat->T[ii].p!=NULL)
765            {
766              h->p=strat->T[ii].p;
767              strat->T[ii].p=NULL;
768            }
769            // else: all NULL
770          }
771          if (h->t_p!=NULL)
772          {
773            if (strat->T[ii].t_p!=NULL)
774            {
775              poly swap;
776              omTypeAlloc0Bin(poly,swap,strat->tailRing->PolyBin);
777              memcpy(swap,h->t_p,strat->tailRing->PolyBin->sizeW*sizeof(long));
778              memcpy(h->t_p,strat->T[ii].t_p,strat->tailRing->PolyBin->sizeW*sizeof(long));
779              memcpy(strat->T[ii].t_p,swap,strat->tailRing->PolyBin->sizeW*sizeof(long));
780              omFreeBinAddr(swap);
781            }
782            else
783            {
784              strat->T[ii].t_p=h->t_p;
785              h->t_p=NULL;
786            }
787          }
788          else
789          {
790            if (strat->T[ii].t_p!=NULL)
791            {
792              h->t_p=strat->T[ii].t_p;
793              strat->T[ii].t_p=NULL;
794            }
795            // else: all NULL
796          }
797          if (strat->tailRing != currRing && (strat->T[ii].p != NULL)
798          && pNext(strat->T[ii].p) != NULL)
799             strat->T[ii].max =p_GetMaxExpP(pNext(strat->T[ii].p), strat->tailRing);
800          else
801             strat->T[ii].max = NULL;
802          h->length=h->pLength=pLength(h->p);
803          strat->T[ii].length=strat->T[ii].pLength=pLength(strat->T[ii].p);
804          if (strat->T[ii].is_normalized)
805          {
806            strat->T[ii].is_normalized=0;
807            strat->T[ii].pNorm();
808          }
809          else
810          {
811            if (TEST_OPT_INTSTRATEGY)
812              strat->T[ii].pCleardenom();
813          }
814          h->PrepareRed(strat->use_buckets);
815        }
816      }
817    }
818#endif // test poly exchange
819    ksReducePoly(h, &(strat->T[ii]), NULL, NULL, strat);
820
821#ifdef KDEBUG
822    if (TEST_OPT_DEBUG)
823    {
824      PrintS("\nto ");
825      h->wrp();
826      PrintLn();
827    }
828#endif
829
830    h_p = h->GetLmTailRing();
831    if (h_p == NULL)
832    {
833      if (h->lcm!=NULL) pLmFree(h->lcm);
834#ifdef KDEBUG
835      h->lcm=NULL;
836#endif
837      return 0;
838    }
839    h->SetShortExpVector();
840    not_sev = ~ h->sev;
841    h_d = h->SetpFDeg();
842    /* compute the ecart */
843    if (ei <= h->ecart)
844      h->ecart = d-h_d;
845    else
846      h->ecart = d-h_d+ei-h->ecart;
847    /*
848     * try to reduce the s-polynomial h
849     *test first whether h should go to the lazyset L
850     *-if the degree jumps
851     *-if the number of pre-defined reductions jumps
852     */
853    pass++;
854    d = h_d + h->ecart;
855    if (!K_TEST_OPT_REDTHROUGH && (strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
856    {
857      h->SetLmCurrRing();
858      at = strat->posInL(strat->L,strat->Ll,h,strat);
859      if (at <= strat->Ll)
860      {
861        int dummy=strat->sl;
862        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
863          return 1;
864        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
865#ifdef KDEBUG
866        if (TEST_OPT_DEBUG)
867          Print(" degree jumped: -> L%d\n",at);
868#endif
869        h->Clear();
870        return -1;
871      }
872    }
873    else if (TEST_OPT_PROT && (strat->Ll < 0) && (d > reddeg))
874    {
875      reddeg = d;
876      Print(".%d",d); mflush();
877    }
878  }
879}
880/*2
881*  reduction procedure for the normal form
882*/
883
884poly redNF (poly h,int &max_ind,kStrategy strat)
885{
886  if (h==NULL) return NULL;
887  int j;
888  max_ind=strat->sl;
889
890  if (0 > strat->sl)
891  {
892    return h;
893  }
894  LObject P(h);
895  P.SetShortExpVector();
896  P.bucket = kBucketCreate(currRing);
897  kBucketInit(P.bucket,P.p,pLength(P.p));
898  kbTest(P.bucket);
899  loop
900  {
901    j=kFindDivisibleByInS(strat,&max_ind,&P);
902    if (j>=0)
903    {
904      int sl=pSize(strat->S[j]);
905      int jj=j;
906      loop
907      {
908        int sll;
909        jj=kFindNextDivisibleByInS(strat,jj+1,max_ind,&P);
910        if (jj<0) break;
911        sll=pSize(strat->S[jj]);
912        if (sll<sl)
913        {
914          if (!nIsOne(pGetCoeff(strat->S[j])))
915          {
916            pNorm(strat->S[j]);
917            //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
918            sl=pSize(strat->S[j]);
919          }
920          if (!nIsOne(pGetCoeff(strat->S[jj])))
921          {
922            pNorm(strat->S[jj]);
923            //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
924            sll=pSize(strat->S[jj]);
925          }
926          if (sll<sl)
927          {
928            #ifdef KDEBUG
929            if (TEST_OPT_DEBUG) Print("better(S%d:%d -> S%d:%d)\n",j,sl,jj,sll);
930            #endif
931            //else if (TEST_OPT_PROT) { PrintS("b"); mflush(); }
932            j=jj;
933            sl=sll;
934          }
935        }
936      }
937      if (!nIsOne(pGetCoeff(strat->S[j])))
938      {
939        pNorm(strat->S[j]);
940        //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
941      }
942      nNormalize(pGetCoeff(P.p));
943#ifdef KDEBUG
944      if (TEST_OPT_DEBUG)
945      {
946        PrintS("red:");
947        wrp(h);
948        PrintS(" with ");
949        wrp(strat->S[j]);
950      }
951#endif
952#ifdef HAVE_PLURAL
953      if (rIsPluralRing(currRing))
954      {
955        number coef;
956        nc_kBucketPolyRed(P.bucket,strat->S[j],&coef);
957        nDelete(&coef);
958      }
959      else
960#endif
961      {
962        number coef;
963        coef=kBucketPolyRed(P.bucket,strat->S[j],pLength(strat->S[j]),strat->kNoether);
964        nDelete(&coef);
965      }
966      h = kBucketGetLm(P.bucket);   // FRAGE OLIVER
967      if (h==NULL)
968      {
969        kBucketDestroy(&P.bucket);
970        return NULL;
971      }
972      kbTest(P.bucket);
973      P.p=h;
974      P.t_p=NULL;
975      P.SetShortExpVector();
976#ifdef KDEBUG
977      if (TEST_OPT_DEBUG)
978      {
979        PrintS("\nto:");
980        wrp(h);
981        PrintLn();
982      }
983#endif
984    }
985    else
986    {
987      P.p=kBucketClear(P.bucket);
988      kBucketDestroy(&P.bucket);
989      pNormalize(P.p);
990      return P.p;
991    }
992  }
993}
994
995#ifdef KDEBUG
996static int bba_count = 0;
997#endif
998
999ideal bba (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
1000{
1001#ifdef KDEBUG
1002  bba_count++;
1003  int loop_count = 0;
1004#endif
1005  om_Opts.MinTrack = 5;
1006  int   srmax,lrmax, red_result = 1;
1007  int   olddeg,reduc;
1008  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1009  BOOLEAN withT = FALSE;
1010
1011  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1012  initBuchMoraPos(strat);
1013  initHilbCrit(F,Q,&hilb,strat);
1014  initBba(F,strat);
1015  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1016  /*Shdl=*/initBuchMora(F, Q,strat);
1017  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
1018  srmax = strat->sl;
1019  reduc = olddeg = lrmax = 0;
1020
1021#ifndef NO_BUCKETS
1022  if (!TEST_OPT_NOT_BUCKETS)
1023    strat->use_buckets = 1;
1024#endif
1025
1026  // redtailBBa against T for inhomogenous input
1027  if (!K_TEST_OPT_OLDSTD)
1028    withT = ! strat->homog;
1029
1030  // strat->posInT = posInT_pLength;
1031  kTest_TS(strat);
1032
1033#ifdef HAVE_TAIL_RING
1034  kStratInitChangeTailRing(strat);
1035#endif
1036
1037  /* compute------------------------------------------------------- */
1038  while (strat->Ll >= 0)
1039  {
1040    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1041    #ifdef KDEBUG
1042      loop_count++;
1043      #ifdef HAVE_RINGS
1044        if (TEST_OPT_DEBUG) PrintS("--- next step ---\n");
1045      #endif
1046      if (TEST_OPT_DEBUG) messageSets(strat);
1047    #endif
1048    if (strat->Ll== 0) strat->interpt=TRUE;
1049    if (TEST_OPT_DEGBOUND
1050        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1051            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1052    {
1053      /*
1054       *stops computation if
1055       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1056       *a predefined number Kstd1_deg
1057       */
1058      while ((strat->Ll >= 0)
1059        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1060        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1061            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1062        )
1063        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1064      if (strat->Ll<0) break;
1065      else strat->noClearS=TRUE;
1066    }
1067    /* picks the last element from the lazyset L */
1068    strat->P = strat->L[strat->Ll];
1069    strat->Ll--;
1070
1071    if (pNext(strat->P.p) == strat->tail)
1072    {
1073      // deletes the short spoly
1074#ifdef HAVE_RINGS
1075      if (rField_is_Ring(currRing))
1076        pLmDelete(strat->P.p);
1077      else
1078#endif
1079        pLmFree(strat->P.p);
1080      strat->P.p = NULL;
1081      poly m1 = NULL, m2 = NULL;
1082
1083      // check that spoly creation is ok
1084      while (strat->tailRing != currRing &&
1085             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1086      {
1087        assume(m1 == NULL && m2 == NULL);
1088        // if not, change to a ring where exponents are at least
1089        // large enough
1090        kStratChangeTailRing(strat);
1091      }
1092      // create the real one
1093      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
1094                    strat->tailRing, m1, m2, strat->R);
1095    }
1096    else if (strat->P.p1 == NULL)
1097    {
1098      if (strat->minim > 0)
1099        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1100      // for input polys, prepare reduction
1101      strat->P.PrepareRed(strat->use_buckets);
1102    }
1103
1104    if (strat->P.p == NULL && strat->P.t_p == NULL)
1105    {
1106      red_result = 0;
1107    }
1108    else
1109    {
1110      if (TEST_OPT_PROT)
1111        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1112                &olddeg,&reduc,strat, red_result);
1113
1114      /* reduction of the element choosen from L */
1115      red_result = strat->red(&strat->P,strat);
1116    }
1117
1118    // reduction to non-zero new poly
1119    if (red_result == 1)
1120    {
1121      /* statistic */
1122      if (TEST_OPT_PROT) PrintS("s");
1123
1124      // get the polynomial (canonicalize bucket, make sure P.p is set)
1125      strat->P.GetP(strat->lmBin);
1126
1127      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1128
1129      // reduce the tail and normalize poly
1130      // in the ring case we cannot expect LC(f) = 1,
1131      // therefore we call pContent instead of pNorm
1132      if ((TEST_OPT_INTSTRATEGY) || (rField_is_Ring(currRing)))
1133      {
1134        strat->P.pCleardenom();
1135        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1136        {
1137          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1138          strat->P.pCleardenom();
1139        }
1140      }
1141      else
1142      {
1143        strat->P.pNorm();
1144        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1145          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1146      }
1147
1148#ifdef KDEBUG
1149      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1150#endif
1151
1152      // min_std stuff
1153      if ((strat->P.p1==NULL) && (strat->minim>0))
1154      {
1155        if (strat->minim==1)
1156        {
1157          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1158          p_Delete(&strat->P.p2, currRing, strat->tailRing);
1159        }
1160        else
1161        {
1162          strat->M->m[minimcnt]=strat->P.p2;
1163          strat->P.p2=NULL;
1164        }
1165        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1166          pNext(strat->M->m[minimcnt])
1167            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1168                                           strat->tailRing, currRing,
1169                                           currRing->PolyBin);
1170        minimcnt++;
1171      }
1172
1173      // enter into S, L, and T
1174      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1175        enterT(strat->P, strat);
1176#ifdef HAVE_RINGS
1177      if (rField_is_Ring(currRing))
1178        superenterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1179      else
1180#endif
1181        enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1182      // posInS only depends on the leading term
1183      if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1184      {
1185      strat->enterS(strat->P, pos, strat, strat->tl);
1186      }
1187      else
1188      {
1189      //  strat->P.Delete(); // syzComp test: it is in T
1190      }
1191#if 0
1192      int pl=pLength(strat->P.p);
1193      if (pl==1)
1194      {
1195        //if (TEST_OPT_PROT)
1196        //PrintS("<1>");
1197      }
1198      else if (pl==2)
1199      {
1200        //if (TEST_OPT_PROT)
1201        //PrintS("<2>");
1202      }
1203#endif
1204      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1205//      Print("[%d]",hilbeledeg);
1206      if (strat->P.lcm!=NULL)
1207#ifdef HAVE_RINGS
1208        pLmDelete(strat->P.lcm);
1209#else
1210        pLmFree(strat->P.lcm);
1211#endif
1212      if (strat->sl>srmax) srmax = strat->sl;
1213    }
1214    else if (strat->P.p1 == NULL && strat->minim > 0)
1215    {
1216      p_Delete(&strat->P.p2, currRing, strat->tailRing);
1217    }
1218
1219#ifdef KDEBUG
1220    memset(&(strat->P), 0, sizeof(strat->P));
1221#endif
1222    kTest_TS(strat);
1223  }
1224#ifdef KDEBUG
1225  if (TEST_OPT_DEBUG) messageSets(strat);
1226#endif
1227  /* complete reduction of the standard basis--------- */
1228  if (TEST_OPT_SB_1)
1229  {
1230    int k=1;
1231    int j;
1232    while(k<=strat->sl)
1233    {
1234      j=0;
1235      loop
1236      {
1237        if (j>=k) break;
1238        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1239        j++;
1240      }
1241      k++;
1242    }
1243  }
1244
1245  if (TEST_OPT_REDSB)
1246  {
1247    completeReduce(strat);
1248#ifdef HAVE_TAIL_RING
1249    if (strat->completeReduce_retry)
1250    {
1251      // completeReduce needed larger exponents, retry
1252      // to reduce with S (instead of T)
1253      // and in currRing (instead of strat->tailRing)
1254      cleanT(strat);strat->tailRing=currRing;
1255      int i;
1256      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1257      completeReduce(strat);
1258    }
1259#endif
1260  }
1261  else if (TEST_OPT_PROT) PrintLn();
1262
1263  /* release temp data-------------------------------- */
1264  exitBuchMora(strat);
1265  if (TEST_OPT_WEIGHTM)
1266  {
1267    pRestoreDegProcs(pFDegOld, pLDegOld);
1268    if (ecartWeights)
1269    {
1270      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1271      ecartWeights=NULL;
1272    }
1273  }
1274  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1275  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1276  return (strat->Shdl);
1277}
1278#ifdef HAVE_PLURAL
1279ideal bbaPart (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
1280{
1281  om_Opts.MinTrack = 5;
1282  int   srmax,lrmax, red_result = 1;
1283  int   olddeg,reduc;
1284  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1285  BOOLEAN withT = FALSE;
1286
1287  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1288  nc_gr_initBba(F,strat);
1289  initBuchMoraPos(strat);
1290  //initHilbCrit(F,Q,&hilb,strat);
1291  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1292  /*Shdl=*/initBuchMora(F, Q,strat);
1293  //if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
1294  strat->posInT=posInT110;
1295
1296  srmax = strat->sl;
1297  reduc = olddeg = lrmax = 0;
1298
1299#ifndef NO_BUCKETS
1300  if (!TEST_OPT_NOT_BUCKETS)
1301    strat->use_buckets = 1;
1302#endif
1303
1304  // redtailBBa against T for inhomogenous input
1305  if (!K_TEST_OPT_OLDSTD)
1306    withT = ! strat->homog;
1307
1308  // strat->posInT = posInT_pLength;
1309  kTest_TS(strat);
1310
1311//#ifdef HAVE_TAIL_RING
1312//  kStratInitChangeTailRing(strat);
1313//#endif
1314
1315  /* compute------------------------------------------------------- */
1316  while (strat->Ll >= 0)
1317  {
1318    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1319    #ifdef KDEBUG
1320      #ifdef HAVE_RINGS
1321        if (TEST_OPT_DEBUG) PrintS("--- next step ---\n");
1322      #endif
1323      if (TEST_OPT_DEBUG) messageSets(strat);
1324    #endif
1325    if (strat->Ll== 0) strat->interpt=TRUE;
1326    if (TEST_OPT_DEGBOUND
1327        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1328            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1329    {
1330      /*
1331       *stops computation if
1332       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1333       *a predefined number Kstd1_deg
1334       */
1335      while ((strat->Ll >= 0)
1336        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1337        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1338            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1339        )
1340        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1341      if (strat->Ll<0) break;
1342      else strat->noClearS=TRUE;
1343    }
1344    /* picks the last element from the lazyset L */
1345    strat->P = strat->L[strat->Ll];
1346    strat->Ll--;
1347
1348    if (pNext(strat->P.p) == strat->tail)
1349    {
1350      // deletes the short spoly
1351#ifdef HAVE_RINGS
1352      if (rField_is_Ring(currRing))
1353        pLmDelete(strat->P.p);
1354      else
1355#endif
1356        pLmFree(strat->P.p);
1357      strat->P.p = NULL;
1358      poly m1 = NULL, m2 = NULL;
1359
1360//#ifdef HAVE_TAIL_RING
1361//      // check that spoly creation is ok
1362//      while (strat->tailRing != currRing &&
1363//             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1364//      {
1365//        assume(m1 == NULL && m2 == NULL);
1366//        // if not, change to a ring where exponents are at least
1367//        // large enough
1368//        kStratChangeTailRing(strat);
1369//      }
1370//#endif
1371      // create the real one
1372      strat->P.p = nc_CreateSpoly(strat->P.p1,strat->P.p2,currRing);
1373    }
1374    //else if (strat->P.p1 == NULL)
1375    //{
1376    //  if (strat->minim > 0)
1377    //    strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1378    //  // for input polys, prepare reduction
1379    //  strat->P.PrepareRed(strat->use_buckets);
1380    //}
1381
1382    if (strat->P.p == NULL && strat->P.t_p == NULL)
1383    {
1384      red_result = 0;
1385    }
1386    else
1387    {
1388      if (TEST_OPT_PROT)
1389        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1390                &olddeg,&reduc,strat, red_result);
1391
1392      /* reduction of the element choosen from L */
1393      red_result = strat->red(&strat->P,strat);
1394    }
1395
1396    // reduction to non-zero new poly
1397    if (red_result == 1)
1398    {
1399      /* statistic */
1400      if (TEST_OPT_PROT) PrintS("s");
1401
1402      // get the polynomial (canonicalize bucket, make sure P.p is set)
1403      strat->P.GetP(strat->lmBin);
1404
1405      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1406
1407      // reduce the tail and normalize poly
1408      // in the ring case we cannot expect LC(f) = 1,
1409      // therefore we call pContent instead of pNorm
1410      if ((TEST_OPT_INTSTRATEGY) || (rField_is_Ring(currRing)))
1411      {
1412        strat->P.pCleardenom();
1413        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1414        {
1415          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1416          strat->P.pCleardenom();
1417        }
1418      }
1419      else
1420      {
1421        strat->P.pNorm();
1422        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1423          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1424      }
1425
1426#ifdef KDEBUG
1427      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1428#endif
1429
1430      // min_std stuff
1431      //if ((strat->P.p1==NULL) && (strat->minim>0))
1432      //{
1433      //  if (strat->minim==1)
1434      //  {
1435      //    strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1436      //    p_Delete(&strat->P.p2, currRing, strat->tailRing);
1437      //  }
1438      //  else
1439      //  {
1440      //    strat->M->m[minimcnt]=strat->P.p2;
1441      //    strat->P.p2=NULL;
1442      //  }
1443      //  if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1444      //    pNext(strat->M->m[minimcnt])
1445      //      = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1446      //                                     strat->tailRing, currRing,
1447      //                                     currRing->PolyBin);
1448      //  minimcnt++;
1449      //}
1450
1451      // enter into S, L, and T
1452      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1453        enterT(strat->P, strat);
1454#ifdef HAVE_RINGS
1455      if (rField_is_Ring(currRing))
1456        superenterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1457      else
1458#endif
1459        enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1460      // posInS only depends on the leading term
1461      if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1462      {
1463      strat->enterS(strat->P, pos, strat, strat->tl);
1464      }
1465      else
1466      {
1467      //  strat->P.Delete(); // syzComp test: it is in T
1468      }
1469      //if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1470//      Print("[%d]",hilbeledeg);
1471      if (strat->P.lcm!=NULL)
1472#ifdef HAVE_RINGS
1473        pLmDelete(strat->P.lcm);
1474#else
1475        pLmFree(strat->P.lcm);
1476#endif
1477      if (strat->sl>srmax) srmax = strat->sl;
1478    }
1479    //else if (strat->P.p1 == NULL && strat->minim > 0)
1480    //{
1481    //  p_Delete(&strat->P.p2, currRing, strat->tailRing);
1482    //}
1483
1484#ifdef KDEBUG
1485    memset(&(strat->P), 0, sizeof(strat->P));
1486#endif
1487    kTest_TS(strat);
1488  }
1489#ifdef KDEBUG
1490  if (TEST_OPT_DEBUG) messageSets(strat);
1491#endif
1492  /* complete reduction of the standard basis--------- */
1493  if (TEST_OPT_SB_1)
1494  {
1495    int k=1;
1496    int j;
1497    while(k<=strat->sl)
1498    {
1499      j=0;
1500      loop
1501      {
1502        if (j>=k) break;
1503        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1504        j++;
1505      }
1506      k++;
1507    }
1508  }
1509
1510  if (TEST_OPT_REDSB)
1511  {
1512    completeReduce(strat);
1513//#ifdef HAVE_TAIL_RING
1514//    if (strat->completeReduce_retry)
1515//    {
1516//      // completeReduce needed larger exponents, retry
1517//      // to reduce with S (instead of T)
1518//      // and in currRing (instead of strat->tailRing)
1519//      cleanT(strat);strat->tailRing=currRing;
1520//      int i;
1521//      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1522//      completeReduce(strat);
1523//    }
1524//#endif
1525  }
1526  else if (TEST_OPT_PROT) PrintLn();
1527
1528  /* release temp data-------------------------------- */
1529  exitBuchMora(strat);
1530  if (TEST_OPT_WEIGHTM)
1531  {
1532    pRestoreDegProcs(pFDegOld, pLDegOld);
1533    if (ecartWeights)
1534    {
1535      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1536      ecartWeights=NULL;
1537    }
1538  }
1539  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1540  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1541  return (strat->Shdl);
1542}
1543#endif
1544poly kNF2 (ideal F,ideal Q,poly q,kStrategy strat, int lazyReduce)
1545{
1546  poly   p;
1547  int   i;
1548
1549  if ((idIs0(F))&&(Q==NULL))
1550    return pCopy(q); /*F=0*/
1551  strat->ak = idRankFreeModule(F);
1552  /*- creating temp data structures------------------- -*/
1553  BITSET save_test=test;
1554  test|=Sy_bit(OPT_REDTAIL);
1555  initBuchMoraCrit(strat);
1556  strat->initEcart = initEcartBBA;
1557  strat->enterS = enterSBba;
1558#ifndef NO_BUCKETS
1559  strat->use_buckets = (!TEST_OPT_NOT_BUCKETS) && (!rIsPluralRing(currRing));
1560#endif
1561  /*- set S -*/
1562  strat->sl = -1;
1563  /*- init local data struct.---------------------------------------- -*/
1564  /*Shdl=*/initS(F,Q,strat);
1565  /*- compute------------------------------------------------------- -*/
1566  //if ((TEST_OPT_INTSTRATEGY)&&(lazyReduce==0))
1567  //{
1568  //  for (i=strat->sl;i>=0;i--)
1569  //    pNorm(strat->S[i]);
1570  //}
1571  kTest(strat);
1572  if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
1573  int max_ind;
1574  p = redNF(pCopy(q),max_ind,strat);
1575  if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
1576  {
1577    BITSET save=test;
1578    test &= ~Sy_bit(OPT_INTSTRATEGY);
1579    if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
1580    p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
1581    test=save;
1582  }
1583  /*- release temp data------------------------------- -*/
1584  omfree(strat->sevS);
1585  omfree(strat->ecartS);
1586  omfree(strat->T);
1587  omfree(strat->sevT);
1588  omfree(strat->R);
1589  omfree(strat->S_2_R);
1590  omfree(strat->L);
1591  omfree(strat->B);
1592  omfree(strat->fromQ);
1593  idDelete(&strat->Shdl);
1594  test=save_test;
1595  if (TEST_OPT_PROT) PrintLn();
1596  return p;
1597}
1598
1599ideal kNF2 (ideal F,ideal Q,ideal q,kStrategy strat, int lazyReduce)
1600{
1601  poly   p;
1602  int   i;
1603  ideal res;
1604  int max_ind;
1605
1606  if (idIs0(q))
1607    return idInit(IDELEMS(q),si_max(q->rank,F->rank));
1608  if ((idIs0(F))&&(Q==NULL))
1609    return idCopy(q); /*F=0*/
1610  strat->ak = idRankFreeModule(F);
1611  /*- creating temp data structures------------------- -*/
1612  BITSET save_test=test;
1613  test|=Sy_bit(OPT_REDTAIL);
1614  initBuchMoraCrit(strat);
1615  strat->initEcart = initEcartBBA;
1616  strat->enterS = enterSBba;
1617  /*- set S -*/
1618  strat->sl = -1;
1619#ifndef NO_BUCKETS
1620  strat->use_buckets = (!TEST_OPT_NOT_BUCKETS) && (!rIsPluralRing(currRing));
1621#endif
1622  /*- init local data struct.---------------------------------------- -*/
1623  /*Shdl=*/initS(F,Q,strat);
1624  /*- compute------------------------------------------------------- -*/
1625  res=idInit(IDELEMS(q),si_max(q->rank,F->rank));
1626  for (i=IDELEMS(q)-1; i>=0; i--)
1627  {
1628    if (q->m[i]!=NULL)
1629    {
1630      if (TEST_OPT_PROT) { PrintS("r");mflush(); }
1631      p = redNF(pCopy(q->m[i]),max_ind,strat);
1632      if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
1633      {
1634        BITSET save=test;
1635        test &= ~Sy_bit(OPT_INTSTRATEGY);
1636        if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
1637        p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
1638        test=save;
1639      }
1640      res->m[i]=p;
1641    }
1642    //else
1643    //  res->m[i]=NULL;
1644  }
1645  /*- release temp data------------------------------- -*/
1646  omfree(strat->sevS);
1647  omfree(strat->ecartS);
1648  omfree(strat->T);
1649  omfree(strat->sevT);
1650  omfree(strat->R);
1651  omfree(strat->S_2_R);
1652  omfree(strat->L);
1653  omfree(strat->B);
1654  omfree(strat->fromQ);
1655  idDelete(&strat->Shdl);
1656  test=save_test;
1657  if (TEST_OPT_PROT) PrintLn();
1658  return res;
1659}
1660
1661/* shiftgb stuff */
1662#ifdef HAVE_SHIFTBBA
1663
1664
1665ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, int uptodeg, int lV)
1666{
1667#ifdef KDEBUG
1668  bba_count++;
1669  int loop_count = 0;
1670#endif
1671  om_Opts.MinTrack = 5;
1672  int   srmax,lrmax, red_result = 1;
1673  int   olddeg,reduc;
1674  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1675  BOOLEAN withT = TRUE; // very important for shifts
1676
1677  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit, NO CHANGES */
1678  initBuchMoraPos(strat); /*NO CHANGES YET: perhaps later*/
1679  initHilbCrit(F,Q,&hilb,strat); /*NO CHANGES*/
1680  initBbaShift(F,strat); /* DONE */
1681  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1682  /*Shdl=*/initBuchMoraShift(F, Q,strat); /* updateS with no toT, i.e. no init for T */
1683  updateSShift(strat,uptodeg,lV); /* initializes T */
1684
1685  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
1686  srmax = strat->sl;
1687  reduc = olddeg = lrmax = 0;
1688
1689#ifndef NO_BUCKETS
1690  if (!TEST_OPT_NOT_BUCKETS)
1691    strat->use_buckets = 1;
1692#endif
1693
1694  // redtailBBa against T for inhomogenous input
1695  //  if (!K_TEST_OPT_OLDSTD)
1696  //    withT = ! strat->homog;
1697
1698  // strat->posInT = posInT_pLength;
1699  kTest_TS(strat);
1700
1701#ifdef HAVE_TAIL_RING
1702  kStratInitChangeTailRing(strat);
1703#endif
1704
1705  /* compute------------------------------------------------------- */
1706  while (strat->Ll >= 0)
1707  {
1708    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1709#ifdef KDEBUG
1710    loop_count++;
1711    if (TEST_OPT_DEBUG) messageSets(strat);
1712#endif
1713    if (strat->Ll== 0) strat->interpt=TRUE;
1714    if (TEST_OPT_DEGBOUND
1715        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1716            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1717    {
1718      /*
1719       *stops computation if
1720       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1721       *a predefined number Kstd1_deg
1722       */
1723      while ((strat->Ll >= 0)
1724        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1725        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1726            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1727        )
1728        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1729      if (strat->Ll<0) break;
1730      else strat->noClearS=TRUE;
1731    }
1732    /* picks the last element from the lazyset L */
1733    strat->P = strat->L[strat->Ll];
1734    strat->Ll--;
1735
1736    if (pNext(strat->P.p) == strat->tail)
1737    {
1738      // deletes the short spoly
1739      pLmFree(strat->P.p);
1740      strat->P.p = NULL;
1741      poly m1 = NULL, m2 = NULL;
1742
1743      // check that spoly creation is ok
1744      while (strat->tailRing != currRing &&
1745             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1746      {
1747        assume(m1 == NULL && m2 == NULL);
1748        // if not, change to a ring where exponents are at least
1749        // large enough
1750        kStratChangeTailRing(strat);
1751      }
1752      // create the real one
1753      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
1754                    strat->tailRing, m1, m2, strat->R);
1755    }
1756    else if (strat->P.p1 == NULL)
1757    {
1758      if (strat->minim > 0)
1759        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1760      // for input polys, prepare reduction
1761      strat->P.PrepareRed(strat->use_buckets);
1762    }
1763
1764    poly qq;
1765
1766    /* here in the nonhomog case we shrink the new spoly */
1767
1768    if ( ! strat->homog)
1769    {
1770      strat->P.GetP(strat->lmBin); // because shifts are counted with .p structure
1771      /* assume strat->P.t_p != NULL */
1772      /* in the nonhomog case we have to shrink the polynomial */
1773      assume(strat->P.t_p!=NULL);
1774      qq = p_Shrink(strat->P.t_p, lV, strat->tailRing); // direct shrink
1775      if (qq != NULL)
1776      {
1777         /* we're here if Shrink is nonzero */
1778        //         strat->P.p =  NULL;
1779        //        strat->P.Delete(); /* deletes P.p and P.t_p */ //error
1780        strat->P.p   =  NULL; // is not set by Delete
1781        strat->P.t_p =  qq;
1782        strat->P.GetP(strat->lmBin);
1783        // update sev and length
1784        strat->initEcart(&(strat->P));
1785        strat->P.sev = pGetShortExpVector(strat->P.p);
1786//         strat->P.FDeg = strat->P.pFDeg();
1787//         strat->P.length = strat->P.pLDeg();
1788//         strat->P.pLength =strat->P.GetpLength(); //pLength(strat->P.p);
1789      }
1790      else
1791      {
1792         /* Shrink is zero, like y(1)*y(2) - y(1)*y(3)*/
1793#ifdef KDEBUG
1794         if (TEST_OPT_DEBUG){PrintS("nonzero s shrinks to 0");PrintLn();}
1795#endif
1796         //         strat->P.Delete();  // cause error
1797         strat->P.p = NULL;
1798         strat->P.t_p = NULL;
1799           //         strat->P.p = NULL; // or delete strat->P.p ?
1800       }
1801    }
1802      /* end shrinking poly in the nonhomog case */
1803
1804    if (strat->P.p == NULL && strat->P.t_p == NULL)
1805    {
1806      red_result = 0;
1807    }
1808    else
1809    {
1810      if (TEST_OPT_PROT)
1811        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1812                &olddeg,&reduc,strat, red_result);
1813
1814      /* reduction of the element choosen from L */
1815      red_result = strat->red(&strat->P,strat);
1816    }
1817
1818    // reduction to non-zero new poly
1819    if (red_result == 1)
1820    {
1821      /* statistic */
1822      if (TEST_OPT_PROT) PrintS("s");
1823
1824      // get the polynomial (canonicalize bucket, make sure P.p is set)
1825      strat->P.GetP(strat->lmBin);
1826
1827      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1828
1829      // reduce the tail and normalize poly
1830      if (TEST_OPT_INTSTRATEGY)
1831      {
1832        strat->P.pCleardenom();
1833        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1834        {
1835          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1836          strat->P.pCleardenom();
1837        }
1838      }
1839      else
1840      {
1841        strat->P.pNorm();
1842        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1843          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1844      }
1845
1846      // here we must shrink again! and optionally reduce again
1847      // or build shrink into redtailBba!
1848
1849#ifdef KDEBUG
1850      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1851#endif
1852
1853      // min_std stuff
1854      if ((strat->P.p1==NULL) && (strat->minim>0))
1855      {
1856        if (strat->minim==1)
1857        {
1858          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1859          p_Delete(&strat->P.p2, currRing, strat->tailRing);
1860        }
1861        else
1862        {
1863          strat->M->m[minimcnt]=strat->P.p2;
1864          strat->P.p2=NULL;
1865        }
1866        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1867          pNext(strat->M->m[minimcnt])
1868            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1869                                           strat->tailRing, currRing,
1870                                           currRing->PolyBin);
1871        minimcnt++;
1872      }
1873
1874    /* here in the nonhomog case we shrink the reduced poly AGAIN */
1875
1876    if ( ! strat->homog)
1877    {
1878      strat->P.GetP(strat->lmBin); // because shifts are counted with .p structure
1879      /* assume strat->P.t_p != NULL */
1880      /* in the nonhomog case we have to shrink the polynomial */
1881      assume(strat->P.t_p!=NULL); // poly qq defined above
1882      qq = p_Shrink(strat->P.t_p, lV, strat->tailRing); // direct shrink
1883      if (qq != NULL)
1884      {
1885         /* we're here if Shrink is nonzero */
1886        //         strat->P.p =  NULL;
1887        //        strat->P.Delete(); /* deletes P.p and P.t_p */ //error
1888        strat->P.p   =  NULL; // is not set by Delete
1889        strat->P.t_p =  qq;
1890        strat->P.GetP(strat->lmBin);
1891        // update sev and length
1892        strat->initEcart(&(strat->P));
1893        strat->P.sev = pGetShortExpVector(strat->P.p);
1894      }
1895      else
1896      {
1897         /* Shrink is zero, like y(1)*y(2) - y(1)*y(3)*/
1898#ifdef PDEBUG
1899         if (TEST_OPT_DEBUG){PrintS("nonzero s shrinks to 0");PrintLn();}
1900#endif
1901         //         strat->P.Delete();  // cause error
1902         strat->P.p = NULL;
1903         strat->P.t_p = NULL;
1904           //         strat->P.p = NULL; // or delete strat->P.p ?
1905         goto     red_shrink2zero;
1906       }
1907    }
1908      /* end shrinking poly AGAIN in the nonhomog case */
1909
1910
1911      // enter into S, L, and T
1912      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1913      //        enterT(strat->P, strat); // this was here before Shift stuff
1914      //enterTShift(LObject p, kStrategy strat, int atT, int uptodeg, int lV); // syntax
1915      // the default value for atT = -1 as in bba
1916      /*   strat->P.GetP(); */
1917      // because shifts are counted with .p structure // done before, but ?
1918      enterTShift(strat->P,strat,-1,uptodeg, lV);
1919      enterpairsShift(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl,uptodeg,lV);
1920      //      enterpairsShift(vw,strat->sl,strat->P.ecart,pos,strat, strat->tl,uptodeg,lV);
1921      // posInS only depends on the leading term
1922      if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1923      {
1924        strat->enterS(strat->P, pos, strat, strat->tl);
1925      }
1926      else
1927      {
1928      //  strat->P.Delete(); // syzComp test: it is in T
1929      }
1930
1931      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1932//      Print("[%d]",hilbeledeg);
1933      if (strat->P.lcm!=NULL) pLmFree(strat->P.lcm);
1934      if (strat->sl>srmax) srmax = strat->sl;
1935    }
1936    else
1937    {
1938    red_shrink2zero:
1939      if (strat->P.p1 == NULL && strat->minim > 0)
1940      {
1941        p_Delete(&strat->P.p2, currRing, strat->tailRing);
1942      }
1943    }
1944#ifdef KDEBUG
1945    memset(&(strat->P), 0, sizeof(strat->P));
1946#endif
1947    kTest_TS(strat);
1948  }
1949#ifdef KDEBUG
1950  if (TEST_OPT_DEBUG) messageSets(strat);
1951#endif
1952  /* complete reduction of the standard basis--------- */
1953  if (TEST_OPT_SB_1)
1954  {
1955    int k=1;
1956    int j;
1957    while(k<=strat->sl)
1958    {
1959      j=0;
1960      loop
1961      {
1962        if (j>=k) break;
1963        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1964        j++;
1965      }
1966      k++;
1967    }
1968  }
1969
1970  if (TEST_OPT_REDSB)
1971  {
1972    completeReduce(strat, TRUE); //shift: withT = TRUE
1973    if (strat->completeReduce_retry)
1974    {
1975      // completeReduce needed larger exponents, retry
1976      // to reduce with S (instead of T)
1977      // and in currRing (instead of strat->tailRing)
1978      cleanT(strat);strat->tailRing=currRing;
1979      int i;
1980      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1981      completeReduce(strat, TRUE);
1982    }
1983  }
1984  else if (TEST_OPT_PROT) PrintLn();
1985
1986  /* release temp data-------------------------------- */
1987  exitBuchMora(strat);
1988  if (TEST_OPT_WEIGHTM)
1989  {
1990    pRestoreDegProcs(pFDegOld, pLDegOld);
1991    if (ecartWeights)
1992    {
1993      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1994      ecartWeights=NULL;
1995    }
1996  }
1997  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1998  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1999  return (strat->Shdl);
2000}
2001
2002
2003ideal freegb(ideal I, int uptodeg, int lVblock)
2004{
2005  /* todo main call */
2006
2007  /* assume: ring is prepared, ideal is copied into shifted ring */
2008  /* uptodeg and lVblock are correct - test them! */
2009
2010  //  kStrategy strat = new skStrategy;
2011  /* ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, int uptodeg, int lV) */
2012  /* at the moment:
2013- no quotient (check)
2014- no *w, no *hilb
2015  */
2016  /* ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
2017     int newIdeal, intvec *vw) */
2018  ideal RS = kStdShift(I,NULL, testHomog, NULL,NULL,0,0,NULL, uptodeg, lVblock);
2019    //bbaShift(I,NULL, NULL, NULL, strat, uptodeg, lVblock);
2020  idSkipZeroes(RS);
2021  return(RS);
2022}
2023
2024/*2
2025*reduces h with elements from T choosing  the first possible
2026* element in t with respect to the given pDivisibleBy
2027*/
2028int redFirstShift (LObject* h,kStrategy strat)
2029{
2030  if (h->IsNull()) return 0;
2031
2032  int at, reddeg,d;
2033  int pass = 0;
2034  int j = 0;
2035
2036  if (! strat->homog)
2037  {
2038    d = h->GetpFDeg() + h->ecart;
2039    reddeg = strat->LazyDegree+d;
2040  }
2041  h->SetShortExpVector();
2042  loop
2043  {
2044    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
2045    if (j < 0)
2046    {
2047      h->SetDegStuffReturnLDeg(strat->LDegLast);
2048      return 1;
2049    }
2050
2051    if (!TEST_OPT_INTSTRATEGY)
2052      strat->T[j].pNorm();
2053#ifdef KDEBUG
2054    if (TEST_OPT_DEBUG)
2055    {
2056      PrintS("reduce ");
2057      h->wrp();
2058      PrintS(" with ");
2059      strat->T[j].wrp();
2060    }
2061#endif
2062    ksReducePoly(h, &(strat->T[j]), strat->kNoetherTail(), NULL, strat);
2063#ifdef KDEBUG
2064    if (TEST_OPT_DEBUG)
2065    {
2066      PrintS(" to ");
2067      wrp(h->p);
2068      PrintLn();
2069    }
2070#endif
2071    if (h->IsNull())
2072    {
2073      if (h->lcm!=NULL) pLmFree(h->lcm);
2074      h->Clear();
2075      return 0;
2076    }
2077    h->SetShortExpVector();
2078
2079#if 0
2080    if ((strat->syzComp!=0) && !strat->honey)
2081    {
2082      if ((strat->syzComp>0) &&
2083          (h->Comp() > strat->syzComp))
2084      {
2085        assume(h->MinComp() > strat->syzComp);
2086#ifdef KDEBUG
2087        if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
2088#endif
2089        if (strat->homog)
2090          h->SetDegStuffReturnLDeg(strat->LDegLast);
2091        return -2;
2092      }
2093    }
2094#endif
2095    if (!strat->homog)
2096    {
2097      if (!K_TEST_OPT_OLDSTD && strat->honey)
2098      {
2099        h->SetpFDeg();
2100        if (strat->T[j].ecart <= h->ecart)
2101          h->ecart = d - h->GetpFDeg();
2102        else
2103          h->ecart = d - h->GetpFDeg() + strat->T[j].ecart - h->ecart;
2104
2105        d = h->GetpFDeg() + h->ecart;
2106      }
2107      else
2108        d = h->SetDegStuffReturnLDeg(strat->LDegLast);
2109      /*- try to reduce the s-polynomial -*/
2110      pass++;
2111      /*
2112       *test whether the polynomial should go to the lazyset L
2113       *-if the degree jumps
2114       *-if the number of pre-defined reductions jumps
2115       */
2116      if (!K_TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
2117          && ((d >= reddeg) || (pass > strat->LazyPass)))
2118      {
2119        h->SetLmCurrRing();
2120        if (strat->posInLDependsOnLength)
2121          h->SetLength(strat->length_pLength);
2122        at = strat->posInL(strat->L,strat->Ll,h,strat);
2123        if (at <= strat->Ll)
2124        {
2125          int dummy=strat->sl;
2126          /*          if (kFindDivisibleByInS(strat,&dummy, h) < 0) */
2127          if (kFindDivisibleByInT(strat->T,strat->sevT, dummy, h) < 0)
2128            return 1;
2129          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
2130#ifdef KDEBUG
2131          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
2132#endif
2133          h->Clear();
2134          return -1;
2135        }
2136      }
2137      if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
2138      {
2139        reddeg = d+1;
2140        Print(".%d",d);mflush();
2141      }
2142    }
2143  }
2144}
2145
2146void initBbaShift(ideal F,kStrategy strat)
2147{
2148  int i;
2149  idhdl h;
2150 /* setting global variables ------------------- */
2151  strat->enterS = enterSBba; /* remains as is, we change enterT! */
2152
2153  strat->red = redFirstShift; /* no redHomog ! */
2154
2155  if (pLexOrder && strat->honey)
2156    strat->initEcart = initEcartNormal;
2157  else
2158    strat->initEcart = initEcartBBA;
2159  if (strat->honey)
2160    strat->initEcartPair = initEcartPairMora;
2161  else
2162    strat->initEcartPair = initEcartPairBba;
2163  strat->kIdeal = NULL;
2164  //if (strat->ak==0) strat->kIdeal->rtyp=IDEAL_CMD;
2165  //else              strat->kIdeal->rtyp=MODUL_CMD;
2166  //strat->kIdeal->data=(void *)strat->Shdl;
2167  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
2168  {
2169    //interred  machen   Aenderung
2170    pFDegOld=pFDeg;
2171    pLDegOld=pLDeg;
2172    //h=ggetid("ecart");
2173    //if ((h!=NULL) /*&& (IDTYP(h)==INTVEC_CMD)*/)
2174    //{
2175    //  ecartWeights=iv2array(IDINTVEC(h));
2176    //}
2177    //else
2178    {
2179      ecartWeights=(short *)omAlloc((pVariables+1)*sizeof(short));
2180      /*uses automatic computation of the ecartWeights to set them*/
2181      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
2182    }
2183    pRestoreDegProcs(totaldegreeWecart, maxdegreeWecart);
2184    if (TEST_OPT_PROT)
2185    {
2186      for(i=1; i<=pVariables; i++)
2187        Print(" %d",ecartWeights[i]);
2188      PrintLn();
2189      mflush();
2190    }
2191  }
2192}
2193#endif
Note: See TracBrowser for help on using the repository browser.