source: git/kernel/kstd2.cc @ cd388c6

spielwiese
Last change on this file since cd388c6 was 3dc79f5, checked in by Hans Schoenemann <hannes@…>, 13 years ago
fix tr. 328 git-svn-id: file:///usr/local/Singular/svn/trunk@14037 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 51.2 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 <kernel/options.h>
38#include <omalloc/omalloc.h>
39#include <kernel/polys.h>
40#include <kernel/ideals.h>
41#include <kernel/febase.h>
42#include <kernel/kstd1.h>
43#include <kernel/khstd.h>
44#include <kernel/kbuckets.h>
45//#include "cntrlc.h"
46#include <kernel/weight.h>
47#include <kernel/intvec.h>
48#ifdef HAVE_PLURAL
49#include <kernel/gring.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          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
720#ifdef KDEBUG
721          if (TEST_OPT_DEBUG) Print(" ecart too big: -> L%d\n",at);
722#endif
723          h->Clear();
724          return -1;
725        }
726      }
727    }
728#ifdef KDEBUG
729    if (TEST_OPT_DEBUG)
730    {
731      PrintS("red:");
732      h->wrp();
733      PrintS(" with ");
734      strat->T[ii].wrp();
735    }
736#endif
737    assume(strat->fromT == FALSE);
738
739    number coef;
740    ksReducePoly(h,&(strat->T[ii]),strat->kNoetherTail(),&coef,strat);
741#ifdef KDEBUG
742    if (TEST_OPT_DEBUG)
743    {
744      PrintS("\nto:");
745      h->wrp();
746      PrintLn();
747    }
748#endif
749    if(h->IsNull())
750    {
751      h->Clear();
752      if (h->lcm!=NULL) pLmFree(h->lcm);
753      #ifdef KDEBUG
754      h->lcm=NULL;
755      #endif
756      return 0;
757    }
758    h->SetShortExpVector();
759    not_sev = ~ h->sev;
760    h_d = h->SetpFDeg();
761    /* compute the ecart */
762    if (ei <= h->ecart)
763      h->ecart = d-h_d;
764    else
765      h->ecart = d-h_d+ei-h->ecart;
766
767    /*
768     * try to reduce the s-polynomial h
769     *test first whether h should go to the lazyset L
770     *-if the degree jumps
771     *-if the number of pre-defined reductions jumps
772     */
773    pass++;
774    d = h_d + h->ecart;
775    if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
776    {
777      h->GetTP(); // clear bucket
778      h->SetLmCurrRing();
779      at = strat->posInL(strat->L,strat->Ll,h,strat);
780      if (at <= strat->Ll)
781      {
782        int dummy=strat->sl;
783        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
784          return 1;
785        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
786#ifdef KDEBUG
787        if (TEST_OPT_DEBUG)
788          Print(" degree jumped: -> L%d\n",at);
789#endif
790        h->Clear();
791        return -1;
792      }
793    }
794    else if (d > reddeg)
795    {
796      if (d>=strat->tailRing->bitmask)
797      {
798        if (h->pTotalDeg()+h->ecart >= strat->tailRing->bitmask)
799        {
800          strat->overflow=TRUE;
801          //Print("OVERFLOW in redHoney d=%ld, max=%ld\n",d,strat->tailRing->bitmask);
802          h->GetP();
803          at = strat->posInL(strat->L,strat->Ll,h,strat);
804          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
805          h->Clear();
806          return -1;
807        }
808      }
809      else if (TEST_OPT_PROT && (strat->Ll < 0) )
810      {
811        //h->wrp(); Print("<%d>\n",h->GetpLength());
812        reddeg = d;
813        Print(".%ld",d); mflush();
814      }
815    }
816  }
817}
818
819/*2
820*  reduction procedure for the normal form
821*/
822
823poly redNF (poly h,int &max_ind,int nonorm,kStrategy strat)
824{
825  if (h==NULL) return NULL;
826  int j;
827  max_ind=strat->sl;
828
829  if (0 > strat->sl)
830  {
831    return h;
832  }
833  LObject P(h);
834  P.SetShortExpVector();
835  P.bucket = kBucketCreate(currRing);
836  kBucketInit(P.bucket,P.p,pLength(P.p));
837  kbTest(P.bucket);
838#ifdef HAVE_RINGS
839  BOOLEAN is_ring = rField_is_Ring(currRing);
840#endif
841#ifdef KDEBUG
842  if (TEST_OPT_DEBUG)
843  {
844    PrintS("redNF: starting S: ");
845    for( j = 0; j <= max_ind; j++ )
846    {
847      Print("S[%d] (of size: %d): ", j, pSize(strat->S[j]));
848      pWrite(strat->S[j]);
849    }
850  };
851#endif
852
853  loop
854  {
855    j=kFindDivisibleByInS(strat,&max_ind,&P);
856    if (j>=0)
857    {
858#ifdef HAVE_RINGS
859      if (!is_ring)
860      {
861#endif
862        int sl=pSize(strat->S[j]);
863        int jj=j;
864        loop
865        {
866          int sll;
867          jj=kFindNextDivisibleByInS(strat,jj+1,max_ind,&P);
868          if (jj<0) break;
869          sll=pSize(strat->S[jj]);
870          if (sll<sl)
871          {
872            #ifdef KDEBUG
873            if (TEST_OPT_DEBUG) Print("better(S%d:%d -> S%d:%d)\n",j,sl,jj,sll);
874            #endif
875            //else if (TEST_OPT_PROT) { PrintS("b"); mflush(); }
876            j=jj;
877            sl=sll;
878          }
879        }
880        if ((nonorm==0) && (!nIsOne(pGetCoeff(strat->S[j]))))
881        {
882          pNorm(strat->S[j]);
883          //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
884        }
885#ifdef HAVE_RINGS
886      }
887#endif
888      nNormalize(pGetCoeff(P.p));
889#ifdef KDEBUG
890      if (TEST_OPT_DEBUG)
891      {
892        PrintS("red:");
893        wrp(h);
894        PrintS(" with ");
895        wrp(strat->S[j]);
896      }
897#endif
898#ifdef HAVE_PLURAL
899      if (rIsPluralRing(currRing))
900      {
901        number coef;
902        nc_kBucketPolyRed(P.bucket,strat->S[j],&coef);
903        nDelete(&coef);
904      }
905      else
906#endif
907      {
908        number coef;
909        coef=kBucketPolyRed(P.bucket,strat->S[j],pLength(strat->S[j]),strat->kNoether);
910        nDelete(&coef);
911      }
912      h = kBucketGetLm(P.bucket);   // FRAGE OLIVER
913      if (h==NULL)
914      {
915        kBucketDestroy(&P.bucket);
916
917#ifdef KDEBUG
918        if (TEST_OPT_DEBUG)
919        {
920          PrintS("redNF: starting S: ");
921          for( j = 0; j <= max_ind; j++ )
922          {
923            Print("S[%d] (of size: %d): ", j, pSize(strat->S[j]));
924            pWrite(strat->S[j]);
925          }
926        };
927#endif
928       
929        return NULL;
930      }
931      kbTest(P.bucket);
932      P.p=h;
933      P.t_p=NULL;
934      P.SetShortExpVector();
935#ifdef KDEBUG
936      if (TEST_OPT_DEBUG)
937      {
938        PrintS("\nto:");
939        wrp(h);
940        PrintLn();
941      }
942#endif
943    }
944    else
945    {
946      P.p=kBucketClear(P.bucket);
947      kBucketDestroy(&P.bucket);
948      pNormalize(P.p);
949
950#ifdef KDEBUG
951      if (TEST_OPT_DEBUG)
952      {
953        PrintS("redNF: starting S: ");
954        for( j = 0; j <= max_ind; j++ )
955        {
956          Print("S[%d] (of size: %d): ", j, pSize(strat->S[j]));
957          pWrite(strat->S[j]);
958        }
959      };
960#endif
961
962      return P.p;
963    }
964  }
965}
966
967#ifdef KDEBUG
968static int bba_count = 0;
969#endif /* KDEBUG */
970void kDebugPrint(kStrategy strat);
971
972ideal bba (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
973{
974#ifdef KDEBUG
975  bba_count++;
976  int loop_count = 0;
977#endif /* KDEBUG */
978  om_Opts.MinTrack = 5;
979  int   srmax,lrmax, red_result = 1;
980  int   olddeg,reduc;
981  int hilbeledeg=1,hilbcount=0,minimcnt=0;
982  BOOLEAN withT = FALSE;
983
984  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
985  initBuchMoraPos(strat);
986  initHilbCrit(F,Q,&hilb,strat);
987  initBba(F,strat);
988  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
989  /*Shdl=*/initBuchMora(F, Q,strat);
990  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
991  srmax = strat->sl;
992  reduc = olddeg = lrmax = 0;
993
994#ifndef NO_BUCKETS
995  if (!TEST_OPT_NOT_BUCKETS)
996    strat->use_buckets = 1;
997#endif
998
999  // redtailBBa against T for inhomogenous input
1000  if (!TEST_OPT_OLDSTD)
1001    withT = ! strat->homog;
1002
1003  // strat->posInT = posInT_pLength;
1004  kTest_TS(strat);
1005
1006#ifdef KDEBUG
1007#if MYTEST
1008  if (TEST_OPT_DEBUG)
1009  {
1010    PrintS("bba start GB: currRing: ");
1011    // rWrite(currRing);PrintLn();
1012    rDebugPrint(currRing);
1013    PrintLn();
1014  }
1015#endif /* MYTEST */
1016#endif /* KDEBUG */
1017
1018#ifdef HAVE_TAIL_RING
1019  if(!idIs0(F) &&(!rField_is_Ring()))  // create strong gcd poly computes with tailring and S[i] ->to be fixed
1020    kStratInitChangeTailRing(strat);
1021#endif
1022  if (BVERBOSE(23))
1023  {
1024    if (test_PosInT!=NULL) strat->posInT=test_PosInT;
1025    if (test_PosInL!=NULL) strat->posInL=test_PosInL;
1026    kDebugPrint(strat);
1027  }
1028
1029
1030#ifdef KDEBUG
1031  //kDebugPrint(strat);
1032#endif
1033  /* compute------------------------------------------------------- */
1034  while (strat->Ll >= 0)
1035  {
1036    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1037    #ifdef KDEBUG
1038      loop_count++;
1039      if (TEST_OPT_DEBUG) messageSets(strat);
1040    #endif
1041    if (strat->Ll== 0) strat->interpt=TRUE;
1042    if (TEST_OPT_DEGBOUND
1043        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1044            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1045    {
1046      /*
1047       *stops computation if
1048       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1049       *a predefined number Kstd1_deg
1050       */
1051      while ((strat->Ll >= 0)
1052        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1053        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1054            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1055        )
1056        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1057      if (strat->Ll<0) break;
1058      else strat->noClearS=TRUE;
1059    }
1060    /* picks the last element from the lazyset L */
1061    strat->P = strat->L[strat->Ll];
1062    strat->Ll--;
1063
1064    if (pNext(strat->P.p) == strat->tail)
1065    {
1066      // deletes the short spoly
1067#ifdef HAVE_RINGS
1068      if (rField_is_Ring(currRing))
1069        pLmDelete(strat->P.p);
1070      else
1071#endif
1072        pLmFree(strat->P.p);
1073      strat->P.p = NULL;
1074      poly m1 = NULL, m2 = NULL;
1075
1076      // check that spoly creation is ok
1077      while (strat->tailRing != currRing &&
1078             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1079      {
1080        assume(m1 == NULL && m2 == NULL);
1081        // if not, change to a ring where exponents are at least
1082        // large enough
1083        if (!kStratChangeTailRing(strat))
1084        {
1085          WerrorS("OVERFLOW...");
1086          break;
1087        }
1088      }
1089      // create the real one
1090      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
1091                    strat->tailRing, m1, m2, strat->R);
1092    }
1093    else if (strat->P.p1 == NULL)
1094    {
1095      if (strat->minim > 0)
1096        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1097      // for input polys, prepare reduction
1098      strat->P.PrepareRed(strat->use_buckets);
1099    }
1100
1101    if (strat->P.p == NULL && strat->P.t_p == NULL)
1102    {
1103      red_result = 0;
1104    }
1105    else
1106    {
1107      if (TEST_OPT_PROT)
1108        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1109                &olddeg,&reduc,strat, red_result);
1110
1111      /* reduction of the element choosen from L */
1112      red_result = strat->red(&strat->P,strat);
1113      if (errorreported)  break;
1114    }
1115
1116    if (strat->overflow)
1117    {
1118        if (!kStratChangeTailRing(strat)) { Werror("OVERFLOW.."); break;}
1119    }
1120
1121    // reduction to non-zero new poly
1122    if (red_result == 1)
1123    {
1124      // get the polynomial (canonicalize bucket, make sure P.p is set)
1125      strat->P.GetP(strat->lmBin);
1126      // in the homogeneous case FDeg >= pFDeg (sugar/honey)
1127      // but now, for entering S, T, we reset it
1128      // in the inhomogeneous case: FDeg == pFDeg
1129      if (strat->homog) strat->initEcart(&(strat->P));
1130
1131      /* statistic */
1132      if (TEST_OPT_PROT) PrintS("s");
1133
1134      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1135
1136#ifdef KDEBUG
1137#if MYTEST
1138      PrintS("New S: "); pDebugPrint(strat->P.p); PrintLn();
1139#endif /* MYTEST */
1140#endif /* KDEBUG */
1141
1142      // reduce the tail and normalize poly
1143      // in the ring case we cannot expect LC(f) = 1,
1144      // therefore we call pContent instead of pNorm
1145      if ((TEST_OPT_INTSTRATEGY) || (rField_is_Ring(currRing)))
1146      {
1147        strat->P.pCleardenom();
1148        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1149        {
1150          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1151          strat->P.pCleardenom();
1152        }
1153      }
1154      else
1155      {
1156        strat->P.pNorm();
1157        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1158          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1159      }
1160
1161#ifdef KDEBUG
1162      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1163#if MYTEST
1164      PrintS("New (reduced) S: "); pDebugPrint(strat->P.p); PrintLn();
1165#endif /* MYTEST */
1166#endif /* KDEBUG */
1167
1168      // min_std stuff
1169      if ((strat->P.p1==NULL) && (strat->minim>0))
1170      {
1171        if (strat->minim==1)
1172        {
1173          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1174          p_Delete(&strat->P.p2, currRing, strat->tailRing);
1175        }
1176        else
1177        {
1178          strat->M->m[minimcnt]=strat->P.p2;
1179          strat->P.p2=NULL;
1180        }
1181        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1182          pNext(strat->M->m[minimcnt])
1183            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1184                                           strat->tailRing, currRing,
1185                                           currRing->PolyBin);
1186        minimcnt++;
1187      }
1188
1189      // enter into S, L, and T
1190      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1191        enterT(strat->P, strat);
1192#ifdef HAVE_RINGS
1193      if (rField_is_Ring(currRing))
1194        superenterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1195      else
1196#endif
1197        enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1198      // posInS only depends on the leading term
1199      strat->enterS(strat->P, pos, strat, strat->tl);
1200#if 0
1201      int pl=pLength(strat->P.p);
1202      if (pl==1)
1203      {
1204        //if (TEST_OPT_PROT)
1205        //PrintS("<1>");
1206      }
1207      else if (pl==2)
1208      {
1209        //if (TEST_OPT_PROT)
1210        //PrintS("<2>");
1211      }
1212#endif
1213      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1214//      Print("[%d]",hilbeledeg);
1215      if (strat->P.lcm!=NULL)
1216#ifdef HAVE_RINGS
1217        pLmDelete(strat->P.lcm);
1218#else
1219        pLmFree(strat->P.lcm);
1220#endif
1221      if (strat->sl>srmax) srmax = strat->sl;
1222    }
1223    else if (strat->P.p1 == NULL && strat->minim > 0)
1224    {
1225      p_Delete(&strat->P.p2, currRing, strat->tailRing);
1226    }
1227
1228#ifdef KDEBUG
1229    memset(&(strat->P), 0, sizeof(strat->P));
1230#endif /* KDEBUG */
1231    kTest_TS(strat);
1232  }
1233#ifdef KDEBUG
1234#if MYTEST
1235  PrintS("bba finish GB: currRing: "); rWrite(currRing);
1236#endif /* MYTEST */
1237  if (TEST_OPT_DEBUG) messageSets(strat);
1238#endif /* KDEBUG */
1239
1240  if (TEST_OPT_SB_1)
1241  {
1242    int k=1;
1243    int j;
1244    while(k<=strat->sl)
1245    {
1246      j=0;
1247      loop
1248      {
1249        if (j>=k) break;
1250        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1251        j++;
1252      }
1253      k++;
1254    }
1255  }
1256
1257  /* complete reduction of the standard basis--------- */
1258  if (TEST_OPT_REDSB)
1259  {
1260    completeReduce(strat);
1261#ifdef HAVE_TAIL_RING
1262    if (strat->completeReduce_retry)
1263    {
1264      // completeReduce needed larger exponents, retry
1265      // to reduce with S (instead of T)
1266      // and in currRing (instead of strat->tailRing)
1267      cleanT(strat);strat->tailRing=currRing;
1268      int i;
1269      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1270      completeReduce(strat);
1271    }
1272#endif
1273  }
1274  else if (TEST_OPT_PROT) PrintLn();
1275
1276  /* release temp data-------------------------------- */
1277  exitBuchMora(strat);
1278  if (TEST_OPT_WEIGHTM)
1279  {
1280    pRestoreDegProcs(pFDegOld, pLDegOld);
1281    if (ecartWeights)
1282    {
1283      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1284      ecartWeights=NULL;
1285    }
1286  }
1287  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1288  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1289
1290#ifdef KDEBUG
1291#if MYTEST
1292  PrintS("bba_end: currRing: "); rWrite(currRing);
1293#endif /* MYTEST */
1294#endif /* KDEBUG */
1295  idTest(strat->Shdl);
1296
1297  return (strat->Shdl);
1298}
1299
1300poly kNF2 (ideal F,ideal Q,poly q,kStrategy strat, int lazyReduce)
1301{
1302  assume(q!=NULL);
1303  assume(!(idIs0(F)&&(Q==NULL))); // NF(q, std(0) in polynomial ring?
1304
1305// lazy_reduce flags: can be combined by |
1306//#define KSTD_NF_LAZY   1
1307  // do only a reduction of the leading term
1308//#define KSTD_NF_NONORM 4
1309  // only global: avoid normalization, return a multiply of NF
1310  poly   p;
1311  int   i;
1312
1313  //if ((idIs0(F))&&(Q==NULL))
1314  //  return pCopy(q); /*F=0*/
1315  //strat->ak = idRankFreeModule(F);
1316  /*- creating temp data structures------------------- -*/
1317  BITSET save_test=test;
1318  test|=Sy_bit(OPT_REDTAIL);
1319  initBuchMoraCrit(strat);
1320  strat->initEcart = initEcartBBA;
1321  strat->enterS = enterSBba;
1322#ifndef NO_BUCKETS
1323  strat->use_buckets = (!TEST_OPT_NOT_BUCKETS) && (!rIsPluralRing(currRing));
1324#endif
1325  /*- set S -*/
1326  strat->sl = -1;
1327  /*- init local data struct.---------------------------------------- -*/
1328  /*Shdl=*/initS(F,Q,strat);
1329  /*- compute------------------------------------------------------- -*/
1330  //if ((TEST_OPT_INTSTRATEGY)&&(lazyReduce==0))
1331  //{
1332  //  for (i=strat->sl;i>=0;i--)
1333  //    pNorm(strat->S[i]);
1334  //}
1335  kTest(strat);
1336  if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
1337  if (BVERBOSE(23)) kDebugPrint(strat);
1338  int max_ind;
1339  p = redNF(pCopy(q),max_ind,lazyReduce & KSTD_NF_NONORM,strat);
1340  if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
1341  {
1342    if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
1343    #ifdef HAVE_RINGS
1344    if (rField_is_Ring())
1345    {
1346      p = redtailBba_Z(p,max_ind,strat);
1347    }
1348    else
1349    #endif
1350    {
1351      BITSET save=test;
1352      test &= ~Sy_bit(OPT_INTSTRATEGY);
1353      p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
1354      test=save;
1355    }
1356  }
1357  /*- release temp data------------------------------- -*/
1358  omfree(strat->sevS);
1359  omfree(strat->ecartS);
1360  omfree(strat->T);
1361  omfree(strat->sevT);
1362  omfree(strat->R);
1363  omfree(strat->S_2_R);
1364  omfree(strat->L);
1365  omfree(strat->B);
1366  omfree(strat->fromQ);
1367  idDelete(&strat->Shdl);
1368  test=save_test;
1369  if (TEST_OPT_PROT) PrintLn();
1370  return p;
1371}
1372
1373ideal kNF2 (ideal F,ideal Q,ideal q,kStrategy strat, int lazyReduce)
1374{
1375  assume(!idIs0(q));
1376  assume(!(idIs0(F)&&(Q==NULL)));
1377// lazy_reduce flags: can be combined by |
1378//#define KSTD_NF_LAZY   1
1379  // do only a reduction of the leading term
1380//#define KSTD_NF_NONORM 4
1381  // only global: avoid normalization, return a multiply of NF
1382  poly   p;
1383  int   i;
1384  ideal res;
1385  int max_ind;
1386
1387  //if (idIs0(q))
1388  //  return idInit(IDELEMS(q),si_max(q->rank,F->rank));
1389  //if ((idIs0(F))&&(Q==NULL))
1390  //  return idCopy(q); /*F=0*/
1391  //strat->ak = idRankFreeModule(F);
1392  /*- creating temp data structures------------------- -*/
1393  BITSET save_test=test;
1394  test|=Sy_bit(OPT_REDTAIL);
1395  initBuchMoraCrit(strat);
1396  strat->initEcart = initEcartBBA;
1397  strat->enterS = enterSBba;
1398  /*- set S -*/
1399  strat->sl = -1;
1400#ifndef NO_BUCKETS
1401  strat->use_buckets = (!TEST_OPT_NOT_BUCKETS) && (!rIsPluralRing(currRing));
1402#endif
1403  /*- init local data struct.---------------------------------------- -*/
1404  /*Shdl=*/initS(F,Q,strat);
1405  /*- compute------------------------------------------------------- -*/
1406  res=idInit(IDELEMS(q),si_max(q->rank,F->rank));
1407  BITSET save=test;
1408  test &= ~Sy_bit(OPT_INTSTRATEGY);
1409  for (i=IDELEMS(q)-1; i>=0; i--)
1410  {
1411    if (q->m[i]!=NULL)
1412    {
1413      if (TEST_OPT_PROT) { PrintS("r");mflush(); }
1414      p = redNF(pCopy(q->m[i]),max_ind,lazyReduce & KSTD_NF_NONORM,strat);
1415      if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
1416      {
1417        if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
1418        #ifdef HAVE_RINGS
1419        if (rField_is_Ring())
1420        {
1421          p = redtailBba_Z(p,max_ind,strat);
1422        }
1423        else
1424        #endif
1425        {
1426          p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
1427        }
1428      }
1429      res->m[i]=p;
1430    }
1431    //else
1432    //  res->m[i]=NULL;
1433  }
1434  /*- release temp data------------------------------- -*/
1435  test=save;
1436  omfree(strat->sevS);
1437  omfree(strat->ecartS);
1438  omfree(strat->T);
1439  omfree(strat->sevT);
1440  omfree(strat->R);
1441  omfree(strat->S_2_R);
1442  omfree(strat->L);
1443  omfree(strat->B);
1444  omfree(strat->fromQ);
1445  idDelete(&strat->Shdl);
1446  test=save_test;
1447  if (TEST_OPT_PROT) PrintLn();
1448  return res;
1449}
1450
1451/* shiftgb stuff */
1452#ifdef HAVE_SHIFTBBA
1453
1454
1455ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, int uptodeg, int lV)
1456{
1457#ifdef KDEBUG
1458  bba_count++;
1459  int loop_count = 0;
1460#endif
1461  om_Opts.MinTrack = 5;
1462  int   srmax,lrmax, red_result = 1;
1463  int   olddeg,reduc;
1464  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1465  BOOLEAN withT = TRUE; // very important for shifts
1466
1467  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit, NO CHANGES */
1468  initBuchMoraPos(strat); /*NO CHANGES YET: perhaps later*/
1469  initHilbCrit(F,Q,&hilb,strat); /*NO CHANGES*/
1470  initBbaShift(F,strat); /* DONE */
1471  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1472  /*Shdl=*/initBuchMoraShift(F, Q,strat); /* updateS with no toT, i.e. no init for T */
1473  updateSShift(strat,uptodeg,lV); /* initializes T */
1474
1475  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
1476  srmax = strat->sl;
1477  reduc = olddeg = lrmax = 0;
1478  strat->lV=lV;
1479
1480#ifndef NO_BUCKETS
1481  if (!TEST_OPT_NOT_BUCKETS)
1482    strat->use_buckets = 1;
1483#endif
1484
1485  // redtailBBa against T for inhomogenous input
1486  //  if (!TEST_OPT_OLDSTD)
1487  //    withT = ! strat->homog;
1488
1489  // strat->posInT = posInT_pLength;
1490  kTest_TS(strat);
1491
1492#ifdef HAVE_TAIL_RING
1493  kStratInitChangeTailRing(strat);
1494#endif
1495
1496  /* compute------------------------------------------------------- */
1497  while (strat->Ll >= 0)
1498  {
1499    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1500#ifdef KDEBUG
1501    loop_count++;
1502    if (TEST_OPT_DEBUG) messageSets(strat);
1503#endif
1504    if (strat->Ll== 0) strat->interpt=TRUE;
1505    if (TEST_OPT_DEGBOUND
1506        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1507            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1508    {
1509      /*
1510       *stops computation if
1511       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1512       *a predefined number Kstd1_deg
1513       */
1514      while ((strat->Ll >= 0)
1515        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1516        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1517            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1518        )
1519        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1520      if (strat->Ll<0) break;
1521      else strat->noClearS=TRUE;
1522    }
1523    /* picks the last element from the lazyset L */
1524    strat->P = strat->L[strat->Ll];
1525    strat->Ll--;
1526
1527    if (pNext(strat->P.p) == strat->tail)
1528    {
1529      // deletes the short spoly
1530      pLmFree(strat->P.p);
1531      strat->P.p = NULL;
1532      poly m1 = NULL, m2 = NULL;
1533
1534      // check that spoly creation is ok
1535      while (strat->tailRing != currRing &&
1536             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1537      {
1538        assume(m1 == NULL && m2 == NULL);
1539        // if not, change to a ring where exponents are at least
1540        // large enough
1541        kStratChangeTailRing(strat);
1542      }
1543      // create the real one
1544      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
1545                    strat->tailRing, m1, m2, strat->R);
1546    }
1547    else if (strat->P.p1 == NULL)
1548    {
1549      if (strat->minim > 0)
1550        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1551      // for input polys, prepare reduction
1552      strat->P.PrepareRed(strat->use_buckets);
1553    }
1554
1555    poly qq;
1556
1557    /* here in the nonhomog case we shrink the new spoly */
1558
1559    if ( ! strat->homog)
1560    {
1561      strat->P.GetP(strat->lmBin); // because shifts are counted with .p structure
1562      /* in the nonhomog case we have to shrink the polynomial */
1563      assume(strat->P.t_p!=NULL);
1564      qq = p_Shrink(strat->P.t_p, lV, strat->tailRing); // direct shrink
1565      if (qq != NULL)
1566      {
1567         /* we're here if Shrink is nonzero */
1568        //         strat->P.p =  NULL;
1569        //        strat->P.Delete(); /* deletes P.p and P.t_p */ //error
1570        strat->P.p   =  NULL; // is not set by Delete
1571        strat->P.t_p =  qq;
1572        strat->P.GetP(strat->lmBin);
1573        // update sev and length
1574        strat->initEcart(&(strat->P));
1575        strat->P.sev = pGetShortExpVector(strat->P.p);
1576//         strat->P.FDeg = strat->P.pFDeg();
1577//         strat->P.length = strat->P.pLDeg();
1578//         strat->P.pLength =strat->P.GetpLength(); //pLength(strat->P.p);
1579      }
1580      else
1581      {
1582         /* Shrink is zero, like y(1)*y(2) - y(1)*y(3)*/
1583#ifdef KDEBUG
1584         if (TEST_OPT_DEBUG){PrintS("nonzero s shrinks to 0");PrintLn();}
1585#endif
1586         //         strat->P.Delete();  // cause error
1587         strat->P.p = NULL;
1588         strat->P.t_p = NULL;
1589           //         strat->P.p = NULL; // or delete strat->P.p ?
1590       }
1591    }
1592      /* end shrinking poly in the nonhomog case */
1593
1594    if (strat->P.p == NULL && strat->P.t_p == NULL)
1595    {
1596      red_result = 0;
1597    }
1598    else
1599    {
1600      if (TEST_OPT_PROT)
1601        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1602                &olddeg,&reduc,strat, red_result);
1603
1604      /* reduction of the element choosen from L */
1605      red_result = strat->red(&strat->P,strat);
1606    }
1607
1608    // reduction to non-zero new poly
1609    if (red_result == 1)
1610    {
1611      /* statistic */
1612      if (TEST_OPT_PROT) PrintS("s");
1613
1614      // get the polynomial (canonicalize bucket, make sure P.p is set)
1615      strat->P.GetP(strat->lmBin);
1616
1617      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1618
1619      // reduce the tail and normalize poly
1620      if (TEST_OPT_INTSTRATEGY)
1621      {
1622        strat->P.pCleardenom();
1623        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1624        {
1625          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1626          strat->P.pCleardenom();
1627        }
1628      }
1629      else
1630      {
1631        strat->P.pNorm();
1632        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1633          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1634      }
1635
1636      // here we must shrink again! and optionally reduce again
1637      // or build shrink into redtailBba!
1638
1639#ifdef KDEBUG
1640      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1641#endif
1642
1643      // min_std stuff
1644      if ((strat->P.p1==NULL) && (strat->minim>0))
1645      {
1646        if (strat->minim==1)
1647        {
1648          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1649          p_Delete(&strat->P.p2, currRing, strat->tailRing);
1650        }
1651        else
1652        {
1653          strat->M->m[minimcnt]=strat->P.p2;
1654          strat->P.p2=NULL;
1655        }
1656        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1657          pNext(strat->M->m[minimcnt])
1658            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1659                                           strat->tailRing, currRing,
1660                                           currRing->PolyBin);
1661        minimcnt++;
1662      }
1663
1664    /* here in the nonhomog case we shrink the reduced poly AGAIN */
1665
1666    if ( ! strat->homog)
1667    {
1668      strat->P.GetP(strat->lmBin); // because shifts are counted with .p structure
1669      /* assume strat->P.t_p != NULL */
1670      /* in the nonhomog case we have to shrink the polynomial */
1671      assume(strat->P.t_p!=NULL); // poly qq defined above
1672      qq = p_Shrink(strat->P.t_p, lV, strat->tailRing); // direct shrink
1673      if (qq != NULL)
1674      {
1675         /* we're here if Shrink is nonzero */
1676        //         strat->P.p =  NULL;
1677        //        strat->P.Delete(); /* deletes P.p and P.t_p */ //error
1678        strat->P.p   =  NULL; // is not set by Delete
1679        strat->P.t_p =  qq;
1680        strat->P.GetP(strat->lmBin);
1681        // update sev and length
1682        strat->initEcart(&(strat->P));
1683        strat->P.sev = pGetShortExpVector(strat->P.p);
1684      }
1685      else
1686      {
1687         /* Shrink is zero, like y(1)*y(2) - y(1)*y(3)*/
1688#ifdef PDEBUG
1689         if (TEST_OPT_DEBUG){PrintS("nonzero s shrinks to 0");PrintLn();}
1690#endif
1691         //         strat->P.Delete();  // cause error
1692         strat->P.p = NULL;
1693         strat->P.t_p = NULL;
1694           //         strat->P.p = NULL; // or delete strat->P.p ?
1695         goto     red_shrink2zero;
1696       }
1697    }
1698      /* end shrinking poly AGAIN in the nonhomog case */
1699
1700
1701      // enter into S, L, and T
1702      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1703      //        enterT(strat->P, strat); // this was here before Shift stuff
1704      //enterTShift(LObject p, kStrategy strat, int atT, int uptodeg, int lV); // syntax
1705      // the default value for atT = -1 as in bba
1706      /*   strat->P.GetP(); */
1707      // because shifts are counted with .p structure // done before, but ?
1708      enterTShift(strat->P,strat,-1,uptodeg, lV);
1709      enterpairsShift(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl,uptodeg,lV);
1710      //      enterpairsShift(vw,strat->sl,strat->P.ecart,pos,strat, strat->tl,uptodeg,lV);
1711      // posInS only depends on the leading term
1712      strat->enterS(strat->P, pos, strat, strat->tl);
1713
1714      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1715//      Print("[%d]",hilbeledeg);
1716      if (strat->P.lcm!=NULL) pLmFree(strat->P.lcm);
1717      if (strat->sl>srmax) srmax = strat->sl;
1718    }
1719    else
1720    {
1721    red_shrink2zero:
1722      if (strat->P.p1 == NULL && strat->minim > 0)
1723      {
1724        p_Delete(&strat->P.p2, currRing, strat->tailRing);
1725      }
1726    }
1727#ifdef KDEBUG
1728    memset(&(strat->P), 0, sizeof(strat->P));
1729#endif
1730    kTest_TS(strat);
1731  }
1732#ifdef KDEBUG
1733  if (TEST_OPT_DEBUG) messageSets(strat);
1734#endif
1735  /* complete reduction of the standard basis--------- */
1736  /*  shift case: look for elt's in S such that they are divisible by elt in T */
1737  //  if (TEST_OPT_SB_1)
1738  if (TEST_OPT_REDSB)
1739  {
1740    int k=0;
1741    int j=-1;
1742    while(k<=strat->sl)
1743    {
1744//       loop
1745//       {
1746//         if (j>=k) break;
1747//         clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1748//         j++;
1749//       }
1750      LObject Ln (strat->S[k],currRing, strat->tailRing);
1751      Ln.SetShortExpVector();
1752      j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln, j+1);
1753      if (j<0) {  k++; j=-1;}
1754      else
1755      {
1756        if ( pLmCmp(strat->S[k],strat->T[j].p) == 0)
1757        {
1758          j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln, j+1);
1759          if (j<0) {  k++; j=-1;}
1760          else
1761          {
1762            deleteInS(k,strat);
1763          }
1764        }
1765        else
1766        {
1767          deleteInS(k,strat);
1768        }
1769      }
1770    }
1771  }
1772
1773  if (TEST_OPT_REDSB)
1774  {    completeReduce(strat, TRUE); //shift: withT = TRUE
1775    if (strat->completeReduce_retry)
1776    {
1777      // completeReduce needed larger exponents, retry
1778      // to reduce with S (instead of T)
1779      // and in currRing (instead of strat->tailRing)
1780      cleanT(strat);strat->tailRing=currRing;
1781      int i;
1782      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1783      completeReduce(strat, TRUE);
1784    }
1785  }
1786  else if (TEST_OPT_PROT) PrintLn();
1787
1788  /* release temp data-------------------------------- */
1789  exitBuchMora(strat);
1790  if (TEST_OPT_WEIGHTM)
1791  {
1792    pRestoreDegProcs(pFDegOld, pLDegOld);
1793    if (ecartWeights)
1794    {
1795      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1796      ecartWeights=NULL;
1797    }
1798  }
1799  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1800  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1801  return (strat->Shdl);
1802}
1803
1804
1805ideal freegb(ideal I, int uptodeg, int lVblock)
1806{
1807  /* todo main call */
1808
1809  /* assume: ring is prepared, ideal is copied into shifted ring */
1810  /* uptodeg and lVblock are correct - test them! */
1811
1812  /* check whether the ideal is in V */
1813
1814//  if (0)
1815  if (! ideal_isInV(I,lVblock) )
1816  {
1817    WerrorS("The input ideal contains incorrectly encoded elements! ");
1818    return(NULL);
1819  }
1820
1821  //  kStrategy strat = new skStrategy;
1822  /* ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, int uptodeg, int lV) */
1823  /* at the moment:
1824- no quotient (check)
1825- no *w, no *hilb
1826  */
1827  /* ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
1828     int newIdeal, intvec *vw) */
1829  ideal RS = kStdShift(I,NULL, testHomog, NULL,NULL,0,0,NULL, uptodeg, lVblock);
1830    //bbaShift(I,NULL, NULL, NULL, strat, uptodeg, lVblock);
1831  idSkipZeroes(RS);
1832  return(RS);
1833}
1834
1835/*2
1836*reduces h with elements from T choosing  the first possible
1837* element in t with respect to the given pDivisibleBy
1838*/
1839int redFirstShift (LObject* h,kStrategy strat)
1840{
1841  if (h->IsNull()) return 0;
1842
1843  int at, reddeg,d;
1844  int pass = 0;
1845  int j = 0;
1846
1847  if (! strat->homog)
1848  {
1849    d = h->GetpFDeg() + h->ecart;
1850    reddeg = strat->LazyDegree+d;
1851  }
1852  h->SetShortExpVector();
1853  loop
1854  {
1855    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
1856    if (j < 0)
1857    {
1858      h->SetDegStuffReturnLDeg(strat->LDegLast);
1859      return 1;
1860    }
1861
1862    if (!TEST_OPT_INTSTRATEGY)
1863      strat->T[j].pNorm();
1864#ifdef KDEBUG
1865    if (TEST_OPT_DEBUG)
1866    {
1867      PrintS("reduce ");
1868      h->wrp();
1869      PrintS(" with ");
1870      strat->T[j].wrp();
1871    }
1872#endif
1873    ksReducePoly(h, &(strat->T[j]), strat->kNoetherTail(), NULL, strat);
1874    if (!h->IsNull())
1875    {
1876      poly qq=p_Shrink(h->GetTP(),strat->lV,strat->tailRing);
1877      h->p=NULL;
1878      h->t_p=qq;
1879      if (qq!=NULL) h->GetP(strat->lmBin);
1880    }
1881
1882#ifdef KDEBUG
1883    if (TEST_OPT_DEBUG)
1884    {
1885      PrintS(" to ");
1886      wrp(h->p);
1887      PrintLn();
1888    }
1889#endif
1890    if (h->IsNull())
1891    {
1892      if (h->lcm!=NULL) pLmFree(h->lcm);
1893      h->Clear();
1894      return 0;
1895    }
1896    h->SetShortExpVector();
1897
1898#if 0
1899    if ((strat->syzComp!=0) && !strat->honey)
1900    {
1901      if ((strat->syzComp>0) &&
1902          (h->Comp() > strat->syzComp))
1903      {
1904        assume(h->MinComp() > strat->syzComp);
1905#ifdef KDEBUG
1906        if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
1907#endif
1908        if (strat->homog)
1909          h->SetDegStuffReturnLDeg(strat->LDegLast);
1910        return -2;
1911      }
1912    }
1913#endif
1914    if (!strat->homog)
1915    {
1916      if (!TEST_OPT_OLDSTD && strat->honey)
1917      {
1918        h->SetpFDeg();
1919        if (strat->T[j].ecart <= h->ecart)
1920          h->ecart = d - h->GetpFDeg();
1921        else
1922          h->ecart = d - h->GetpFDeg() + strat->T[j].ecart - h->ecart;
1923
1924        d = h->GetpFDeg() + h->ecart;
1925      }
1926      else
1927        d = h->SetDegStuffReturnLDeg(strat->LDegLast);
1928      /*- try to reduce the s-polynomial -*/
1929      pass++;
1930      /*
1931       *test whether the polynomial should go to the lazyset L
1932       *-if the degree jumps
1933       *-if the number of pre-defined reductions jumps
1934       */
1935      if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
1936          && ((d >= reddeg) || (pass > strat->LazyPass)))
1937      {
1938        h->SetLmCurrRing();
1939        if (strat->posInLDependsOnLength)
1940          h->SetLength(strat->length_pLength);
1941        at = strat->posInL(strat->L,strat->Ll,h,strat);
1942        if (at <= strat->Ll)
1943        {
1944          int dummy=strat->sl;
1945          /*          if (kFindDivisibleByInS(strat,&dummy, h) < 0) */
1946          if (kFindDivisibleByInT(strat->T,strat->sevT, dummy, h) < 0)
1947            return 1;
1948          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
1949#ifdef KDEBUG
1950          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
1951#endif
1952          h->Clear();
1953          return -1;
1954        }
1955      }
1956      if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
1957      {
1958        reddeg = d+1;
1959        Print(".%d",d);mflush();
1960      }
1961    }
1962  }
1963}
1964
1965void initBbaShift(ideal F,kStrategy strat)
1966{
1967  int i;
1968  idhdl h;
1969 /* setting global variables ------------------- */
1970  strat->enterS = enterSBba; /* remains as is, we change enterT! */
1971
1972  strat->red = redFirstShift; /* no redHomog ! */
1973
1974  if (pLexOrder && strat->honey)
1975    strat->initEcart = initEcartNormal;
1976  else
1977    strat->initEcart = initEcartBBA;
1978  if (strat->honey)
1979    strat->initEcartPair = initEcartPairMora;
1980  else
1981    strat->initEcartPair = initEcartPairBba;
1982  strat->kIdeal = NULL;
1983  //if (strat->ak==0) strat->kIdeal->rtyp=IDEAL_CMD;
1984  //else              strat->kIdeal->rtyp=MODUL_CMD;
1985  //strat->kIdeal->data=(void *)strat->Shdl;
1986  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1987  {
1988    //interred  machen   Aenderung
1989    pFDegOld=pFDeg;
1990    pLDegOld=pLDeg;
1991    //h=ggetid("ecart");
1992    //if ((h!=NULL) /*&& (IDTYP(h)==INTVEC_CMD)*/)
1993    //{
1994    //  ecartWeights=iv2array(IDINTVEC(h));
1995    //}
1996    //else
1997    {
1998      ecartWeights=(short *)omAlloc((pVariables+1)*sizeof(short));
1999      /*uses automatic computation of the ecartWeights to set them*/
2000      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
2001    }
2002    pRestoreDegProcs(totaldegreeWecart, maxdegreeWecart);
2003    if (TEST_OPT_PROT)
2004    {
2005      for(i=1; i<=pVariables; i++)
2006        Print(" %d",ecartWeights[i]);
2007      PrintLn();
2008      mflush();
2009    }
2010  }
2011}
2012#endif
Note: See TracBrowser for help on using the repository browser.