source: git/kernel/kstd2.cc @ ca371d

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