source: git/kernel/kstd2.cc @ 9127cc

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