source: git/kernel/kstd2.cc @ b938f4

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