source: git/kernel/kstd2.cc @ d5564f8

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