source: git/kernel/kstd2.cc @ 8066e80

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