source: git/kernel/kstd2.cc @ 936551

spielwiese
Last change on this file since 936551 was 6ad5ce, checked in by Hans Schönemann <hannes@…>, 16 years ago
*hannes: buckets/normalize in redtailBba git-svn-id: file:///usr/local/Singular/svn/trunk@10665 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 49.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kstd2.cc,v 1.66 2008-04-04 10:30:09 Singular Exp $ */
5/*
6*  ABSTRACT -  Kernel: alg. of Buchberger
7*/
8
9// #define PDEBUG 2
10// define to enable tailRings
11#define HAVE_TAIL_RING
12// define if no buckets should be used
13// #define NO_BUCKETS
14
15#include "mod2.h"
16#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 redRing (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) pLmDelete(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#ifdef KDEBUG
385        if (TEST_OPT_DEBUG) Print(" ->L[%d]\n",at);
386#endif
387        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);     // NOT RING CHECKED OLIVER
388        h->Clear();
389        return -1;
390      }
391    }
392    else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d != reddeg))
393    {
394      Print(".%d",d);mflush();
395      reddeg = d;
396    }
397  }
398}
399#endif
400
401/*2
402*  reduction procedure for the homogeneous case
403*  and the case of a degree-ordering
404*/
405int redHomog (LObject* h,kStrategy strat)
406{
407  if (strat->tl<0) return 1;
408  //if (h->GetLmTailRing()==NULL) return 0; // HS: SHOULD NOT BE NEEDED!
409  assume(h->FDeg == h->pFDeg());
410
411  poly h_p;
412  int i,j,at,pass, ii;
413  unsigned long not_sev;
414  long reddeg,d;
415
416  pass = j = 0;
417  d = reddeg = h->GetpFDeg();
418  h->SetShortExpVector();
419  int li;
420  h_p = h->GetLmTailRing();
421  not_sev = ~ h->sev;
422  loop
423  {
424    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
425    if (j < 0) return 1;
426
427    li = strat->T[j].pLength;
428    ii = j;
429    /*
430     * the polynomial to reduce with (up to the moment) is;
431     * pi with length li
432     */
433    i = j;
434#if 1
435    if (TEST_OPT_LENGTH)
436    loop
437    {
438      /*- search the shortest possible with respect to length -*/
439      i++;
440      if (i > strat->tl)
441        break;
442      if (li<=1)
443        break;
444      if ((strat->T[i].pLength < li)
445         &&
446          p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i],
447                               h_p, not_sev, strat->tailRing))
448      {
449        /*
450         * the polynomial to reduce with is now;
451         */
452        li = strat->T[i].pLength;
453        ii = i;
454      }
455    }
456#endif
457
458    /*
459     * end of search: have to reduce with pi
460     */
461#ifdef KDEBUG
462    if (TEST_OPT_DEBUG)
463    {
464      PrintS("red:");
465      h->wrp();
466      PrintS(" with ");
467      strat->T[ii].wrp();
468    }
469#endif
470    assume(strat->fromT == FALSE);
471
472    ksReducePoly(h, &(strat->T[ii]), NULL, NULL, strat);
473
474#ifdef KDEBUG
475    if (TEST_OPT_DEBUG)
476    {
477      PrintS("\nto ");
478      h->wrp();
479      PrintLn();
480    }
481#endif
482
483    h_p = h->GetLmTailRing();
484    if (h_p == NULL)
485    {
486      if (h->lcm!=NULL) pLmFree(h->lcm);
487#ifdef KDEBUG
488      h->lcm=NULL;
489#endif
490      return 0;
491    }
492    h->SetShortExpVector();
493    not_sev = ~ h->sev;
494    /*
495     * try to reduce the s-polynomial h
496     *test first whether h should go to the lazyset L
497     *-if the degree jumps
498     *-if the number of pre-defined reductions jumps
499     */
500    pass++;
501    if (!K_TEST_OPT_REDTHROUGH && (strat->Ll >= 0) && (pass > strat->LazyPass))
502    {
503      h->SetLmCurrRing();
504      at = strat->posInL(strat->L,strat->Ll,h,strat);
505      if (at <= strat->Ll)
506      {
507        int dummy=strat->sl;
508        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
509          return 1;
510        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
511#ifdef KDEBUG
512        if (TEST_OPT_DEBUG)
513          Print(" lazy: -> L%d\n",at);
514#endif
515        h->Clear();
516        return -1;
517      }
518    }
519  }
520}
521
522/*2
523*  reduction procedure for the inhomogeneous case
524*  and not a degree-ordering
525*/
526int redLazy (LObject* h,kStrategy strat)
527{
528  if (strat->tl<0) return 1;
529  int at,d,i,ii,li;
530  int j = 0;
531  int pass = 0;
532  assume(h->pFDeg() == h->FDeg);
533  long reddeg = h->GetpFDeg();
534  unsigned long not_sev;
535
536  h->SetShortExpVector();
537  poly h_p = h->GetLmTailRing();
538  not_sev = ~ h->sev;
539  loop
540  {
541    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
542    if (j < 0) return 1;
543
544    li = strat->T[j].pLength;
545    #if 0
546    if (li==0)
547    {
548      li=strat->T[j].pLength=pLength(strat->T[j].p);
549    }
550    #endif
551    ii = j;
552    /*
553     * the polynomial to reduce with (up to the moment) is;
554     * pi with length li
555     */
556
557    i = j;
558#if 1
559    if (TEST_OPT_LENGTH)
560    loop
561    {
562      /*- search the shortest possible with respect to length -*/
563      i++;
564      if (i > strat->tl)
565        break;
566      if (li<=1)
567        break;
568    #if 0
569      if (strat->T[i].pLength==0)
570      {
571        PrintS("!");
572        strat->T[i].pLength=pLength(strat->T[i].p);
573      }
574   #endif
575      if ((strat->T[i].pLength < li)
576         &&
577          p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i],
578                               h_p, not_sev, strat->tailRing))
579      {
580        /*
581         * the polynomial to reduce with is now;
582         */
583        PrintS("+");
584        li = strat->T[i].pLength;
585        ii = i;
586      }
587    }
588#endif
589
590    /*
591     * end of search: have to reduce with pi
592     */
593
594
595#ifdef KDEBUG
596    if (TEST_OPT_DEBUG)
597    {
598      PrintS("red:");
599      h->wrp();
600      PrintS(" with ");
601      strat->T[ii].wrp();
602    }
603#endif
604
605    ksReducePoly(h, &(strat->T[ii]), NULL, NULL, strat);
606
607#ifdef KDEBUG
608    if (TEST_OPT_DEBUG)
609    {
610      PrintS("\nto ");
611      h->wrp();
612      PrintLn();
613    }
614#endif
615
616    h_p=h->GetLmTailRing();
617
618    if (h_p == NULL)
619    {
620      if (h->lcm!=NULL) pLmFree(h->lcm);
621#ifdef KDEBUG
622      h->lcm=NULL;
623#endif
624      return 0;
625    }
626    h->SetShortExpVector();
627    not_sev = ~ h->sev;
628    d = h->SetpFDeg();
629    /*- try to reduce the s-polynomial -*/
630    pass++;
631    if (//!K_TEST_OPT_REDTHROUGH &&
632        (strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
633    {
634      h->SetLmCurrRing();
635      at = strat->posInL(strat->L,strat->Ll,h,strat);
636      if (at <= strat->Ll)
637      {
638#if 1
639        int dummy=strat->sl;
640        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
641          return 1;
642#endif
643#ifdef KDEBUG
644        if (TEST_OPT_DEBUG) Print(" ->L[%d]\n",at);
645#endif
646        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
647        h->Clear();
648        return -1;
649      }
650    }
651    else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d != reddeg))
652    {
653      Print(".%d",d);mflush();
654      reddeg = d;
655    }
656  }
657}
658/*2
659*  reduction procedure for the sugar-strategy (honey)
660* reduces h with elements from T choosing first possible
661* element in T with respect to the given ecart
662*/
663int redHoney (LObject* h, kStrategy strat)
664{
665  if (strat->tl<0) return 1;
666  //if (h->GetLmTailRing()==NULL) return 0; // HS: SHOULD NOT BE NEEDED!
667  assume(h->FDeg == h->pFDeg());
668
669  poly h_p;
670  int i,j,at,pass,ei, ii, h_d;
671  unsigned long not_sev;
672  long reddeg,d;
673
674  pass = j = 0;
675  d = reddeg = h->GetpFDeg() + h->ecart;
676  h->SetShortExpVector();
677  int li;
678  h_p = h->GetLmTailRing();
679  not_sev = ~ h->sev;
680  loop
681  {
682    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
683    if (j < 0) return 1;
684
685    ei = strat->T[j].ecart;
686    li = strat->T[j].pLength;
687    #if 0
688    if (li==0)
689    {
690       //PrintS("!");
691       li=strat->T[j].pLength=pLength(strat->T[j].p);
692    }
693    #endif
694    ii = j;
695    /*
696     * the polynomial to reduce with (up to the moment) is;
697     * pi with ecart ei
698     */
699    i = j;
700    if (TEST_OPT_LENGTH)
701    loop
702    {
703      /*- takes the first possible with respect to ecart -*/
704      i++;
705      if (i > strat->tl)
706        break;
707      //if (ei < h->ecart)
708      //  break;
709      if (li<=1)
710        break;
711      if ((((strat->T[i].ecart < ei) && (ei> h->ecart))
712         || ((strat->T[i].ecart <= h->ecart) && (strat->T[i].pLength < li)))
713         &&
714          p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i],
715                               h_p, not_sev, strat->tailRing))
716      {
717        /*
718         * the polynomial to reduce with is now;
719         */
720        ei = strat->T[i].ecart;
721        li = strat->T[i].pLength;
722        ii = i;
723      }
724    }
725
726    /*
727     * end of search: have to reduce with pi
728     */
729    if (!K_TEST_OPT_REDTHROUGH && (pass!=0) && (ei > h->ecart))
730    {
731      h->SetLmCurrRing();
732      /*
733       * It is not possible to reduce h with smaller ecart;
734       * if possible h goes to the lazy-set L,i.e
735       * if its position in L would be not the last one
736       */
737      if (strat->Ll >= 0) /* L is not empty */
738      {
739        at = strat->posInL(strat->L,strat->Ll,h,strat);
740        if(at <= strat->Ll)
741          /*- h will not become the next element to reduce -*/
742        {
743          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
744#ifdef KDEBUG
745          if (TEST_OPT_DEBUG) Print(" ecart too big: -> L%d\n",at);
746#endif
747          h->Clear();
748          return -1;
749        }
750      }
751    }
752#ifdef KDEBUG
753    if (TEST_OPT_DEBUG)
754    {
755      PrintS("red:");
756      h->wrp();
757      PrintS(" with ");
758      strat->T[ii].wrp();
759    }
760#endif
761    assume(strat->fromT == FALSE);
762
763#if 0 // test poly exchange
764    if (strat->inStdFac==0)
765    {
766      int ll;
767      poly t_p;
768      if (strat->tailRing==currRing)
769        t_p=strat->T[ii].p;
770      else
771        t_p=strat->T[ii].t_p;
772      if ((p_LmCmp(h_p,t_p,strat->tailRing)==0)
773      && ((ll=h->GuessLength()) < strat->T[ii].pLength))
774      {
775        h->GetP();
776        if ((h->pLength=h->GetpLength()) < strat->T[ii].pLength)
777        {
778          if (TEST_OPT_PROT)  PrintS("e");
779          h->GetP();
780          if (h->p!=NULL)
781          {
782            if (strat->T[ii].p!=NULL)
783            {
784              poly swap;
785              omTypeAlloc0Bin(poly,swap,currRing->PolyBin);
786              memcpy(swap,h->p,currRing->PolyBin->sizeW*sizeof(long));
787              memcpy(h->p,strat->T[ii].p,currRing->PolyBin->sizeW*sizeof(long));
788              memcpy(strat->T[ii].p,swap,currRing->PolyBin->sizeW*sizeof(long));
789              omFreeBinAddr(swap);
790            }
791            else
792            {
793              strat->T[ii].p=h->p;
794              h->p=NULL;
795            }
796          }
797          else
798          {
799            if (strat->T[ii].p!=NULL)
800            {
801              h->p=strat->T[ii].p;
802              strat->T[ii].p=NULL;
803            }
804            // else: all NULL
805          }
806          if (h->t_p!=NULL)
807          {
808            if (strat->T[ii].t_p!=NULL)
809            {
810              poly swap;
811              omTypeAlloc0Bin(poly,swap,strat->tailRing->PolyBin);
812              memcpy(swap,h->t_p,strat->tailRing->PolyBin->sizeW*sizeof(long));
813              memcpy(h->t_p,strat->T[ii].t_p,strat->tailRing->PolyBin->sizeW*sizeof(long));
814              memcpy(strat->T[ii].t_p,swap,strat->tailRing->PolyBin->sizeW*sizeof(long));
815              omFreeBinAddr(swap);
816            }
817            else
818            {
819              strat->T[ii].t_p=h->t_p;
820              h->t_p=NULL;
821            }
822          }
823          else
824          {
825            if (strat->T[ii].t_p!=NULL)
826            {
827              h->t_p=strat->T[ii].t_p;
828              strat->T[ii].t_p=NULL;
829            }
830            // else: all NULL
831          }
832          if (strat->tailRing != currRing && (strat->T[ii].p != NULL)
833          && pNext(strat->T[ii].p) != NULL)
834             strat->T[ii].max =p_GetMaxExpP(pNext(strat->T[ii].p), strat->tailRing);
835          else
836             strat->T[ii].max = NULL;
837          h->length=h->pLength=pLength(h->p);
838          strat->T[ii].length=strat->T[ii].pLength=pLength(strat->T[ii].p);
839          if (strat->T[ii].is_normalized)
840          {
841            strat->T[ii].is_normalized=0;
842            strat->T[ii].pNorm();
843          }
844          else
845          {
846            if (TEST_OPT_INTSTRATEGY)
847              strat->T[ii].pCleardenom();
848          }
849          h->PrepareRed(strat->use_buckets);
850        }
851      }
852    }
853#endif // test poly exchange
854    ksReducePoly(h, &(strat->T[ii]), NULL, NULL, strat);
855
856#ifdef KDEBUG
857    if (TEST_OPT_DEBUG)
858    {
859      PrintS("\nto ");
860      h->wrp();
861      PrintLn();
862    }
863#endif
864
865    h_p = h->GetLmTailRing();
866    if (h_p == NULL)
867    {
868      if (h->lcm!=NULL) pLmFree(h->lcm);
869#ifdef KDEBUG
870      h->lcm=NULL;
871#endif
872      return 0;
873    }
874    h->SetShortExpVector();
875    not_sev = ~ h->sev;
876    h_d = h->SetpFDeg();
877    /* compute the ecart */
878    if (ei <= h->ecart)
879      h->ecart = d-h_d;
880    else
881      h->ecart = d-h_d+ei-h->ecart;
882    /*
883     * try to reduce the s-polynomial h
884     *test first whether h should go to the lazyset L
885     *-if the degree jumps
886     *-if the number of pre-defined reductions jumps
887     */
888    pass++;
889    d = h_d + h->ecart;
890    if (!K_TEST_OPT_REDTHROUGH && (strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
891    {
892      h->SetLmCurrRing();
893      at = strat->posInL(strat->L,strat->Ll,h,strat);
894      if (at <= strat->Ll)
895      {
896        int dummy=strat->sl;
897        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
898          return 1;
899        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
900#ifdef KDEBUG
901        if (TEST_OPT_DEBUG)
902          Print(" degree jumped: -> L%d\n",at);
903#endif
904        h->Clear();
905        return -1;
906      }
907    }
908    else if (TEST_OPT_PROT && (strat->Ll < 0) && (d > reddeg))
909    {
910      reddeg = d;
911      Print(".%d",d); mflush();
912    }
913  }
914}
915/*2
916*  reduction procedure for the normal form
917*/
918
919poly redNF (poly h,int &max_ind,kStrategy strat)
920{
921  if (h==NULL) return NULL;
922  int j;
923  max_ind=strat->sl;
924
925  if (0 > strat->sl)
926  {
927    return h;
928  }
929  LObject P(h);
930  P.SetShortExpVector();
931  P.bucket = kBucketCreate(currRing);
932  kBucketInit(P.bucket,P.p,pLength(P.p));
933  kbTest(P.bucket);
934  loop
935  {
936    j=kFindDivisibleByInS(strat,&max_ind,&P);
937    if (j>=0)
938    {
939      int sl=pSize(strat->S[j]);
940      int jj=j;
941      loop
942      {
943        int sll;
944        jj=kFindNextDivisibleByInS(strat,jj+1,max_ind,&P);
945        if (jj<0) break;
946        sll=pSize(strat->S[jj]);
947        if (sll<sl)
948        {
949          if (!nIsOne(pGetCoeff(strat->S[j])))
950          {
951            pNorm(strat->S[j]);
952            //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
953            sl=pSize(strat->S[j]);
954          }
955          if (!nIsOne(pGetCoeff(strat->S[jj])))
956          {
957            pNorm(strat->S[jj]);
958            //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
959            sll=pSize(strat->S[jj]);
960          }
961          if (sll<sl)
962          {
963            #ifdef KDEBUG
964            if (TEST_OPT_DEBUG) Print("better(S%d:%d -> S%d:%d)\n",j,sl,jj,sll);
965            #endif
966            //else if (TEST_OPT_PROT) { PrintS("b"); mflush(); }
967            j=jj;
968            sl=sll;
969          }
970        }
971      }
972      if (!nIsOne(pGetCoeff(strat->S[j])))
973      {
974        pNorm(strat->S[j]);
975        //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
976      }
977      nNormalize(pGetCoeff(P.p));
978#ifdef KDEBUG
979      if (TEST_OPT_DEBUG)
980      {
981        PrintS("red:");
982        wrp(h);
983        PrintS(" with ");
984        wrp(strat->S[j]);
985      }
986#endif
987#ifdef HAVE_PLURAL
988      if (rIsPluralRing(currRing))
989      {
990        number coef;
991        nc_kBucketPolyRed(P.bucket,strat->S[j],&coef);
992        nDelete(&coef);
993      }
994      else
995#endif
996      {
997        number coef;
998        coef=kBucketPolyRed(P.bucket,strat->S[j],pLength(strat->S[j]),strat->kNoether);
999        nDelete(&coef);
1000      }
1001      h = kBucketGetLm(P.bucket);   // FRAGE OLIVER
1002      if (h==NULL)
1003      {
1004        kBucketDestroy(&P.bucket);
1005        return NULL;
1006      }
1007      kbTest(P.bucket);
1008      P.p=h;
1009      P.t_p=NULL;
1010      P.SetShortExpVector();
1011#ifdef KDEBUG
1012      if (TEST_OPT_DEBUG)
1013      {
1014        PrintS("\nto:");
1015        wrp(h);
1016        PrintLn();
1017      }
1018#endif
1019    }
1020    else
1021    {
1022      P.p=kBucketClear(P.bucket);
1023      kBucketDestroy(&P.bucket);
1024      pNormalize(P.p);
1025      return P.p;
1026    }
1027  }
1028}
1029
1030#ifdef KDEBUG
1031static int bba_count = 0;
1032#endif
1033
1034ideal bba (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
1035{
1036#ifdef KDEBUG
1037  bba_count++;
1038  int loop_count = 0;
1039#endif
1040  om_Opts.MinTrack = 5;
1041  int   srmax,lrmax, red_result = 1;
1042  int   olddeg,reduc;
1043  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1044  BOOLEAN withT = FALSE;
1045
1046  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1047  initBuchMoraPos(strat);
1048  initHilbCrit(F,Q,&hilb,strat);
1049  initBba(F,strat);
1050  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1051  /*Shdl=*/initBuchMora(F, Q,strat);
1052  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
1053  srmax = strat->sl;
1054  reduc = olddeg = lrmax = 0;
1055
1056#ifndef NO_BUCKETS
1057  if (!TEST_OPT_NOT_BUCKETS)
1058    strat->use_buckets = 1;
1059#endif
1060
1061  // redtailBBa against T for inhomogenous input
1062  if (!K_TEST_OPT_OLDSTD)
1063    withT = ! strat->homog;
1064
1065  // strat->posInT = posInT_pLength;
1066  kTest_TS(strat);
1067
1068#ifdef HAVE_TAIL_RING
1069  kStratInitChangeTailRing(strat);
1070#endif
1071
1072  /* compute------------------------------------------------------- */
1073  while (strat->Ll >= 0)
1074  {
1075    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1076    #ifdef KDEBUG
1077      loop_count++;
1078      #ifdef HAVE_RINGS
1079        if (TEST_OPT_DEBUG) PrintS("--- next step ---\n");
1080      #endif
1081      if (TEST_OPT_DEBUG) messageSets(strat);
1082    #endif
1083    if (strat->Ll== 0) strat->interpt=TRUE;
1084    if (TEST_OPT_DEGBOUND
1085        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1086            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1087    {
1088      /*
1089       *stops computation if
1090       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1091       *a predefined number Kstd1_deg
1092       */
1093      while ((strat->Ll >= 0)
1094        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1095        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1096            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1097        )
1098        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1099      if (strat->Ll<0) break;
1100      else strat->noClearS=TRUE;
1101    }
1102    /* picks the last element from the lazyset L */
1103    strat->P = strat->L[strat->Ll];
1104    strat->Ll--;
1105
1106    if (pNext(strat->P.p) == strat->tail)
1107    {
1108      // deletes the short spoly
1109#ifdef HAVE_RINGS
1110      if (rField_is_Ring(currRing))
1111        pLmDelete(strat->P.p);
1112      else
1113#endif
1114        pLmFree(strat->P.p);
1115      strat->P.p = NULL;
1116      poly m1 = NULL, m2 = NULL;
1117
1118      // check that spoly creation is ok
1119      while (strat->tailRing != currRing &&
1120             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1121      {
1122        assume(m1 == NULL && m2 == NULL);
1123        // if not, change to a ring where exponents are at least
1124        // large enough
1125        kStratChangeTailRing(strat);
1126      }
1127      // create the real one
1128      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
1129                    strat->tailRing, m1, m2, strat->R);
1130    }
1131    else if (strat->P.p1 == NULL)
1132    {
1133      if (strat->minim > 0)
1134        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1135      // for input polys, prepare reduction
1136      strat->P.PrepareRed(strat->use_buckets);
1137    }
1138
1139    if (strat->P.p == NULL && strat->P.t_p == NULL)
1140    {
1141      red_result = 0;
1142    }
1143    else
1144    {
1145      if (TEST_OPT_PROT)
1146        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1147                &olddeg,&reduc,strat, red_result);
1148
1149      /* reduction of the element choosen from L */
1150      red_result = strat->red(&strat->P,strat);
1151    }
1152
1153    // reduction to non-zero new poly
1154    if (red_result == 1)
1155    {
1156      /* statistic */
1157      if (TEST_OPT_PROT) PrintS("s");
1158
1159      // get the polynomial (canonicalize bucket, make sure P.p is set)
1160      strat->P.GetP(strat->lmBin);
1161
1162      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1163
1164      // reduce the tail and normalize poly
1165      if (TEST_OPT_INTSTRATEGY)
1166      {
1167        strat->P.pCleardenom();
1168        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1169        {
1170          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1171          strat->P.pCleardenom();
1172        }
1173      }
1174      else
1175      {
1176        strat->P.pNorm();
1177        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1178          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1179      }
1180
1181#ifdef KDEBUG
1182      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1183#endif
1184
1185      // min_std stuff
1186      if ((strat->P.p1==NULL) && (strat->minim>0))
1187      {
1188        if (strat->minim==1)
1189        {
1190          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1191          p_Delete(&strat->P.p2, currRing, strat->tailRing);
1192        }
1193        else
1194        {
1195          strat->M->m[minimcnt]=strat->P.p2;
1196          strat->P.p2=NULL;
1197        }
1198        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1199          pNext(strat->M->m[minimcnt])
1200            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1201                                           strat->tailRing, currRing,
1202                                           currRing->PolyBin);
1203        minimcnt++;
1204      }
1205
1206      // enter into S, L, and T
1207      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1208        enterT(strat->P, strat);
1209#ifdef HAVE_RINGS
1210#ifdef HAVE_VANGB
1211      int at_R = strat->tl;
1212#endif
1213      if (rField_is_Ring(currRing))
1214        superenterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1215      else
1216#endif
1217        enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1218      // posInS only depends on the leading term
1219      if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1220      {
1221#ifdef HAVE_VANGB
1222      strat->enterS(strat->P, pos, strat, at_R);
1223#else
1224      strat->enterS(strat->P, pos, strat, strat->tl);
1225#endif
1226      }
1227      else
1228      {
1229      //  strat->P.Delete(); // syzComp test: it is in T
1230      }
1231#if 0
1232      int pl=pLength(strat->P.p);
1233      if (pl==1)
1234      {
1235        //if (TEST_OPT_PROT)
1236        //PrintS("<1>");
1237      }
1238      else if (pl==2)
1239      {
1240        //if (TEST_OPT_PROT)
1241        //PrintS("<2>");
1242      }
1243#endif
1244      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1245//      Print("[%d]",hilbeledeg);
1246      if (strat->P.lcm!=NULL)
1247#ifdef HAVE_RINGS
1248        pLmDelete(strat->P.lcm);
1249#else
1250        pLmFree(strat->P.lcm);
1251#endif
1252      if (strat->sl>srmax) srmax = strat->sl;
1253    }
1254    else if (strat->P.p1 == NULL && strat->minim > 0)
1255    {
1256      p_Delete(&strat->P.p2, currRing, strat->tailRing);
1257    }
1258
1259#ifdef KDEBUG
1260    memset(&(strat->P), 0, sizeof(strat->P));
1261#endif
1262    kTest_TS(strat);
1263  }
1264#ifdef KDEBUG
1265  if (TEST_OPT_DEBUG) messageSets(strat);
1266#endif
1267  /* complete reduction of the standard basis--------- */
1268  if (TEST_OPT_SB_1)
1269  {
1270    int k=1;
1271    int j;
1272    while(k<=strat->sl)
1273    {
1274      j=0;
1275      loop
1276      {
1277        if (j>=k) break;
1278        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1279        j++;
1280      }
1281      k++;
1282    }
1283  }
1284
1285  if (TEST_OPT_REDSB)
1286  {
1287    completeReduce(strat);
1288    if (strat->completeReduce_retry)
1289    {
1290      // completeReduce needed larger exponents, retry
1291      // to reduce with S (instead of T)
1292      // and in currRing (instead of strat->tailRing)
1293      cleanT(strat);strat->tailRing=currRing;
1294      int i;
1295      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1296      completeReduce(strat);
1297    }
1298  }
1299  else if (TEST_OPT_PROT) PrintLn();
1300
1301  /* release temp data-------------------------------- */
1302  exitBuchMora(strat);
1303  if (TEST_OPT_WEIGHTM)
1304  {
1305    pRestoreDegProcs(pFDegOld, pLDegOld);
1306    if (ecartWeights)
1307    {
1308      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1309      ecartWeights=NULL;
1310    }
1311  }
1312  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1313  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1314  return (strat->Shdl);
1315}
1316
1317poly kNF2 (ideal F,ideal Q,poly q,kStrategy strat, int lazyReduce)
1318{
1319  poly   p;
1320  int   i;
1321
1322  if ((idIs0(F))&&(Q==NULL))
1323    return pCopy(q); /*F=0*/
1324  strat->ak = idRankFreeModule(F);
1325  /*- creating temp data structures------------------- -*/
1326  BITSET save_test=test;
1327  test|=Sy_bit(OPT_REDTAIL);
1328  initBuchMoraCrit(strat);
1329  strat->initEcart = initEcartBBA;
1330  strat->enterS = enterSBba;
1331#ifndef NO_BUCKETS
1332  strat->use_buckets = (!TEST_OPT_NOT_BUCKETS) && (!rIsPluralRing(currRing));
1333#endif
1334  /*- set S -*/
1335  strat->sl = -1;
1336  /*- init local data struct.---------------------------------------- -*/
1337  /*Shdl=*/initS(F,Q,strat);
1338  /*- compute------------------------------------------------------- -*/
1339  //if ((TEST_OPT_INTSTRATEGY)&&(lazyReduce==0))
1340  //{
1341  //  for (i=strat->sl;i>=0;i--)
1342  //    pNorm(strat->S[i]);
1343  //}
1344  kTest(strat);
1345  if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
1346  int max_ind;
1347  p = redNF(pCopy(q),max_ind,strat);
1348  if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
1349  {
1350    BITSET save=test;
1351    test &= ~Sy_bit(OPT_INTSTRATEGY);
1352    if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
1353    p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
1354    test=save;
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  poly   p;
1375  int   i;
1376  ideal res;
1377  int max_ind;
1378
1379  if (idIs0(q))
1380    return idInit(IDELEMS(q),q->rank);
1381  if ((idIs0(F))&&(Q==NULL))
1382    return idCopy(q); /*F=0*/
1383  strat->ak = idRankFreeModule(F);
1384  /*- creating temp data structures------------------- -*/
1385  BITSET save_test=test;
1386  test|=Sy_bit(OPT_REDTAIL);
1387  initBuchMoraCrit(strat);
1388  strat->initEcart = initEcartBBA;
1389  strat->enterS = enterSBba;
1390  /*- set S -*/
1391  strat->sl = -1;
1392#ifndef NO_BUCKETS
1393  strat->use_buckets = (!TEST_OPT_NOT_BUCKETS) && (!rIsPluralRing(currRing));
1394#endif
1395  /*- init local data struct.---------------------------------------- -*/
1396  /*Shdl=*/initS(F,Q,strat);
1397  /*- compute------------------------------------------------------- -*/
1398  res=idInit(IDELEMS(q),q->rank);
1399  for (i=IDELEMS(q)-1; i>=0; i--)
1400  {
1401    if (q->m[i]!=NULL)
1402    {
1403      if (TEST_OPT_PROT) { PrintS("r");mflush(); }
1404      p = redNF(pCopy(q->m[i]),max_ind,strat);
1405      if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
1406      {
1407        BITSET save=test;
1408        test &= ~Sy_bit(OPT_INTSTRATEGY);
1409        if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
1410        p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
1411        test=save;
1412      }
1413      res->m[i]=p;
1414    }
1415    //else
1416    //  res->m[i]=NULL;
1417  }
1418  /*- release temp data------------------------------- -*/
1419  omfree(strat->sevS);
1420  omfree(strat->ecartS);
1421  omfree(strat->T);
1422  omfree(strat->sevT);
1423  omfree(strat->R);
1424  omfree(strat->S_2_R);
1425  omfree(strat->L);
1426  omfree(strat->B);
1427  omfree(strat->fromQ);
1428  idDelete(&strat->Shdl);
1429  test=save_test;
1430  if (TEST_OPT_PROT) PrintLn();
1431  return res;
1432}
1433
1434/* shiftgb stuff */
1435
1436
1437
1438ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, int uptodeg, int lV)
1439{
1440#ifdef KDEBUG
1441  bba_count++;
1442  int loop_count = 0;
1443#endif
1444  om_Opts.MinTrack = 5;
1445  int   srmax,lrmax, red_result = 1;
1446  int   olddeg,reduc;
1447  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1448  BOOLEAN withT = TRUE; // very important for shifts
1449
1450  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit, NO CHANGES */
1451  initBuchMoraPos(strat); /*NO CHANGES YET: perhaps later*/
1452  initHilbCrit(F,Q,&hilb,strat); /*NO CHANGES*/
1453  initBbaShift(F,strat); /* DONE */
1454  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1455  /*Shdl=*/initBuchMoraShift(F, Q,strat); /* updateS with no toT, i.e. no init for T */
1456  updateSShift(strat,uptodeg,lV); /* initializes T */
1457
1458  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
1459  srmax = strat->sl;
1460  reduc = olddeg = lrmax = 0;
1461
1462#ifndef NO_BUCKETS
1463  if (!TEST_OPT_NOT_BUCKETS)
1464    strat->use_buckets = 1;
1465#endif
1466
1467  // redtailBBa against T for inhomogenous input
1468  //  if (!K_TEST_OPT_OLDSTD)
1469  //    withT = ! strat->homog;
1470
1471  // strat->posInT = posInT_pLength;
1472  kTest_TS(strat);
1473
1474#ifdef HAVE_TAIL_RING
1475  kStratInitChangeTailRing(strat);
1476#endif
1477
1478  /* compute------------------------------------------------------- */
1479  while (strat->Ll >= 0)
1480  {
1481    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1482#ifdef KDEBUG
1483    loop_count++;
1484    if (TEST_OPT_DEBUG) messageSets(strat);
1485#endif
1486    if (strat->Ll== 0) strat->interpt=TRUE;
1487    if (TEST_OPT_DEGBOUND
1488        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1489            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1490    {
1491      /*
1492       *stops computation if
1493       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1494       *a predefined number Kstd1_deg
1495       */
1496      while ((strat->Ll >= 0)
1497        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1498        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1499            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1500        )
1501        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1502      if (strat->Ll<0) break;
1503      else strat->noClearS=TRUE;
1504    }
1505    /* picks the last element from the lazyset L */
1506    strat->P = strat->L[strat->Ll];
1507    strat->Ll--;
1508
1509    if (pNext(strat->P.p) == strat->tail)
1510    {
1511      // deletes the short spoly
1512      pLmFree(strat->P.p);
1513      strat->P.p = NULL;
1514      poly m1 = NULL, m2 = NULL;
1515
1516      // check that spoly creation is ok
1517      while (strat->tailRing != currRing &&
1518             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1519      {
1520        assume(m1 == NULL && m2 == NULL);
1521        // if not, change to a ring where exponents are at least
1522        // large enough
1523        kStratChangeTailRing(strat);
1524      }
1525      // create the real one
1526      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
1527                    strat->tailRing, m1, m2, strat->R);
1528    }
1529    else if (strat->P.p1 == NULL)
1530    {
1531      if (strat->minim > 0)
1532        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1533      // for input polys, prepare reduction
1534      strat->P.PrepareRed(strat->use_buckets);
1535    }
1536
1537    poly qq;
1538
1539    /* here in the nonhomog case we shrink the new spoly */
1540   
1541    if ( ! strat->homog)
1542    {
1543      strat->P.GetP(strat->lmBin); // because shifts are counted with .p structure
1544      /* assume strat->P.t_p != NULL */
1545      /* in the nonhomog case we have to shrink the polynomial */
1546      assume(strat->P.t_p!=NULL);
1547      qq = p_Shrink(strat->P.t_p, lV, strat->tailRing); // direct shrink
1548      if (qq != NULL)
1549      {
1550         /* we're here if Shrink is nonzero */
1551        //         strat->P.p =  NULL;
1552        //        strat->P.Delete(); /* deletes P.p and P.t_p */ //error
1553        strat->P.p   =  NULL; // is not set by Delete
1554        strat->P.t_p =  qq;
1555        strat->P.GetP(strat->lmBin);
1556        // update sev and length
1557        strat->initEcart(&(strat->P));
1558        strat->P.sev = pGetShortExpVector(strat->P.p);
1559//         strat->P.FDeg = strat->P.pFDeg();
1560//         strat->P.length = strat->P.pLDeg();
1561//         strat->P.pLength =strat->P.GetpLength(); //pLength(strat->P.p);
1562      }
1563      else
1564      {
1565         /* Shrink is zero, like y(1)*y(2) - y(1)*y(3)*/
1566#ifdef KDEBUG
1567         if (TEST_OPT_DEBUG){PrintS("nonzero s shrinks to 0");PrintLn();}
1568#endif
1569         //      strat->P.Delete();  // cause error
1570         strat->P.p = NULL;
1571         strat->P.t_p = NULL;
1572           //         strat->P.p = NULL; // or delete strat->P.p ?
1573       }
1574    }
1575      /* end shrinking poly in the nonhomog case */
1576
1577    if (strat->P.p == NULL && strat->P.t_p == NULL)
1578    {
1579      red_result = 0;
1580    }
1581    else
1582    {
1583      if (TEST_OPT_PROT)
1584        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1585                &olddeg,&reduc,strat, red_result);
1586
1587      /* reduction of the element choosen from L */
1588      red_result = strat->red(&strat->P,strat);
1589    }
1590
1591    // reduction to non-zero new poly
1592    if (red_result == 1)
1593    {
1594      /* statistic */
1595      if (TEST_OPT_PROT) PrintS("s");
1596
1597      // get the polynomial (canonicalize bucket, make sure P.p is set)
1598      strat->P.GetP(strat->lmBin);
1599
1600      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1601
1602      // reduce the tail and normalize poly
1603      if (TEST_OPT_INTSTRATEGY)
1604      {
1605        strat->P.pCleardenom();
1606        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1607        {
1608          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1609          strat->P.pCleardenom();
1610        }
1611      }
1612      else
1613      {
1614        strat->P.pNorm();
1615        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1616          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1617      }
1618
1619      // here we must shrink again! and optionally reduce again
1620      // or build shrink into redtailBba!
1621
1622#ifdef KDEBUG
1623      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1624#endif
1625
1626      // min_std stuff
1627      if ((strat->P.p1==NULL) && (strat->minim>0))
1628      {
1629        if (strat->minim==1)
1630        {
1631          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1632          p_Delete(&strat->P.p2, currRing, strat->tailRing);
1633        }
1634        else
1635        {
1636          strat->M->m[minimcnt]=strat->P.p2;
1637          strat->P.p2=NULL;
1638        }
1639        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1640          pNext(strat->M->m[minimcnt])
1641            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1642                                           strat->tailRing, currRing,
1643                                           currRing->PolyBin);
1644        minimcnt++;
1645      }
1646
1647    /* here in the nonhomog case we shrink the reduced poly AGAIN */
1648   
1649    if ( ! strat->homog)
1650    {
1651      strat->P.GetP(strat->lmBin); // because shifts are counted with .p structure
1652      /* assume strat->P.t_p != NULL */
1653      /* in the nonhomog case we have to shrink the polynomial */
1654      assume(strat->P.t_p!=NULL); // poly qq defined above
1655      qq = p_Shrink(strat->P.t_p, lV, strat->tailRing); // direct shrink
1656      if (qq != NULL)
1657      {
1658         /* we're here if Shrink is nonzero */
1659        //         strat->P.p =  NULL;
1660        //        strat->P.Delete(); /* deletes P.p and P.t_p */ //error
1661        strat->P.p   =  NULL; // is not set by Delete
1662        strat->P.t_p =  qq;
1663        strat->P.GetP(strat->lmBin);
1664        // update sev and length
1665        strat->initEcart(&(strat->P));
1666        strat->P.sev = pGetShortExpVector(strat->P.p);
1667      }
1668      else
1669      {
1670         /* Shrink is zero, like y(1)*y(2) - y(1)*y(3)*/
1671#ifdef PDEBUG
1672         if (TEST_OPT_DEBUG){PrintS("nonzero s shrinks to 0");PrintLn();}
1673#endif
1674         //      strat->P.Delete();  // cause error
1675         strat->P.p = NULL;
1676         strat->P.t_p = NULL;
1677           //         strat->P.p = NULL; // or delete strat->P.p ?
1678         goto     red_shrink2zero;
1679       }
1680    }
1681      /* end shrinking poly AGAIN in the nonhomog case */
1682
1683
1684      // enter into S, L, and T
1685      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1686      //        enterT(strat->P, strat); // this was here before Shift stuff
1687      //enterTShift(LObject p, kStrategy strat, int atT, int uptodeg, int lV); // syntax
1688      // the default value for atT = -1 as in bba
1689      /*   strat->P.GetP(); */ 
1690      // because shifts are counted with .p structure // done before, but ?
1691      enterTShift(strat->P,strat,-1,uptodeg, lV);
1692      enterpairsShift(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl,uptodeg,lV);
1693      //      enterpairsShift(vw,strat->sl,strat->P.ecart,pos,strat, strat->tl,uptodeg,lV);
1694      // posInS only depends on the leading term
1695      if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1696      {
1697        strat->enterS(strat->P, pos, strat, strat->tl);
1698      }
1699      else
1700      {
1701      //  strat->P.Delete(); // syzComp test: it is in T
1702      }
1703
1704      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1705//      Print("[%d]",hilbeledeg);
1706      if (strat->P.lcm!=NULL) pLmFree(strat->P.lcm);
1707      if (strat->sl>srmax) srmax = strat->sl;
1708    }
1709    else 
1710    {
1711    red_shrink2zero:
1712      if (strat->P.p1 == NULL && strat->minim > 0)
1713      {
1714        p_Delete(&strat->P.p2, currRing, strat->tailRing);
1715      }
1716    }
1717#ifdef KDEBUG
1718    memset(&(strat->P), 0, sizeof(strat->P));
1719#endif
1720    kTest_TS(strat);
1721  }
1722#ifdef KDEBUG
1723  if (TEST_OPT_DEBUG) messageSets(strat);
1724#endif
1725  /* complete reduction of the standard basis--------- */
1726  if (TEST_OPT_SB_1)
1727  {
1728    int k=1;
1729    int j;
1730    while(k<=strat->sl)
1731    {
1732      j=0;
1733      loop
1734      {
1735        if (j>=k) break;
1736        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1737        j++;
1738      }
1739      k++;
1740    }
1741  }
1742
1743  if (TEST_OPT_REDSB)
1744  {
1745    completeReduce(strat, TRUE); //shift: withT = TRUE
1746    if (strat->completeReduce_retry)
1747    {
1748      // completeReduce needed larger exponents, retry
1749      // to reduce with S (instead of T)
1750      // and in currRing (instead of strat->tailRing)
1751      cleanT(strat);strat->tailRing=currRing;
1752      int i;
1753      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1754      completeReduce(strat, TRUE);
1755    }
1756  }
1757  else if (TEST_OPT_PROT) PrintLn();
1758
1759  /* release temp data-------------------------------- */
1760  exitBuchMora(strat);
1761  if (TEST_OPT_WEIGHTM)
1762  {
1763    pRestoreDegProcs(pFDegOld, pLDegOld);
1764    if (ecartWeights)
1765    {
1766      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1767      ecartWeights=NULL;
1768    }
1769  }
1770  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1771  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1772  return (strat->Shdl);
1773}
1774
1775
1776ideal freegb(ideal I, int uptodeg, int lVblock)
1777{
1778  /* todo main call */
1779
1780  /* assume: ring is prepared, ideal is copied into shifted ring */
1781  /* uptodeg and lVblock are correct - test them! */
1782
1783  //  kStrategy strat = new skStrategy;
1784  /* ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, int uptodeg, int lV) */
1785  /* at the moment:
1786- no quotient (check)
1787- no *w, no *hilb
1788  */
1789  /* ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
1790     int newIdeal, intvec *vw) */
1791  ideal RS = kStdShift(I,NULL, testHomog, NULL,NULL,0,0,NULL, uptodeg, lVblock);
1792    //bbaShift(I,NULL, NULL, NULL, strat, uptodeg, lVblock);
1793  idSkipZeroes(RS);
1794  return(RS);
1795}
1796
1797/*2
1798*reduces h with elements from T choosing  the first possible
1799* element in t with respect to the given pDivisibleBy
1800*/
1801int redFirstShift (LObject* h,kStrategy strat)
1802{
1803  if (h->IsNull()) return 0;
1804
1805  int at, reddeg,d;
1806  int pass = 0;
1807  int j = 0;
1808
1809  if (! strat->homog)
1810  {
1811    d = h->GetpFDeg() + h->ecart;
1812    reddeg = strat->LazyDegree+d;
1813  }
1814  h->SetShortExpVector();
1815  loop
1816  {
1817    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
1818    if (j < 0)
1819    {
1820      h->SetDegStuffReturnLDeg(strat->LDegLast);
1821      return 1;
1822    }
1823
1824    if (!TEST_OPT_INTSTRATEGY)
1825      strat->T[j].pNorm();
1826#ifdef KDEBUG
1827    if (TEST_OPT_DEBUG)
1828    {
1829      PrintS("reduce ");
1830      h->wrp();
1831      PrintS(" with ");
1832      strat->T[j].wrp();
1833    }
1834#endif
1835    ksReducePoly(h, &(strat->T[j]), strat->kNoetherTail(), NULL, strat);
1836#ifdef KDEBUG
1837    if (TEST_OPT_DEBUG)
1838    {
1839      PrintS(" to ");
1840      wrp(h->p);
1841      PrintLn();
1842    }
1843#endif
1844    if (h->IsNull())
1845    {
1846      if (h->lcm!=NULL) pLmFree(h->lcm);
1847      h->Clear();
1848      return 0;
1849    }
1850    h->SetShortExpVector();
1851
1852#if 0
1853    if ((strat->syzComp!=0) && !strat->honey)
1854    {
1855      if ((strat->syzComp>0) &&
1856          (h->Comp() > strat->syzComp))
1857      {
1858        assume(h->MinComp() > strat->syzComp);
1859#ifdef KDEBUG
1860        if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
1861#endif
1862        if (strat->homog)
1863          h->SetDegStuffReturnLDeg(strat->LDegLast);
1864        return -2;
1865      }
1866    }
1867#endif
1868    if (!strat->homog)
1869    {
1870      if (!K_TEST_OPT_OLDSTD && strat->honey)
1871      {
1872        h->SetpFDeg();
1873        if (strat->T[j].ecart <= h->ecart)
1874          h->ecart = d - h->GetpFDeg();
1875        else
1876          h->ecart = d - h->GetpFDeg() + strat->T[j].ecart - h->ecart;
1877
1878        d = h->GetpFDeg() + h->ecart;
1879      }
1880      else
1881        d = h->SetDegStuffReturnLDeg(strat->LDegLast);
1882      /*- try to reduce the s-polynomial -*/
1883      pass++;
1884      /*
1885       *test whether the polynomial should go to the lazyset L
1886       *-if the degree jumps
1887       *-if the number of pre-defined reductions jumps
1888       */
1889      if (!K_TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
1890          && ((d >= reddeg) || (pass > strat->LazyPass)))
1891      {
1892        h->SetLmCurrRing();
1893        if (strat->posInLDependsOnLength)
1894          h->SetLength(strat->length_pLength);
1895        at = strat->posInL(strat->L,strat->Ll,h,strat);
1896        if (at <= strat->Ll)
1897        {
1898          int dummy=strat->sl;
1899          /*          if (kFindDivisibleByInS(strat,&dummy, h) < 0) */
1900          if (kFindDivisibleByInT(strat->T,strat->sevT, dummy, h) < 0)
1901            return 1;
1902          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
1903#ifdef KDEBUG
1904          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
1905#endif
1906          h->Clear();
1907          return -1;
1908        }
1909      }
1910      if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
1911      {
1912        reddeg = d+1;
1913        Print(".%d",d);mflush();
1914      }
1915    }
1916  }
1917}
1918
1919void initBbaShift(ideal F,kStrategy strat)
1920{
1921  int i;
1922  idhdl h;
1923 /* setting global variables ------------------- */
1924  strat->enterS = enterSBba; /* remains as is, we change enterT! */
1925
1926  strat->red = redFirstShift; /* no redHomog ! */
1927
1928  if (pLexOrder && strat->honey)
1929    strat->initEcart = initEcartNormal;
1930  else
1931    strat->initEcart = initEcartBBA;
1932  if (strat->honey)
1933    strat->initEcartPair = initEcartPairMora;
1934  else
1935    strat->initEcartPair = initEcartPairBba;
1936  strat->kIdeal = NULL;
1937  //if (strat->ak==0) strat->kIdeal->rtyp=IDEAL_CMD;
1938  //else              strat->kIdeal->rtyp=MODUL_CMD;
1939  //strat->kIdeal->data=(void *)strat->Shdl;
1940  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1941  {
1942    //interred  machen   Aenderung
1943    pFDegOld=pFDeg;
1944    pLDegOld=pLDeg;
1945    //h=ggetid("ecart");
1946    //if ((h!=NULL) /*&& (IDTYP(h)==INTVEC_CMD)*/)
1947    //{
1948    //  ecartWeights=iv2array(IDINTVEC(h));
1949    //}
1950    //else
1951    {
1952      ecartWeights=(short *)omAlloc((pVariables+1)*sizeof(short));
1953      /*uses automatic computation of the ecartWeights to set them*/
1954      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
1955    }
1956    pRestoreDegProcs(totaldegreeWecart, maxdegreeWecart);
1957    if (TEST_OPT_PROT)
1958    {
1959      for(i=1; i<=pVariables; i++)
1960        Print(" %d",ecartWeights[i]);
1961      PrintLn();
1962      mflush();
1963    }
1964  }
1965}
Note: See TracBrowser for help on using the repository browser.