source: git/kernel/kstd2.cc @ 08ab82

spielwiese
Last change on this file since 08ab82 was 08ab82, checked in by Hans Schönemann <hannes@…>, 16 years ago
*hannes: OPT_DEBUG git-svn-id: file:///usr/local/Singular/svn/trunk@10383 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 43.3 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kstd2.cc,v 1.56 2007-11-06 16:30:20 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            #ifdef KDEBUG
1050            if (TEST_OPT_DEBUG) Print("better(S%d:%d -> S%d:%d)\n",j,sl,jj,sll);
1051            #endif
1052            //else if (TEST_OPT_PROT) { PrintS("b"); mflush(); }
1053            j=jj;
1054            sl=sll;
1055          }
1056        }
1057      }
1058      if (!nIsOne(pGetCoeff(strat->S[j])))
1059      {
1060        pNorm(strat->S[j]);
1061        //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
1062      }
1063      nNormalize(pGetCoeff(P.p));
1064#ifdef KDEBUG
1065      if (TEST_OPT_DEBUG)
1066      {
1067        PrintS("red:");
1068        wrp(h);
1069        PrintS(" with ");
1070        wrp(strat->S[j]);
1071      }
1072#endif
1073#ifdef HAVE_PLURAL
1074      if (rIsPluralRing(currRing))
1075      {
1076        number coef;
1077        nc_kBucketPolyRed(P.bucket,strat->S[j],&coef);
1078        nDelete(&coef);
1079      }
1080      else
1081#endif
1082      {
1083        number coef;
1084        coef=kBucketPolyRed(P.bucket,strat->S[j],pLength(strat->S[j]),strat->kNoether);
1085        nDelete(&coef);
1086      }
1087      h = kBucketGetLm(P.bucket);   // FRAGE OLIVER
1088      if (h==NULL)
1089      {
1090        kBucketDestroy(&P.bucket);
1091        return NULL;
1092      }
1093      kbTest(P.bucket);
1094      P.p=h;
1095      P.t_p=NULL;
1096      P.SetShortExpVector();
1097#ifdef KDEBUG
1098      if (TEST_OPT_DEBUG)
1099      {
1100        PrintS("\nto:");
1101        wrp(h);
1102        PrintLn();
1103      }
1104#endif
1105    }
1106    else
1107    {
1108      P.p=kBucketClear(P.bucket);
1109      kBucketDestroy(&P.bucket);
1110      pNormalize(P.p);
1111      return P.p;
1112    }
1113  }
1114}
1115
1116#ifdef KDEBUG
1117static int bba_count = 0;
1118#endif
1119
1120ideal bba (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
1121{
1122#ifdef KDEBUG
1123  bba_count++;
1124  int loop_count = 0;
1125#endif
1126  om_Opts.MinTrack = 5;
1127  int   srmax,lrmax, red_result = 1;
1128  int   olddeg,reduc;
1129  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1130  BOOLEAN withT = FALSE;
1131
1132  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1133  initBuchMoraPos(strat);
1134  initHilbCrit(F,Q,&hilb,strat);
1135  initBba(F,strat);
1136  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1137  /*Shdl=*/initBuchMora(F, Q,strat);
1138  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
1139  srmax = strat->sl;
1140  reduc = olddeg = lrmax = 0;
1141
1142#ifndef NO_BUCKETS
1143  if (!TEST_OPT_NOT_BUCKETS)
1144    strat->use_buckets = 1;
1145#endif
1146
1147  // redtailBBa against T for inhomogenous input
1148  if (!K_TEST_OPT_OLDSTD)
1149    withT = ! strat->homog;
1150
1151  // strat->posInT = posInT_pLength;
1152  kTest_TS(strat);
1153
1154#ifdef HAVE_TAIL_RING
1155  kStratInitChangeTailRing(strat);
1156#endif
1157
1158  /* compute------------------------------------------------------- */
1159  while (strat->Ll >= 0)
1160  {
1161    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1162    #ifdef KDEBUG
1163      loop_count++;
1164      #ifdef HAVE_RINGS
1165        if (TEST_OPT_DEBUG) PrintS("--- next step ---\n");
1166      #endif
1167      if (TEST_OPT_DEBUG) messageSets(strat);
1168    #endif
1169    if (strat->Ll== 0) strat->interpt=TRUE;
1170    if (TEST_OPT_DEGBOUND
1171        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1172            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1173    {
1174      /*
1175       *stops computation if
1176       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1177       *a predefined number Kstd1_deg
1178       */
1179      while ((strat->Ll >= 0)
1180        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1181        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1182            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1183        )
1184        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1185      if (strat->Ll<0) break;
1186      else strat->noClearS=TRUE;
1187    }
1188    /* picks the last element from the lazyset L */
1189    strat->P = strat->L[strat->Ll];
1190    strat->Ll--;
1191
1192    if (pNext(strat->P.p) == strat->tail)
1193    {
1194      // deletes the short spoly
1195      pLmFree(strat->P.p);
1196      strat->P.p = NULL;
1197      poly m1 = NULL, m2 = NULL;
1198
1199      // check that spoly creation is ok
1200      while (strat->tailRing != currRing &&
1201             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1202      {
1203        assume(m1 == NULL && m2 == NULL);
1204        // if not, change to a ring where exponents are at least
1205        // large enough
1206        kStratChangeTailRing(strat);
1207      }
1208      // create the real one
1209      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
1210                    strat->tailRing, m1, m2, strat->R);
1211    }
1212    else if (strat->P.p1 == NULL)
1213    {
1214      if (strat->minim > 0)
1215        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1216      // for input polys, prepare reduction
1217      strat->P.PrepareRed(strat->use_buckets);
1218    }
1219
1220    if (strat->P.p == NULL && strat->P.t_p == NULL)
1221    {
1222      red_result = 0;
1223    }
1224    else
1225    {
1226      if (TEST_OPT_PROT)
1227        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1228                &olddeg,&reduc,strat, red_result);
1229
1230      /* reduction of the element choosen from L */
1231      red_result = strat->red(&strat->P,strat);
1232    }
1233
1234    // reduction to non-zero new poly
1235    if (red_result == 1)
1236    {
1237      /* statistic */
1238      if (TEST_OPT_PROT) PrintS("s");
1239
1240      // get the polynomial (canonicalize bucket, make sure P.p is set)
1241      strat->P.GetP(strat->lmBin);
1242
1243      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1244
1245      // reduce the tail and normalize poly
1246      if (TEST_OPT_INTSTRATEGY)
1247      {
1248        strat->P.pCleardenom();
1249        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1250        {
1251          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1252          strat->P.pCleardenom();
1253        }
1254      }
1255      else
1256      {
1257        strat->P.pNorm();
1258        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1259          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1260      }
1261
1262#ifdef KDEBUG
1263      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1264#endif
1265
1266      // min_std stuff
1267      if ((strat->P.p1==NULL) && (strat->minim>0))
1268      {
1269        if (strat->minim==1)
1270        {
1271          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1272          p_Delete(&strat->P.p2, currRing, strat->tailRing);
1273        }
1274        else
1275        {
1276          strat->M->m[minimcnt]=strat->P.p2;
1277          strat->P.p2=NULL;
1278        }
1279        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1280          pNext(strat->M->m[minimcnt])
1281            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1282                                           strat->tailRing, currRing,
1283                                           currRing->PolyBin);
1284        minimcnt++;
1285      }
1286
1287      // enter into S, L, and T
1288      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1289        enterT(strat->P, strat);
1290#ifdef HAVE_RINGS
1291#ifdef HAVE_VANGB
1292      int at_R = strat->tl;
1293#endif
1294      if (rField_is_Ring(currRing))
1295        superenterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1296      else
1297#endif
1298        enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1299      // posInS only depends on the leading term
1300      if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1301      {
1302#ifdef HAVE_VANGB
1303      strat->enterS(strat->P, pos, strat, at_R);
1304#else
1305      strat->enterS(strat->P, pos, strat, strat->tl);
1306#endif
1307      }
1308      else
1309      {
1310      //  strat->P.Delete(); // syzComp test: it is in T
1311      }
1312#if 0
1313      int pl=pLength(strat->P.p);
1314      if (pl==1)
1315      {
1316        //if (TEST_OPT_PROT)
1317        //PrintS("<1>");
1318      }
1319      else if (pl==2)
1320      {
1321        //if (TEST_OPT_PROT)
1322        //PrintS("<2>");
1323      }
1324#endif
1325      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1326//      Print("[%d]",hilbeledeg);
1327      if (strat->P.lcm!=NULL) pLmFree(strat->P.lcm);
1328      if (strat->sl>srmax) srmax = strat->sl;
1329    }
1330    else if (strat->P.p1 == NULL && strat->minim > 0)
1331    {
1332      p_Delete(&strat->P.p2, currRing, strat->tailRing);
1333    }
1334#ifdef KDEBUG
1335    memset(&(strat->P), 0, sizeof(strat->P));
1336#endif
1337    kTest_TS(strat);
1338  }
1339#ifdef KDEBUG
1340  if (TEST_OPT_DEBUG) messageSets(strat);
1341#endif
1342  /* complete reduction of the standard basis--------- */
1343  if (TEST_OPT_SB_1)
1344  {
1345    int k=1;
1346    int j;
1347    while(k<=strat->sl)
1348    {
1349      j=0;
1350      loop
1351      {
1352        if (j>=k) break;
1353        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1354        j++;
1355      }
1356      k++;
1357    }
1358  }
1359
1360  if (TEST_OPT_REDSB)
1361  {
1362    completeReduce(strat);
1363    if (strat->completeReduce_retry)
1364    {
1365      // completeReduce needed larger exponents, retry
1366      // to reduce with S (instead of T)
1367      // and in currRing (instead of strat->tailRing)
1368      cleanT(strat);strat->tailRing=currRing;
1369      int i;
1370      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1371      completeReduce(strat);
1372    }
1373  }
1374  else if (TEST_OPT_PROT) PrintLn();
1375
1376  /* release temp data-------------------------------- */
1377  exitBuchMora(strat);
1378  if (TEST_OPT_WEIGHTM)
1379  {
1380    pRestoreDegProcs(pFDegOld, pLDegOld);
1381    if (ecartWeights)
1382    {
1383      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1384      ecartWeights=NULL;
1385    }
1386  }
1387  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1388  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1389  return (strat->Shdl);
1390}
1391
1392poly kNF2 (ideal F,ideal Q,poly q,kStrategy strat, int lazyReduce)
1393{
1394  poly   p;
1395  int   i;
1396
1397  if ((idIs0(F))&&(Q==NULL))
1398    return pCopy(q); /*F=0*/
1399  strat->ak = idRankFreeModule(F);
1400  /*- creating temp data structures------------------- -*/
1401  BITSET save_test=test;
1402  test|=Sy_bit(OPT_REDTAIL);
1403  initBuchMoraCrit(strat);
1404  strat->initEcart = initEcartBBA;
1405  strat->enterS = enterSBba;
1406  /*- set S -*/
1407  strat->sl = -1;
1408  /*- init local data struct.---------------------------------------- -*/
1409  /*Shdl=*/initS(F,Q,strat);
1410  /*- compute------------------------------------------------------- -*/
1411  //if ((TEST_OPT_INTSTRATEGY)&&(lazyReduce==0))
1412  //{
1413  //  for (i=strat->sl;i>=0;i--)
1414  //    pNorm(strat->S[i]);
1415  //}
1416  kTest(strat);
1417  if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
1418  int max_ind;
1419  p = redNF(pCopy(q),max_ind,strat);
1420  if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
1421  {
1422    BITSET save=test;
1423    test &= ~Sy_bit(OPT_INTSTRATEGY);
1424    if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
1425    p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
1426    test=save;
1427  }
1428  /*- release temp data------------------------------- -*/
1429  omfree(strat->sevS);
1430  omfree(strat->ecartS);
1431  omfree(strat->T);
1432  omfree(strat->sevT);
1433  omfree(strat->R);
1434  omfree(strat->S_2_R);
1435  omfree(strat->L);
1436  omfree(strat->B);
1437  omfree(strat->fromQ);
1438  idDelete(&strat->Shdl);
1439  test=save_test;
1440  if (TEST_OPT_PROT) PrintLn();
1441  return p;
1442}
1443
1444ideal kNF2 (ideal F,ideal Q,ideal q,kStrategy strat, int lazyReduce)
1445{
1446  poly   p;
1447  int   i;
1448  ideal res;
1449  int max_ind;
1450
1451  if (idIs0(q))
1452    return idInit(IDELEMS(q),q->rank);
1453  if ((idIs0(F))&&(Q==NULL))
1454    return idCopy(q); /*F=0*/
1455  strat->ak = idRankFreeModule(F);
1456  /*- creating temp data structures------------------- -*/
1457  BITSET save_test=test;
1458  test|=Sy_bit(OPT_REDTAIL);
1459  initBuchMoraCrit(strat);
1460  strat->initEcart = initEcartBBA;
1461  strat->enterS = enterSBba;
1462  /*- set S -*/
1463  strat->sl = -1;
1464  /*- init local data struct.---------------------------------------- -*/
1465  /*Shdl=*/initS(F,Q,strat);
1466  /*- compute------------------------------------------------------- -*/
1467  res=idInit(IDELEMS(q),q->rank);
1468  for (i=IDELEMS(q)-1; i>=0; i--)
1469  {
1470    if (q->m[i]!=NULL)
1471    {
1472      if (TEST_OPT_PROT) { PrintS("r");mflush(); }
1473      p = redNF(pCopy(q->m[i]),max_ind,strat);
1474      if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
1475      {
1476        BITSET save=test;
1477        test &= ~Sy_bit(OPT_INTSTRATEGY);
1478        if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
1479        p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
1480        test=save;
1481      }
1482      res->m[i]=p;
1483    }
1484    //else
1485    //  res->m[i]=NULL;
1486  }
1487  /*- release temp data------------------------------- -*/
1488  omfree(strat->sevS);
1489  omfree(strat->ecartS);
1490  omfree(strat->T);
1491  omfree(strat->sevT);
1492  omfree(strat->R);
1493  omfree(strat->S_2_R);
1494  omfree(strat->L);
1495  omfree(strat->B);
1496  omfree(strat->fromQ);
1497  idDelete(&strat->Shdl);
1498  test=save_test;
1499  if (TEST_OPT_PROT) PrintLn();
1500  return res;
1501}
1502
1503/* shiftgb stuff */
1504// #ifdef KDEBUG
1505// static int bba_count = 0;
1506// #endif
1507
1508#ifdef HAVE_PLURAL
1509
1510ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, int uptodeg, int lV)
1511{
1512#ifdef KDEBUG
1513  bba_count++;
1514  int loop_count = 0;
1515#endif
1516  om_Opts.MinTrack = 5;
1517  int   srmax,lrmax, red_result = 1;
1518  int   olddeg,reduc;
1519  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1520  BOOLEAN withT = FALSE;
1521
1522  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1523  initBuchMoraPos(strat);
1524  initHilbCrit(F,Q,&hilb,strat);
1525  initBbaShift(F,strat); /* TODOING */
1526  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1527  /*Shdl=*/initBuchMora(F, Q,strat);
1528  if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
1529  srmax = strat->sl;
1530  reduc = olddeg = lrmax = 0;
1531
1532#ifndef NO_BUCKETS
1533  if (!TEST_OPT_NOT_BUCKETS)
1534    strat->use_buckets = 1;
1535#endif
1536
1537  // redtailBBa against T for inhomogenous input
1538  if (!K_TEST_OPT_OLDSTD)
1539    withT = ! strat->homog;
1540
1541  // strat->posInT = posInT_pLength;
1542  kTest_TS(strat);
1543
1544#ifdef HAVE_TAIL_RING
1545  kStratInitChangeTailRing(strat);
1546#endif
1547
1548  /* compute------------------------------------------------------- */
1549  while (strat->Ll >= 0)
1550  {
1551    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1552#ifdef KDEBUG
1553    loop_count++;
1554    if (TEST_OPT_DEBUG) messageSets(strat);
1555#endif
1556    if (strat->Ll== 0) strat->interpt=TRUE;
1557    if (TEST_OPT_DEGBOUND
1558        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1559            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1560    {
1561      /*
1562       *stops computation if
1563       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1564       *a predefined number Kstd1_deg
1565       */
1566      while ((strat->Ll >= 0)
1567        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1568        && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1569            || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
1570        )
1571        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1572      if (strat->Ll<0) break;
1573      else strat->noClearS=TRUE;
1574    }
1575    /* picks the last element from the lazyset L */
1576    strat->P = strat->L[strat->Ll];
1577    strat->Ll--;
1578
1579    if (pNext(strat->P.p) == strat->tail)
1580    {
1581      // deletes the short spoly
1582      pLmFree(strat->P.p);
1583      strat->P.p = NULL;
1584      poly m1 = NULL, m2 = NULL;
1585
1586      // check that spoly creation is ok
1587      while (strat->tailRing != currRing &&
1588             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1589      {
1590        assume(m1 == NULL && m2 == NULL);
1591        // if not, change to a ring where exponents are at least
1592        // large enough
1593        kStratChangeTailRing(strat);
1594      }
1595      // create the real one
1596      ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
1597                    strat->tailRing, m1, m2, strat->R);
1598    }
1599    else if (strat->P.p1 == NULL)
1600    {
1601      if (strat->minim > 0)
1602        strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
1603      // for input polys, prepare reduction
1604      strat->P.PrepareRed(strat->use_buckets);
1605    }
1606
1607    if (strat->P.p == NULL && strat->P.t_p == NULL)
1608    {
1609      red_result = 0;
1610    }
1611    else
1612    {
1613      if (TEST_OPT_PROT)
1614        message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1615                &olddeg,&reduc,strat, red_result);
1616
1617      /* reduction of the element choosen from L */
1618      red_result = strat->red(&strat->P,strat);
1619    }
1620
1621    // reduction to non-zero new poly
1622    if (red_result == 1)
1623    {
1624      /* statistic */
1625      if (TEST_OPT_PROT) PrintS("s");
1626
1627      // get the polynomial (canonicalize bucket, make sure P.p is set)
1628      strat->P.GetP(strat->lmBin);
1629
1630      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1631
1632      // reduce the tail and normalize poly
1633      if (TEST_OPT_INTSTRATEGY)
1634      {
1635        strat->P.pCleardenom();
1636        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1637        {
1638          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1639          strat->P.pCleardenom();
1640        }
1641      }
1642      else
1643      {
1644        strat->P.pNorm();
1645        if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
1646          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
1647      }
1648
1649#ifdef KDEBUG
1650      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
1651#endif
1652
1653      // min_std stuff
1654      if ((strat->P.p1==NULL) && (strat->minim>0))
1655      {
1656        if (strat->minim==1)
1657        {
1658          strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
1659          p_Delete(&strat->P.p2, currRing, strat->tailRing);
1660        }
1661        else
1662        {
1663          strat->M->m[minimcnt]=strat->P.p2;
1664          strat->P.p2=NULL;
1665        }
1666        if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
1667          pNext(strat->M->m[minimcnt])
1668            = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
1669                                           strat->tailRing, currRing,
1670                                           currRing->PolyBin);
1671        minimcnt++;
1672      }
1673
1674      // enter into S, L, and T
1675      //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1676        enterT(strat->P, strat);
1677        enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
1678      // posInS only depends on the leading term
1679      if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
1680      {
1681        strat->enterS(strat->P, pos, strat, strat->tl);
1682      }
1683      else
1684      {
1685      //  strat->P.Delete(); // syzComp test: it is in T
1686      }
1687      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1688//      Print("[%d]",hilbeledeg);
1689      if (strat->P.lcm!=NULL) pLmFree(strat->P.lcm);
1690      if (strat->sl>srmax) srmax = strat->sl;
1691    }
1692    else if (strat->P.p1 == NULL && strat->minim > 0)
1693    {
1694      p_Delete(&strat->P.p2, currRing, strat->tailRing);
1695    }
1696#ifdef KDEBUG
1697    memset(&(strat->P), 0, sizeof(strat->P));
1698#endif
1699    kTest_TS(strat);
1700  }
1701#ifdef KDEBUG
1702  if (TEST_OPT_DEBUG) messageSets(strat);
1703#endif
1704  /* complete reduction of the standard basis--------- */
1705  if (TEST_OPT_SB_1)
1706  {
1707    int k=1;
1708    int j;
1709    while(k<=strat->sl)
1710    {
1711      j=0;
1712      loop
1713      {
1714        if (j>=k) break;
1715        clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1716        j++;
1717      }
1718      k++;
1719    }
1720  }
1721
1722  if (TEST_OPT_REDSB)
1723  {
1724    completeReduce(strat);
1725    if (strat->completeReduce_retry)
1726    {
1727      // completeReduce needed larger exponents, retry
1728      // to reduce with S (instead of T)
1729      // and in currRing (instead of strat->tailRing)
1730      cleanT(strat);strat->tailRing=currRing;
1731      int i;
1732      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
1733      completeReduce(strat);
1734    }
1735  }
1736  else if (TEST_OPT_PROT) PrintLn();
1737
1738  /* release temp data-------------------------------- */
1739  exitBuchMora(strat);
1740  if (TEST_OPT_WEIGHTM)
1741  {
1742    pRestoreDegProcs(pFDegOld, pLDegOld);
1743    if (ecartWeights)
1744    {
1745      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1746      ecartWeights=NULL;
1747    }
1748  }
1749  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1750  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1751  return (strat->Shdl);
1752}
1753
1754ideal freegb(ideal I, int uptodeg, int lVblock)
1755{
1756  /* todo main call */
1757
1758  kStrategy strat = new skStrategy;
1759  /* ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, int uptodeg, int lV) */
1760  /* at the moment:
1761- no quotient (check)
1762- no *w, no *hilb
1763  */
1764
1765  ideal RS = bbaShift(I,NULL, NULL, NULL, strat, uptodeg, lVblock);
1766  return(RS);
1767}
1768#endif
Note: See TracBrowser for help on using the repository browser.