source: git/kernel/kstd2.cc @ 18ff4c

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