source: git/kernel/kstd2.cc @ 4c4979

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