source: git/kernel/kstd2.cc @ 1c473f

spielwiese
Last change on this file since 1c473f was 1c473f, checked in by Viktor Levandovskyy <levandov@…>, 16 years ago
*levandov: modifications of shift free gb git-svn-id: file:///usr/local/Singular/svn/trunk@10606 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 46.8 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kstd2.cc,v 1.63 2008-02-24 17:41:31 levandov 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  /*- set S -*/
1332  strat->sl = -1;
1333  /*- init local data struct.---------------------------------------- -*/
1334  /*Shdl=*/initS(F,Q,strat);
1335  /*- compute------------------------------------------------------- -*/
1336  //if ((TEST_OPT_INTSTRATEGY)&&(lazyReduce==0))
1337  //{
1338  //  for (i=strat->sl;i>=0;i--)
1339  //    pNorm(strat->S[i]);
1340  //}
1341  kTest(strat);
1342  if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
1343  int max_ind;
1344  p = redNF(pCopy(q),max_ind,strat);
1345  if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
1346  {
1347    BITSET save=test;
1348    test &= ~Sy_bit(OPT_INTSTRATEGY);
1349    if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
1350    p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
1351    test=save;
1352  }
1353  /*- release temp data------------------------------- -*/
1354  omfree(strat->sevS);
1355  omfree(strat->ecartS);
1356  omfree(strat->T);
1357  omfree(strat->sevT);
1358  omfree(strat->R);
1359  omfree(strat->S_2_R);
1360  omfree(strat->L);
1361  omfree(strat->B);
1362  omfree(strat->fromQ);
1363  idDelete(&strat->Shdl);
1364  test=save_test;
1365  if (TEST_OPT_PROT) PrintLn();
1366  return p;
1367}
1368
1369ideal kNF2 (ideal F,ideal Q,ideal q,kStrategy strat, int lazyReduce)
1370{
1371  poly   p;
1372  int   i;
1373  ideal res;
1374  int max_ind;
1375
1376  if (idIs0(q))
1377    return idInit(IDELEMS(q),q->rank);
1378  if ((idIs0(F))&&(Q==NULL))
1379    return idCopy(q); /*F=0*/
1380  strat->ak = idRankFreeModule(F);
1381  /*- creating temp data structures------------------- -*/
1382  BITSET save_test=test;
1383  test|=Sy_bit(OPT_REDTAIL);
1384  initBuchMoraCrit(strat);
1385  strat->initEcart = initEcartBBA;
1386  strat->enterS = enterSBba;
1387  /*- set S -*/
1388  strat->sl = -1;
1389  /*- init local data struct.---------------------------------------- -*/
1390  /*Shdl=*/initS(F,Q,strat);
1391  /*- compute------------------------------------------------------- -*/
1392  res=idInit(IDELEMS(q),q->rank);
1393  for (i=IDELEMS(q)-1; i>=0; i--)
1394  {
1395    if (q->m[i]!=NULL)
1396    {
1397      if (TEST_OPT_PROT) { PrintS("r");mflush(); }
1398      p = redNF(pCopy(q->m[i]),max_ind,strat);
1399      if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
1400      {
1401        BITSET save=test;
1402        test &= ~Sy_bit(OPT_INTSTRATEGY);
1403        if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
1404        p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
1405        test=save;
1406      }
1407      res->m[i]=p;
1408    }
1409    //else
1410    //  res->m[i]=NULL;
1411  }
1412  /*- release temp data------------------------------- -*/
1413  omfree(strat->sevS);
1414  omfree(strat->ecartS);
1415  omfree(strat->T);
1416  omfree(strat->sevT);
1417  omfree(strat->R);
1418  omfree(strat->S_2_R);
1419  omfree(strat->L);
1420  omfree(strat->B);
1421  omfree(strat->fromQ);
1422  idDelete(&strat->Shdl);
1423  test=save_test;
1424  if (TEST_OPT_PROT) PrintLn();
1425  return res;
1426}
1427
1428/* shiftgb stuff */
1429
1430
1431
1432ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, int uptodeg, int lV)
1433{
1434#ifdef KDEBUG
1435  bba_count++;
1436  int loop_count = 0;
1437#endif
1438  om_Opts.MinTrack = 5;
1439  int   srmax,lrmax, red_result = 1;
1440  int   olddeg,reduc;
1441  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1442  BOOLEAN withT = TRUE; //FALSE;
1443
1444  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit, NO CHANGES */
1445  initBuchMoraPos(strat); /*NO CHANGES YET: perhaps later*/
1446  initHilbCrit(F,Q,&hilb,strat); /*NO CHANGES*/
1447  initBbaShift(F,strat); /* DONE */
1448  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1449  /*Shdl=*/initBuchMoraShift(F, Q,strat); /* updateS with no toT, i.e. no init for T */
1450  updateSShift(strat,uptodeg,lV); /* initializes T */
1451
1452  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
1453  srmax = strat->sl;
1454  reduc = olddeg = lrmax = 0;
1455
1456#ifndef NO_BUCKETS
1457  if (!TEST_OPT_NOT_BUCKETS)
1458    strat->use_buckets = 1;
1459#endif
1460
1461  // redtailBBa against T for inhomogenous input
1462  //  if (!K_TEST_OPT_OLDSTD)
1463  //    withT = ! strat->homog;
1464
1465  // strat->posInT = posInT_pLength;
1466  kTest_TS(strat);
1467
1468#ifdef HAVE_TAIL_RING
1469  kStratInitChangeTailRing(strat);
1470#endif
1471
1472  /* compute------------------------------------------------------- */
1473  while (strat->Ll >= 0)
1474  {
1475    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1476#ifdef KDEBUG
1477    loop_count++;
1478    if (TEST_OPT_DEBUG) messageSets(strat);
1479#endif
1480    if (strat->Ll== 0) strat->interpt=TRUE;
1481    if (TEST_OPT_DEGBOUND
1482        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1483            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1484    {
1485      /*
1486       *stops computation if
1487       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1488       *a predefined number Kstd1_deg
1489       */
1490      while ((strat->Ll >= 0)
1491        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1492        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1493            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1494        )
1495        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1496      if (strat->Ll<0) break;
1497      else strat->noClearS=TRUE;
1498    }
1499    /* picks the last element from the lazyset L */
1500    strat->P = strat->L[strat->Ll];
1501    strat->Ll--;
1502
1503    if (pNext(strat->P.p) == strat->tail)
1504    {
1505      // deletes the short spoly
1506      pLmFree(strat->P.p);
1507      strat->P.p = NULL;
1508      poly m1 = NULL, m2 = NULL;
1509
1510      // check that spoly creation is ok
1511      while (strat->tailRing != currRing &&
1512             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1513      {
1514        assume(m1 == NULL && m2 == NULL);
1515        // if not, change to a ring where exponents are at least
1516        // large enough
1517        kStratChangeTailRing(strat);
1518      }
1519      // create the real one
1520      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
1521                    strat->tailRing, m1, m2, strat->R);
1522    }
1523    else if (strat->P.p1 == NULL)
1524    {
1525      if (strat->minim > 0)
1526        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1527      // for input polys, prepare reduction
1528      strat->P.PrepareRed(strat->use_buckets);
1529    }
1530
1531    if (strat->P.p == NULL && strat->P.t_p == NULL)
1532    {
1533      red_result = 0;
1534    }
1535    else
1536    {
1537      if (TEST_OPT_PROT)
1538        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1539                &olddeg,&reduc,strat, red_result);
1540
1541      /* reduction of the element choosen from L */
1542      red_result = strat->red(&strat->P,strat);
1543    }
1544
1545    // reduction to non-zero new poly
1546    if (red_result == 1)
1547    {
1548      /* statistic */
1549      if (TEST_OPT_PROT) PrintS("s");
1550
1551      // get the polynomial (canonicalize bucket, make sure P.p is set)
1552      strat->P.GetP(strat->lmBin);
1553
1554      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1555
1556      // reduce the tail and normalize poly
1557      if (TEST_OPT_INTSTRATEGY)
1558      {
1559        strat->P.pCleardenom();
1560        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1561        {
1562          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1563          strat->P.pCleardenom();
1564        }
1565      }
1566      else
1567      {
1568        strat->P.pNorm();
1569        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1570          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1571      }
1572
1573#ifdef KDEBUG
1574      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1575#endif
1576
1577      // min_std stuff
1578      if ((strat->P.p1==NULL) && (strat->minim>0))
1579      {
1580        if (strat->minim==1)
1581        {
1582          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1583          p_Delete(&strat->P.p2, currRing, strat->tailRing);
1584        }
1585        else
1586        {
1587          strat->M->m[minimcnt]=strat->P.p2;
1588          strat->P.p2=NULL;
1589        }
1590        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1591          pNext(strat->M->m[minimcnt])
1592            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1593                                           strat->tailRing, currRing,
1594                                           currRing->PolyBin);
1595        minimcnt++;
1596      }
1597
1598      // enter into S, L, and T
1599      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1600      //        enterT(strat->P, strat); // this was here before Shift stuff
1601      //enterTShift(LObject p, kStrategy strat, int atT, int uptodeg, int lV); // syntax
1602      // the default value for atT = -1 as in bba
1603      strat->P.GetP(); // because shifts are counted with .p structure
1604      enterTShift(strat->P,strat,-1,uptodeg, lV);
1605//       poly vw;
1606//       if (strat->P.t_p!=NULL)
1607//       {
1608//          vw = pCopyL2p(strat->P,strat);     
1609//       }
1610//       else
1611//       {
1612//          vw = pCopy(strat->P.p);
1613//       }
1614      enterpairsShift(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl,uptodeg,lV);
1615      //      enterpairsShift(vw,strat->sl,strat->P.ecart,pos,strat, strat->tl,uptodeg,lV);
1616      // delete vw ?
1617      // posInS only depends on the leading term
1618      if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1619      {
1620        strat->enterS(strat->P, pos, strat, strat->tl);
1621      }
1622      else
1623      {
1624      //  strat->P.Delete(); // syzComp test: it is in T
1625      }
1626      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1627//      Print("[%d]",hilbeledeg);
1628      if (strat->P.lcm!=NULL) pLmFree(strat->P.lcm);
1629      if (strat->sl>srmax) srmax = strat->sl;
1630    }
1631    else if (strat->P.p1 == NULL && strat->minim > 0)
1632    {
1633      p_Delete(&strat->P.p2, currRing, strat->tailRing);
1634    }
1635#ifdef KDEBUG
1636    memset(&(strat->P), 0, sizeof(strat->P));
1637#endif
1638    kTest_TS(strat);
1639  }
1640#ifdef KDEBUG
1641  if (TEST_OPT_DEBUG) messageSets(strat);
1642#endif
1643  /* complete reduction of the standard basis--------- */
1644  if (TEST_OPT_SB_1)
1645  {
1646    int k=1;
1647    int j;
1648    while(k<=strat->sl)
1649    {
1650      j=0;
1651      loop
1652      {
1653        if (j>=k) break;
1654        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1655        j++;
1656      }
1657      k++;
1658    }
1659  }
1660
1661  if (TEST_OPT_REDSB)
1662  {
1663    completeReduce(strat);
1664    if (strat->completeReduce_retry)
1665    {
1666      // completeReduce needed larger exponents, retry
1667      // to reduce with S (instead of T)
1668      // and in currRing (instead of strat->tailRing)
1669      cleanT(strat);strat->tailRing=currRing;
1670      int i;
1671      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1672      completeReduce(strat);
1673    }
1674  }
1675  else if (TEST_OPT_PROT) PrintLn();
1676
1677  /* release temp data-------------------------------- */
1678  exitBuchMora(strat);
1679  if (TEST_OPT_WEIGHTM)
1680  {
1681    pRestoreDegProcs(pFDegOld, pLDegOld);
1682    if (ecartWeights)
1683    {
1684      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1685      ecartWeights=NULL;
1686    }
1687  }
1688  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1689  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1690  return (strat->Shdl);
1691}
1692
1693
1694ideal freegb(ideal I, int uptodeg, int lVblock)
1695{
1696  /* todo main call */
1697
1698  /* assume: ring is prepared, ideal is copied into shifted ring */
1699  /* uptodeg and lVblock are correct - test them! */
1700
1701  //  kStrategy strat = new skStrategy;
1702  /* ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, int uptodeg, int lV) */
1703  /* at the moment:
1704- no quotient (check)
1705- no *w, no *hilb
1706  */
1707  /* ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
1708     int newIdeal, intvec *vw) */
1709  ideal RS = kStdShift(I,NULL, testHomog, NULL,NULL,0,0,NULL, uptodeg, lVblock);
1710    //bbaShift(I,NULL, NULL, NULL, strat, uptodeg, lVblock);
1711  idSkipZeroes(RS);
1712  return(RS);
1713}
1714
1715/*2
1716*reduces h with elements from T choosing  the first possible
1717* element in t with respect to the given pDivisibleBy
1718*/
1719int redFirstShift (LObject* h,kStrategy strat)
1720{
1721  if (h->IsNull()) return 0;
1722
1723  int at, reddeg,d;
1724  int pass = 0;
1725  int j = 0;
1726
1727  if (! strat->homog)
1728  {
1729    d = h->GetpFDeg() + h->ecart;
1730    reddeg = strat->LazyDegree+d;
1731  }
1732  h->SetShortExpVector();
1733  loop
1734  {
1735    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
1736    if (j < 0)
1737    {
1738      h->SetDegStuffReturnLDeg(strat->LDegLast);
1739      return 1;
1740    }
1741
1742    if (!TEST_OPT_INTSTRATEGY)
1743      strat->T[j].pNorm();
1744#ifdef KDEBUG
1745    if (TEST_OPT_DEBUG)
1746    {
1747      PrintS("reduce ");
1748      h->wrp();
1749      PrintS(" with ");
1750      strat->T[j].wrp();
1751    }
1752#endif
1753    ksReducePoly(h, &(strat->T[j]), strat->kNoetherTail(), NULL, strat);
1754#ifdef KDEBUG
1755    if (TEST_OPT_DEBUG)
1756    {
1757      PrintS(" to ");
1758      wrp(h->p);
1759      PrintLn();
1760    }
1761#endif
1762    if (h->IsNull())
1763    {
1764      if (h->lcm!=NULL) pLmFree(h->lcm);
1765      h->Clear();
1766      return 0;
1767    }
1768    h->SetShortExpVector();
1769
1770#if 0
1771    if ((strat->syzComp!=0) && !strat->honey)
1772    {
1773      if ((strat->syzComp>0) &&
1774          (h->Comp() > strat->syzComp))
1775      {
1776        assume(h->MinComp() > strat->syzComp);
1777#ifdef KDEBUG
1778        if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
1779#endif
1780        if (strat->homog)
1781          h->SetDegStuffReturnLDeg(strat->LDegLast);
1782        return -2;
1783      }
1784    }
1785#endif
1786    if (!strat->homog)
1787    {
1788      if (!K_TEST_OPT_OLDSTD && strat->honey)
1789      {
1790        h->SetpFDeg();
1791        if (strat->T[j].ecart <= h->ecart)
1792          h->ecart = d - h->GetpFDeg();
1793        else
1794          h->ecart = d - h->GetpFDeg() + strat->T[j].ecart - h->ecart;
1795
1796        d = h->GetpFDeg() + h->ecart;
1797      }
1798      else
1799        d = h->SetDegStuffReturnLDeg(strat->LDegLast);
1800      /*- try to reduce the s-polynomial -*/
1801      pass++;
1802      /*
1803       *test whether the polynomial should go to the lazyset L
1804       *-if the degree jumps
1805       *-if the number of pre-defined reductions jumps
1806       */
1807      if (!K_TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
1808          && ((d >= reddeg) || (pass > strat->LazyPass)))
1809      {
1810        h->SetLmCurrRing();
1811        if (strat->posInLDependsOnLength)
1812          h->SetLength(strat->length_pLength);
1813        at = strat->posInL(strat->L,strat->Ll,h,strat);
1814        if (at <= strat->Ll)
1815        {
1816          int dummy=strat->sl;
1817          /*          if (kFindDivisibleByInS(strat,&dummy, h) < 0) */
1818          if (kFindDivisibleByInT(strat->T,strat->sevT, dummy, h) < 0)
1819            return 1;
1820          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
1821#ifdef KDEBUG
1822          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
1823#endif
1824          h->Clear();
1825          return -1;
1826        }
1827      }
1828      if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
1829      {
1830        reddeg = d+1;
1831        Print(".%d",d);mflush();
1832      }
1833    }
1834  }
1835}
1836
1837void initBbaShift(ideal F,kStrategy strat)
1838{
1839  int i;
1840  idhdl h;
1841 /* setting global variables ------------------- */
1842  strat->enterS = enterSBba; /* remains as is, we change enterT! */
1843
1844  strat->red = redFirstShift; /* no redHomog ! */
1845
1846  if (pLexOrder && strat->honey)
1847    strat->initEcart = initEcartNormal;
1848  else
1849    strat->initEcart = initEcartBBA;
1850  if (strat->honey)
1851    strat->initEcartPair = initEcartPairMora;
1852  else
1853    strat->initEcartPair = initEcartPairBba;
1854  strat->kIdeal = NULL;
1855  //if (strat->ak==0) strat->kIdeal->rtyp=IDEAL_CMD;
1856  //else              strat->kIdeal->rtyp=MODUL_CMD;
1857  //strat->kIdeal->data=(void *)strat->Shdl;
1858  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1859  {
1860    //interred  machen   Aenderung
1861    pFDegOld=pFDeg;
1862    pLDegOld=pLDeg;
1863    //h=ggetid("ecart");
1864    //if ((h!=NULL) /*&& (IDTYP(h)==INTVEC_CMD)*/)
1865    //{
1866    //  ecartWeights=iv2array(IDINTVEC(h));
1867    //}
1868    //else
1869    {
1870      ecartWeights=(short *)omAlloc((pVariables+1)*sizeof(short));
1871      /*uses automatic computation of the ecartWeights to set them*/
1872      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
1873    }
1874    pRestoreDegProcs(totaldegreeWecart, maxdegreeWecart);
1875    if (TEST_OPT_PROT)
1876    {
1877      for(i=1; i<=pVariables; i++)
1878        Print(" %d",ecartWeights[i]);
1879      PrintLn();
1880      mflush();
1881    }
1882  }
1883}
Note: See TracBrowser for help on using the repository browser.