source: git/kernel/kstd2.cc @ af378f7

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