source: git/kernel/GBEngine/kstd1.cc @ a3f0fea

spielwiese
Last change on this file since a3f0fea was a3f0fea, checked in by Reimer Behrends <behrends@…>, 5 years ago
Modify variable declarions for pSingular.
  • Property mode set to 100644
File size: 88.3 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT:
6*/
7
8// TODO: why the following is here instead of mod2.h???
9
10
11// define if buckets should be used
12#define MORA_USE_BUCKETS
13
14#define PRE_INTEGER_CHECK 0
15
16#include "kernel/mod2.h"
17
18#include "misc/options.h"
19#include "misc/intvec.h"
20
21#include "polys/weight.h"
22#include "kernel/polys.h"
23
24#include "kernel/GBEngine/kutil.h"
25#include "kernel/GBEngine/kstd1.h"
26#include "kernel/GBEngine/khstd.h"
27#include "kernel/combinatorics/stairc.h"
28#include "kernel/ideals.h"
29
30//#include "ipprint.h"
31
32#ifdef HAVE_PLURAL
33#include "polys/nc/nc.h"
34#include "polys/nc/sca.h"
35#include "kernel/GBEngine/nc.h"
36#endif
37
38#include "kernel/GBEngine/kInline.h"
39
40
41/* the list of all options which give a warning by test */
42VAR BITSET kOptions=Sy_bit(OPT_PROT)           /*  0 */
43                |Sy_bit(OPT_REDSB)         /*  1 */
44                |Sy_bit(OPT_NOT_SUGAR)     /*  3 */
45                |Sy_bit(OPT_INTERRUPT)     /*  4 */
46                |Sy_bit(OPT_SUGARCRIT)     /*  5 */
47                |Sy_bit(OPT_REDTHROUGH)
48                |Sy_bit(OPT_OLDSTD)
49                |Sy_bit(OPT_FASTHC)        /* 10 */
50                |Sy_bit(OPT_INTSTRATEGY)   /* 26 */
51                |Sy_bit(OPT_INFREDTAIL)    /* 28 */
52                |Sy_bit(OPT_NOTREGULARITY) /* 30 */
53                |Sy_bit(OPT_WEIGHTM);      /* 31 */
54
55/* the list of all options which may be used by option and test */
56/* defintion of ALL options: libpolys/misc/options.h */
57VAR BITSET validOpts=Sy_bit(0)
58                |Sy_bit(1)
59                |Sy_bit(2) // obachman 10/00: replaced by notBucket
60                |Sy_bit(3)
61                |Sy_bit(4)
62                |Sy_bit(5)
63                |Sy_bit(6)
64//                |Sy_bit(7) obachman 11/00 tossed: 12/00 used for redThrough
65                |Sy_bit(7) // OPT_REDTHROUGH
66                |Sy_bit(8) // obachman 11/00 tossed -> motsak 2011 experimental: OPT_NO_SYZ_MINIM
67                |Sy_bit(9)
68                |Sy_bit(10)
69                |Sy_bit(11)
70                |Sy_bit(12)
71                |Sy_bit(13)
72                |Sy_bit(14)
73                |Sy_bit(15)
74                |Sy_bit(16)
75                |Sy_bit(17)
76                |Sy_bit(18)
77                |Sy_bit(19)
78//                |Sy_bit(20) obachman 11/00 tossed: 12/00 used for redOldStd
79                |Sy_bit(OPT_OLDSTD)
80                |Sy_bit(21)
81                |Sy_bit(22)
82                /*|Sy_bit(23)*/
83                /*|Sy_bit(24)*/
84                |Sy_bit(OPT_REDTAIL)
85                |Sy_bit(OPT_INTSTRATEGY)
86                |Sy_bit(27)
87                |Sy_bit(28)
88                |Sy_bit(29)
89                |Sy_bit(30)
90                |Sy_bit(31);
91
92//static BOOLEAN posInLOldFlag;
93           /*FALSE, if posInL == posInL10*/
94// returns TRUE if mora should use buckets, false otherwise
95static BOOLEAN kMoraUseBucket(kStrategy strat);
96
97static void kOptimizeLDeg(pLDegProc ldeg, kStrategy strat)
98{
99//  if (strat->ak == 0 && !rIsSyzIndexRing(currRing))
100    strat->length_pLength = TRUE;
101//  else
102//    strat->length_pLength = FALSE;
103
104  if ((ldeg == pLDeg0c /*&& !rIsSyzIndexRing(currRing)*/) ||
105      (ldeg == pLDeg0 && strat->ak == 0))
106  {
107    strat->LDegLast = TRUE;
108  }
109  else
110  {
111    strat->LDegLast = FALSE;
112  }
113}
114
115
116static int doRed (LObject* h, TObject* with,BOOLEAN intoT,kStrategy strat, bool redMoraNF)
117{
118  int ret;
119#if KDEBUG > 0
120  kTest_L(h);
121  kTest_T(with);
122#endif
123  // Hmmm ... why do we do this -- polys from T should already be normalized
124  if (!TEST_OPT_INTSTRATEGY)
125    with->pNorm();
126#ifdef KDEBUG
127  if (TEST_OPT_DEBUG)
128  {
129    PrintS("reduce ");h->wrp();PrintS(" with ");with->wrp();PrintLn();
130  }
131#endif
132  if (intoT)
133  {
134    // need to do it exacly like this: otherwise
135    // we might get errors
136    LObject L= *h;
137    L.Copy();
138    h->GetP();
139    h->length=h->pLength=pLength(h->p);
140    ret = ksReducePoly(&L, with, strat->kNoetherTail(), NULL, strat);
141    if (ret)
142    {
143      if (ret < 0) return ret;
144      if (h->tailRing != strat->tailRing)
145        h->ShallowCopyDelete(strat->tailRing,
146                             pGetShallowCopyDeleteProc(h->tailRing,
147                                                       strat->tailRing));
148    }
149    if(redMoraNF && (rField_is_Ring(currRing)))
150      enterT_strong(*h,strat);
151    else
152      enterT(*h,strat);
153    *h = L;
154  }
155  else
156    ret = ksReducePoly(h, with, strat->kNoetherTail(), NULL, strat);
157#ifdef KDEBUG
158  if (TEST_OPT_DEBUG)
159  {
160    PrintS("to ");h->wrp();PrintLn();
161  }
162#endif
163  return ret;
164}
165
166int redEcart (LObject* h,kStrategy strat)
167{
168  int i,at,ei,li,ii;
169  int j = 0;
170  int pass = 0;
171  long d,reddeg;
172
173  d = h->GetpFDeg()+ h->ecart;
174  reddeg = strat->LazyDegree+d;
175  h->SetShortExpVector();
176  loop
177  {
178    j = kFindDivisibleByInT(strat, h);
179    if (j < 0)
180    {
181      if (strat->honey) h->SetLength(strat->length_pLength);
182      return 1;
183    }
184
185    ei = strat->T[j].ecart;
186    ii = j;
187
188    if (ei > h->ecart && ii < strat->tl)
189    {
190      li = strat->T[j].length;
191      // the polynomial to reduce with (up to the moment) is;
192      // pi with ecart ei and length li
193      // look for one with smaller ecart
194      i = j;
195      loop
196      {
197        /*- takes the first possible with respect to ecart -*/
198        i++;
199#if 1
200        if (i > strat->tl) break;
201        if ((strat->T[i].ecart < ei || (strat->T[i].ecart == ei &&
202                                        strat->T[i].length < li))
203            &&
204            p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i], h->GetLmTailRing(), ~h->sev, strat->tailRing))
205#else
206          j = kFindDivisibleByInT(strat, h, i);
207        if (j < 0) break;
208        i = j;
209        if (strat->T[i].ecart < ei || (strat->T[i].ecart == ei &&
210                                        strat->T[i].length < li))
211#endif
212        {
213          // the polynomial to reduce with is now
214          ii = i;
215          ei = strat->T[i].ecart;
216          if (ei <= h->ecart) break;
217          li = strat->T[i].length;
218        }
219      }
220    }
221
222    // end of search: have to reduce with pi
223    if (ei > h->ecart)
224    {
225      // It is not possible to reduce h with smaller ecart;
226      // if possible h goes to the lazy-set L,i.e
227      // if its position in L would be not the last one
228      strat->fromT = TRUE;
229      if (!TEST_OPT_REDTHROUGH && strat->Ll >= 0) /*- L is not empty -*/
230      {
231        h->SetLmCurrRing();
232        if (strat->honey && strat->posInLDependsOnLength)
233          h->SetLength(strat->length_pLength);
234        assume(h->FDeg == h->pFDeg());
235        at = strat->posInL(strat->L,strat->Ll,h,strat);
236        if (at <= strat->Ll)
237        {
238          /*- h will not become the next element to reduce -*/
239          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
240#ifdef KDEBUG
241          if (TEST_OPT_DEBUG) Print(" ecart too big; -> L%d\n",at);
242#endif
243          h->Clear();
244          strat->fromT = FALSE;
245          return -1;
246        }
247      }
248    }
249
250    // now we finally can reduce
251    doRed(h,&(strat->T[ii]),strat->fromT,strat,FALSE);
252    strat->fromT=FALSE;
253
254    // are we done ???
255    if (h->IsNull())
256    {
257      assume(!rField_is_Ring(currRing));
258      kDeleteLcm(h);
259      h->Clear();
260      return 0;
261    }
262
263    // NO!
264    h->SetShortExpVector();
265    h->SetpFDeg();
266    if (strat->honey)
267    {
268      if (ei <= h->ecart)
269        h->ecart = d-h->GetpFDeg();
270      else
271        h->ecart = d-h->GetpFDeg()+ei-h->ecart;
272    }
273    else
274      // this has the side effect of setting h->length
275      h->ecart = h->pLDeg(strat->LDegLast) - h->GetpFDeg();
276#if 0
277    if (strat->syzComp!=0)
278    {
279      if ((strat->syzComp>0) && (h->Comp() > strat->syzComp))
280      {
281        assume(h->MinComp() > strat->syzComp);
282        if (strat->honey) h->SetLength();
283#ifdef KDEBUG
284        if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
285#endif
286        return -2;
287      }
288    }
289#endif
290    /*- try to reduce the s-polynomial -*/
291    pass++;
292    d = h->GetpFDeg()+h->ecart;
293    /*
294     *test whether the polynomial should go to the lazyset L
295     *-if the degree jumps
296     *-if the number of pre-defined reductions jumps
297     */
298    if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
299        && ((d >= reddeg) || (pass > strat->LazyPass)))
300    {
301      h->SetLmCurrRing();
302      if (strat->honey && strat->posInLDependsOnLength)
303        h->SetLength(strat->length_pLength);
304      assume(h->FDeg == h->pFDeg());
305      at = strat->posInL(strat->L,strat->Ll,h,strat);
306      if (at <= strat->Ll)
307      {
308        int dummy=strat->sl;
309        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
310        {
311          if (strat->honey && !strat->posInLDependsOnLength)
312            h->SetLength(strat->length_pLength);
313          return 1;
314        }
315        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
316#ifdef KDEBUG
317        if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
318#endif
319        h->Clear();
320        return -1;
321      }
322    }
323    else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
324    {
325      Print(".%ld",d);mflush();
326      reddeg = d+1;
327      if (h->pTotalDeg()+h->ecart >= (int)strat->tailRing->bitmask)
328      {
329        strat->overflow=TRUE;
330        //Print("OVERFLOW in redEcart d=%ld, max=%ld",d,strat->tailRing->bitmask);
331        h->GetP();
332        at = strat->posInL(strat->L,strat->Ll,h,strat);
333        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
334        h->Clear();
335        return -1;
336      }
337    }
338  }
339}
340
341#ifdef HAVE_RINGS
342int redRiloc (LObject* h,kStrategy strat)
343{
344  int i,at,ei,li,ii;
345  int j = 0;
346  int pass = 0;
347  long d,reddeg;
348
349  d = h->GetpFDeg()+ h->ecart;
350  reddeg = strat->LazyDegree+d;
351  h->SetShortExpVector();
352  loop
353  {
354    j = kFindDivisibleByInT(strat, h);
355    if (j < 0)
356    {
357      // over ZZ: cleanup coefficients by complete reduction with monomials
358      postReduceByMon(h, strat);
359      if(h->p == NULL)
360      {
361        kDeleteLcm(h);
362        h->Clear();
363        return 0;
364      }
365      if (strat->honey) h->SetLength(strat->length_pLength);
366      if(strat->tl >= 0)
367          h->i_r1 = strat->tl;
368      else
369          h->i_r1 = -1;
370      if (h->GetLmTailRing() == NULL)
371      {
372        kDeleteLcm(h);
373        h->Clear();
374        return 0;
375      }
376      return 1;
377    }
378
379    ei = strat->T[j].ecart;
380    ii = j;
381    if (ei > h->ecart && ii < strat->tl)
382    {
383      li = strat->T[j].length;
384      // the polynomial to reduce with (up to the moment) is;
385      // pi with ecart ei and length li
386      // look for one with smaller ecart
387      i = j;
388      loop
389      {
390        /*- takes the first possible with respect to ecart -*/
391        i++;
392#if 1
393        if (i > strat->tl) break;
394        if ((strat->T[i].ecart < ei || (strat->T[i].ecart == ei &&
395                                        strat->T[i].length < li))
396            &&
397            p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i], h->GetLmTailRing(), ~h->sev, strat->tailRing)
398            &&
399            n_DivBy(h->p->coef,strat->T[i].p->coef,strat->tailRing->cf))
400#else
401          j = kFindDivisibleByInT(strat, h, i);
402        if (j < 0) break;
403        i = j;
404        if (strat->T[i].ecart < ei || (strat->T[i].ecart == ei &&
405                                        strat->T[i].length < li))
406#endif
407        {
408          // the polynomial to reduce with is now
409          ii = i;
410          ei = strat->T[i].ecart;
411          if (ei <= h->ecart) break;
412          li = strat->T[i].length;
413        }
414      }
415    }
416
417    // end of search: have to reduce with pi
418    if (ei > h->ecart)
419    {
420      // It is not possible to reduce h with smaller ecart;
421      // if possible h goes to the lazy-set L,i.e
422      // if its position in L would be not the last one
423      strat->fromT = TRUE;
424      if (!TEST_OPT_REDTHROUGH && strat->Ll >= 0) /*- L is not empty -*/
425      {
426        h->SetLmCurrRing();
427        if (strat->honey && strat->posInLDependsOnLength)
428          h->SetLength(strat->length_pLength);
429        assume(h->FDeg == h->pFDeg());
430        at = strat->posInL(strat->L,strat->Ll,h,strat);
431        if (at <= strat->Ll && pLmCmp(h->p, strat->L[strat->Ll].p) != 0 && !nEqual(h->p->coef, strat->L[strat->Ll].p->coef))
432        {
433          /*- h will not become the next element to reduce -*/
434          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
435          #ifdef KDEBUG
436          if (TEST_OPT_DEBUG) Print(" ecart too big; -> L%d\n",at);
437          #endif
438          h->Clear();
439          strat->fromT = FALSE;
440          return -1;
441        }
442      }
443      doRed(h,&(strat->T[ii]),strat->fromT,strat,TRUE);
444    }
445    else
446    {
447      // now we finally can reduce
448      doRed(h,&(strat->T[ii]),strat->fromT,strat,FALSE);
449    }
450    strat->fromT=FALSE;
451    // are we done ???
452    if (h->IsNull())
453    {
454      kDeleteLcm(h);
455      h->Clear();
456      return 0;
457    }
458
459    // NO!
460    h->SetShortExpVector();
461    h->SetpFDeg();
462    if (strat->honey)
463    {
464      if (ei <= h->ecart)
465        h->ecart = d-h->GetpFDeg();
466      else
467        h->ecart = d-h->GetpFDeg()+ei-h->ecart;
468    }
469    else
470      // this has the side effect of setting h->length
471      h->ecart = h->pLDeg(strat->LDegLast) - h->GetpFDeg();
472    /*- try to reduce the s-polynomial -*/
473    pass++;
474    d = h->GetpFDeg()+h->ecart;
475    /*
476     *test whether the polynomial should go to the lazyset L
477     *-if the degree jumps
478     *-if the number of pre-defined reductions jumps
479     */
480    if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
481        && ((d >= reddeg) || (pass > strat->LazyPass)))
482    {
483      h->SetLmCurrRing();
484      if (strat->honey && strat->posInLDependsOnLength)
485        h->SetLength(strat->length_pLength);
486      assume(h->FDeg == h->pFDeg());
487      at = strat->posInL(strat->L,strat->Ll,h,strat);
488      if (at <= strat->Ll)
489      {
490        int dummy=strat->sl;
491        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
492        {
493          if (strat->honey && !strat->posInLDependsOnLength)
494            h->SetLength(strat->length_pLength);
495          return 1;
496        }
497        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
498#ifdef KDEBUG
499        if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
500#endif
501        h->Clear();
502        return -1;
503      }
504    }
505    else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
506    {
507      Print(".%ld",d);mflush();
508      reddeg = d+1;
509      if (h->pTotalDeg()+h->ecart >= (int)strat->tailRing->bitmask)
510      {
511        strat->overflow=TRUE;
512        //Print("OVERFLOW in redEcart d=%ld, max=%ld",d,strat->tailRing->bitmask);
513        h->GetP();
514        at = strat->posInL(strat->L,strat->Ll,h,strat);
515        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
516        h->Clear();
517        return -1;
518      }
519    }
520  }
521}
522#endif
523
524/*2
525*reduces h with elements from T choosing  the first possible
526* element in t with respect to the given pDivisibleBy
527*/
528int redFirst (LObject* h,kStrategy strat)
529{
530  if (h->IsNull()) return 0;
531
532  int at;
533  long reddeg,d;
534  int pass = 0;
535  int j = 0;
536
537  if (! strat->homog)
538  {
539    d = h->GetpFDeg() + h->ecart;
540    reddeg = strat->LazyDegree+d;
541  }
542  h->SetShortExpVector();
543  loop
544  {
545    j = kFindDivisibleByInT(strat, h);
546    if (j < 0)
547    {
548      h->SetDegStuffReturnLDeg(strat->LDegLast);
549      return 1;
550    }
551
552    if (!TEST_OPT_INTSTRATEGY)
553      strat->T[j].pNorm();
554#ifdef KDEBUG
555    if (TEST_OPT_DEBUG)
556    {
557      PrintS("reduce ");
558      h->wrp();
559      PrintS(" with ");
560      strat->T[j].wrp();
561    }
562#endif
563    ksReducePoly(h, &(strat->T[j]), strat->kNoetherTail(), NULL, strat);
564#ifdef KDEBUG
565    if (TEST_OPT_DEBUG)
566    {
567      PrintS(" to ");
568      wrp(h->p);
569      PrintLn();
570    }
571#endif
572    if (h->IsNull())
573    {
574      assume(!rField_is_Ring(currRing));
575      kDeleteLcm(h);
576      h->Clear();
577      return 0;
578    }
579    h->SetShortExpVector();
580
581#if 0
582    if ((strat->syzComp!=0) && !strat->honey)
583    {
584      if ((strat->syzComp>0) &&
585          (h->Comp() > strat->syzComp))
586      {
587        assume(h->MinComp() > strat->syzComp);
588#ifdef KDEBUG
589        if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
590#endif
591        if (strat->homog)
592          h->SetDegStuffReturnLDeg(strat->LDegLast);
593        return -2;
594      }
595    }
596#endif
597    if (!strat->homog)
598    {
599      if (!TEST_OPT_OLDSTD && strat->honey)
600      {
601        h->SetpFDeg();
602        if (strat->T[j].ecart <= h->ecart)
603          h->ecart = d - h->GetpFDeg();
604        else
605          h->ecart = d - h->GetpFDeg() + strat->T[j].ecart - h->ecart;
606
607        d = h->GetpFDeg() + h->ecart;
608      }
609      else
610        d = h->SetDegStuffReturnLDeg(strat->LDegLast);
611      /*- try to reduce the s-polynomial -*/
612      pass++;
613      /*
614       *test whether the polynomial should go to the lazyset L
615       *-if the degree jumps
616       *-if the number of pre-defined reductions jumps
617       */
618      if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
619          && ((d >= reddeg) || (pass > strat->LazyPass)))
620      {
621        h->SetLmCurrRing();
622        if (strat->posInLDependsOnLength)
623          h->SetLength(strat->length_pLength);
624        at = strat->posInL(strat->L,strat->Ll,h,strat);
625        if (at <= strat->Ll)
626        {
627          int dummy=strat->sl;
628          if (kFindDivisibleByInS(strat,&dummy, h) < 0)
629            return 1;
630          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
631#ifdef KDEBUG
632          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
633#endif
634          h->Clear();
635          return -1;
636        }
637      }
638      if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
639      {
640        reddeg = d+1;
641        Print(".%ld",d);mflush();
642        if (h->pTotalDeg()+h->ecart >= (int)strat->tailRing->bitmask)
643        {
644          strat->overflow=TRUE;
645          //Print("OVERFLOW in redFirst d=%ld, max=%ld",d,strat->tailRing->bitmask);
646          h->GetP();
647          at = strat->posInL(strat->L,strat->Ll,h,strat);
648          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
649          h->Clear();
650          return -1;
651        }
652      }
653    }
654  }
655}
656
657/*2
658* reduces h with elements from T choosing first possible
659* element in T with respect to the given ecart
660* used for computing normal forms outside kStd
661*/
662static poly redMoraNF (poly h,kStrategy strat, int flag)
663{
664  LObject H;
665  H.p = h;
666  int j = 0;
667  int z = 10;
668  int o = H.SetpFDeg();
669  H.ecart = currRing->pLDeg(H.p,&H.length,currRing)-o;
670  if ((flag & 2) == 0) cancelunit(&H,TRUE);
671  H.sev = pGetShortExpVector(H.p);
672  unsigned long not_sev = ~ H.sev;
673  loop
674  {
675    if (j > strat->tl)
676    {
677      return H.p;
678    }
679    if (TEST_V_DEG_STOP)
680    {
681      if (kModDeg(H.p)>Kstd1_deg) pLmDelete(&H.p);
682      if (H.p==NULL) return NULL;
683    }
684    if (p_LmShortDivisibleBy(strat->T[j].GetLmTailRing(), strat->sevT[j], H.GetLmTailRing(), not_sev, strat->tailRing)
685        )
686    {
687      /*- remember the found T-poly -*/
688      // poly pi = strat->T[j].p;
689      int ei = strat->T[j].ecart;
690      int li = strat->T[j].length;
691      int ii = j;
692      /*
693      * the polynomial to reduce with (up to the moment) is;
694      * pi with ecart ei and length li
695      */
696      loop
697      {
698        /*- look for a better one with respect to ecart -*/
699        /*- stop, if the ecart is small enough (<=ecart(H)) -*/
700        j++;
701        if (j > strat->tl) break;
702        if (ei <= H.ecart) break;
703        if (((strat->T[j].ecart < ei)
704          || ((strat->T[j].ecart == ei)
705        && (strat->T[j].length < li)))
706        && pLmShortDivisibleBy(strat->T[j].p,strat->sevT[j], H.p, not_sev)
707        )
708        {
709          /*
710          * the polynomial to reduce with is now;
711          */
712          // pi = strat->T[j].p;
713          ei = strat->T[j].ecart;
714          li = strat->T[j].length;
715          ii = j;
716        }
717      }
718      /*
719      * end of search: have to reduce with pi
720      */
721      z++;
722      if (z>10)
723      {
724        pNormalize(H.p);
725        z=0;
726      }
727      if ((ei > H.ecart) && (!strat->kHEdgeFound))
728      {
729        /*
730        * It is not possible to reduce h with smaller ecart;
731        * we have to reduce with bad ecart: H has to enter in T
732        */
733        doRed(&H,&(strat->T[ii]),TRUE,strat,TRUE);
734        if (H.p == NULL)
735          return NULL;
736      }
737      else
738      {
739        /*
740        * we reduce with good ecart, h need not to be put to T
741        */
742        doRed(&H,&(strat->T[ii]),FALSE,strat,TRUE);
743        if (H.p == NULL)
744          return NULL;
745      }
746      /*- try to reduce the s-polynomial -*/
747      o = H.SetpFDeg();
748      if ((flag &2 ) == 0) cancelunit(&H,TRUE);
749      H.ecart = currRing->pLDeg(H.p,&(H.length),currRing)-o;
750      j = 0;
751      H.sev = pGetShortExpVector(H.p);
752      not_sev = ~ H.sev;
753    }
754    else
755    {
756      j++;
757    }
758  }
759}
760
761#ifdef HAVE_RINGS
762static poly redMoraNFRing (poly h,kStrategy strat, int flag)
763{
764  LObject H;
765  H.p = h;
766  int j = 0;
767  int z = 10;
768  int o = H.SetpFDeg();
769  H.ecart = currRing->pLDeg(H.p,&H.length,currRing)-o;
770  if ((flag & 2) == 0) cancelunit(&H,TRUE);
771  H.sev = pGetShortExpVector(H.p);
772  unsigned long not_sev = ~ H.sev;
773  loop
774  {
775    if (j > strat->tl)
776    {
777      return H.p;
778    }
779    if (TEST_V_DEG_STOP)
780    {
781      if (kModDeg(H.p)>Kstd1_deg) pLmDelete(&H.p);
782      if (H.p==NULL) return NULL;
783    }
784    if (p_LmShortDivisibleBy(strat->T[j].GetLmTailRing(), strat->sevT[j], H.GetLmTailRing(), not_sev, strat->tailRing)
785        && (n_DivBy(H.p->coef, strat->T[j].p->coef,strat->tailRing->cf))
786        )
787    {
788      /*- remember the found T-poly -*/
789      // poly pi = strat->T[j].p;
790      int ei = strat->T[j].ecart;
791      int li = strat->T[j].length;
792      int ii = j;
793      /*
794      * the polynomial to reduce with (up to the moment) is;
795      * pi with ecart ei and length li
796      */
797      loop
798      {
799        /*- look for a better one with respect to ecart -*/
800        /*- stop, if the ecart is small enough (<=ecart(H)) -*/
801        j++;
802        if (j > strat->tl) break;
803        if (ei <= H.ecart) break;
804        if (((strat->T[j].ecart < ei)
805          || ((strat->T[j].ecart == ei)
806        && (strat->T[j].length < li)))
807        && pLmShortDivisibleBy(strat->T[j].p,strat->sevT[j], H.p, not_sev)
808        && (n_DivBy(H.p->coef, strat->T[j].p->coef,strat->tailRing->cf))
809        )
810        {
811          /*
812          * the polynomial to reduce with is now;
813          */
814          // pi = strat->T[j].p;
815          ei = strat->T[j].ecart;
816          li = strat->T[j].length;
817          ii = j;
818        }
819      }
820      /*
821      * end of search: have to reduce with pi
822      */
823      z++;
824      if (z>10)
825      {
826        pNormalize(H.p);
827        z=0;
828      }
829      if ((ei > H.ecart) && (!strat->kHEdgeFound))
830      {
831        /*
832        * It is not possible to reduce h with smaller ecart;
833        * we have to reduce with bad ecart: H has to enter in T
834        */
835        doRed(&H,&(strat->T[ii]),TRUE,strat,TRUE);
836        if (H.p == NULL)
837          return NULL;
838      }
839      else
840      {
841        /*
842        * we reduce with good ecart, h need not to be put to T
843        */
844        doRed(&H,&(strat->T[ii]),FALSE,strat,TRUE);
845        if (H.p == NULL)
846          return NULL;
847      }
848      /*- try to reduce the s-polynomial -*/
849      o = H.SetpFDeg();
850      if ((flag &2 ) == 0) cancelunit(&H,TRUE);
851      H.ecart = currRing->pLDeg(H.p,&(H.length),currRing)-o;
852      j = 0;
853      H.sev = pGetShortExpVector(H.p);
854      not_sev = ~ H.sev;
855    }
856    else
857    {
858      j++;
859    }
860  }
861}
862#endif
863
864/*2
865*reorders  L with respect to posInL
866*/
867void reorderL(kStrategy strat)
868{
869  int i,j,at;
870  LObject p;
871
872  for (i=1; i<=strat->Ll; i++)
873  {
874    at = strat->posInL(strat->L,i-1,&(strat->L[i]),strat);
875    if (at != i)
876    {
877      p = strat->L[i];
878      for (j=i-1; j>=at; j--) strat->L[j+1] = strat->L[j];
879      strat->L[at] = p;
880    }
881  }
882}
883
884/*2
885*reorders  T with respect to length
886*/
887void reorderT(kStrategy strat)
888{
889  int i,j,at;
890  TObject p;
891  unsigned long sev;
892
893
894  for (i=1; i<=strat->tl; i++)
895  {
896    if (strat->T[i-1].length > strat->T[i].length)
897    {
898      p = strat->T[i];
899      sev = strat->sevT[i];
900      at = i-1;
901      loop
902      {
903        at--;
904        if (at < 0) break;
905        if (strat->T[i].length > strat->T[at].length) break;
906      }
907      for (j = i-1; j>at; j--)
908      {
909        strat->T[j+1]=strat->T[j];
910        strat->sevT[j+1]=strat->sevT[j];
911        strat->R[strat->T[j+1].i_r] = &(strat->T[j+1]);
912      }
913      strat->T[at+1]=p;
914      strat->sevT[at+1] = sev;
915      strat->R[p.i_r] = &(strat->T[at+1]);
916    }
917  }
918}
919
920/*2
921*looks whether exactly (currRing->N)-1 axis are used
922*returns last != 0 in this case
923*last is the (first) unused axis
924*/
925void missingAxis (int* last,kStrategy strat)
926{
927  int   i = 0;
928  int   k = 0;
929
930  *last = 0;
931  if (!rHasMixedOrdering(currRing))
932  {
933    loop
934    {
935      i++;
936      if (i > (currRing->N)) break;
937      if (strat->NotUsedAxis[i])
938      {
939        *last = i;
940        k++;
941      }
942      if (k>1)
943      {
944        *last = 0;
945        break;
946      }
947    }
948  }
949}
950
951/*2
952*last is the only non used axis, it looks
953*for a monomial in p being a pure power of this
954*variable and returns TRUE in this case
955*(*length) gives the length between the pure power and the leading term
956*(should be minimal)
957*/
958BOOLEAN hasPurePower (const poly p,int last, int *length,kStrategy strat)
959{
960  poly h;
961  int i;
962
963  if (pNext(p) == strat->tail)
964    return FALSE;
965  pp_Test(p, currRing, strat->tailRing);
966  if (strat->ak <= 0 || p_MinComp(p, currRing, strat->tailRing) == strat->ak)
967  {
968    i = p_IsPurePower(p, currRing);
969    if (rField_is_Ring(currRing) && (!n_IsUnit(pGetCoeff(p), currRing->cf))) i=0;
970    if (i == last)
971    {
972      *length = 0;
973      return TRUE;
974    }
975    *length = 1;
976    h = pNext(p);
977    while (h != NULL)
978    {
979      i = p_IsPurePower(h, strat->tailRing);
980      if (rField_is_Ring(currRing) && (!n_IsUnit(pGetCoeff(h), currRing->cf))) i=0;
981      if (i==last) return TRUE;
982      (*length)++;
983      pIter(h);
984    }
985  }
986  return FALSE;
987}
988
989BOOLEAN hasPurePower (LObject *L,int last, int *length,kStrategy strat)
990{
991  if (L->bucket != NULL)
992  {
993    poly p = L->GetP();
994    return hasPurePower(p, last, length, strat);
995  }
996  else
997  {
998    return hasPurePower(L->p, last, length, strat);
999  }
1000}
1001
1002/*2
1003* looks up the position of polynomial p in L
1004* in the case of looking for the pure powers
1005*/
1006int posInL10 (const LSet set,const int length, LObject* p,const kStrategy strat)
1007{
1008  int j,dp,dL;
1009
1010  if (length<0) return 0;
1011  if (hasPurePower(p,strat->lastAxis,&dp,strat))
1012  {
1013    int op= p->GetpFDeg() +p->ecart;
1014    for (j=length; j>=0; j--)
1015    {
1016      if (!hasPurePower(&(set[j]),strat->lastAxis,&dL,strat))
1017        return j+1;
1018      if (dp < dL)
1019        return j+1;
1020      if ((dp == dL)
1021          && (set[j].GetpFDeg()+set[j].ecart >= op))
1022        return j+1;
1023    }
1024  }
1025  j=length;
1026  loop
1027  {
1028    if (j<0) break;
1029    if (!hasPurePower(&(set[j]),strat->lastAxis,&dL,strat)) break;
1030    j--;
1031  }
1032  return strat->posInLOld(set,j,p,strat);
1033}
1034
1035
1036/*2
1037* computes the s-polynomials L[ ].p in L
1038*/
1039void updateL(kStrategy strat)
1040{
1041  LObject p;
1042  int dL;
1043  int j=strat->Ll;
1044  loop
1045  {
1046    if (j<0) break;
1047    if (hasPurePower(&(strat->L[j]),strat->lastAxis,&dL,strat))
1048    {
1049      p=strat->L[strat->Ll];
1050      strat->L[strat->Ll]=strat->L[j];
1051      strat->L[j]=p;
1052      break;
1053    }
1054    j--;
1055  }
1056  if (j<0)
1057  {
1058    j=strat->Ll;
1059    loop
1060    {
1061      if (j<0) break;
1062      if (pNext(strat->L[j].p) == strat->tail)
1063      {
1064        if (rField_is_Ring(currRing))
1065          pLmDelete(strat->L[j].p);    /*deletes the short spoly and computes*/
1066        else
1067          pLmFree(strat->L[j].p);    /*deletes the short spoly and computes*/
1068        strat->L[j].p = NULL;
1069        poly m1 = NULL, m2 = NULL;
1070        // check that spoly creation is ok
1071        while (strat->tailRing != currRing &&
1072               !kCheckSpolyCreation(&(strat->L[j]), strat, m1, m2))
1073        {
1074          assume(m1 == NULL && m2 == NULL);
1075          // if not, change to a ring where exponents are at least
1076          // large enough
1077          kStratChangeTailRing(strat);
1078        }
1079        /* create the real one */
1080        ksCreateSpoly(&(strat->L[j]), strat->kNoetherTail(), FALSE,
1081                      strat->tailRing, m1, m2, strat->R);
1082
1083        strat->L[j].SetLmCurrRing();
1084        if (!strat->honey)
1085          strat->initEcart(&strat->L[j]);
1086        else
1087          strat->L[j].SetLength(strat->length_pLength);
1088
1089        BOOLEAN pp = hasPurePower(&(strat->L[j]),strat->lastAxis,&dL,strat);
1090
1091        if (strat->use_buckets) strat->L[j].PrepareRed(TRUE);
1092
1093        if (pp)
1094        {
1095          p=strat->L[strat->Ll];
1096          strat->L[strat->Ll]=strat->L[j];
1097          strat->L[j]=p;
1098          break;
1099        }
1100      }
1101      j--;
1102    }
1103  }
1104}
1105
1106/*2
1107* computes the s-polynomials L[ ].p in L and
1108* cuts elements in L above noether
1109*/
1110void updateLHC(kStrategy strat)
1111{
1112
1113  int i = 0;
1114  kTest_TS(strat);
1115  while (i <= strat->Ll)
1116  {
1117    if (pNext(strat->L[i].p) == strat->tail)
1118    {
1119       /*- deletes the int spoly and computes -*/
1120      if (pLmCmp(strat->L[i].p,strat->kNoether) == -1)
1121      {
1122        if (rField_is_Ring(currRing))
1123          pLmDelete(strat->L[i].p);
1124        else
1125          pLmFree(strat->L[i].p);
1126        strat->L[i].p = NULL;
1127      }
1128      else
1129      {
1130        if (rField_is_Ring(currRing))
1131          pLmDelete(strat->L[i].p);
1132        else
1133          pLmFree(strat->L[i].p);
1134        strat->L[i].p = NULL;
1135        poly m1 = NULL, m2 = NULL;
1136        // check that spoly creation is ok
1137        while (strat->tailRing != currRing &&
1138               !kCheckSpolyCreation(&(strat->L[i]), strat, m1, m2))
1139        {
1140          assume(m1 == NULL && m2 == NULL);
1141          // if not, change to a ring where exponents are at least
1142          // large enough
1143          kStratChangeTailRing(strat);
1144        }
1145        /* create the real one */
1146        ksCreateSpoly(&(strat->L[i]), strat->kNoetherTail(), FALSE,
1147                      strat->tailRing, m1, m2, strat->R);
1148        if (! strat->L[i].IsNull())
1149        {
1150          strat->L[i].SetLmCurrRing();
1151          strat->L[i].SetpFDeg();
1152          strat->L[i].ecart
1153            = strat->L[i].pLDeg(strat->LDegLast) - strat->L[i].GetpFDeg();
1154          if (strat->use_buckets) strat->L[i].PrepareRed(TRUE);
1155        }
1156      }
1157    }
1158    else
1159      deleteHC(&(strat->L[i]), strat);
1160    if (strat->L[i].IsNull())
1161      deleteInL(strat->L,&strat->Ll,i,strat);
1162    else
1163    {
1164#ifdef KDEBUG
1165      kTest_L(&(strat->L[i]), strat->tailRing, TRUE, i, strat->T, strat->tl);
1166#endif
1167      i++;
1168    }
1169  }
1170  kTest_TS(strat);
1171}
1172
1173/*2
1174* cuts in T above strat->kNoether and tries to cancel a unit
1175* changes also S as S is a subset of T
1176*/
1177void updateT(kStrategy strat)
1178{
1179  int i = 0;
1180  LObject p;
1181
1182  while (i <= strat->tl)
1183  {
1184    p = strat->T[i];
1185    deleteHC(&p,strat, TRUE);
1186    /*- tries to cancel a unit: -*/
1187    cancelunit(&p);
1188    if (TEST_OPT_INTSTRATEGY) /* deleteHC and/or cancelunit may have changed p*/
1189      p.pCleardenom();
1190    if (p.p != strat->T[i].p)
1191    {
1192      strat->sevT[i] = pGetShortExpVector(p.p);
1193      p.SetpFDeg();
1194    }
1195    strat->T[i] = p;
1196    i++;
1197  }
1198}
1199
1200/*2
1201* arranges red, pos and T if strat->kHEdgeFound (first time)
1202*/
1203void firstUpdate(kStrategy strat)
1204{
1205  if (strat->update)
1206  {
1207    kTest_TS(strat);
1208    strat->update = (strat->tl == -1);
1209    if (TEST_OPT_WEIGHTM)
1210    {
1211      pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
1212      if (strat->tailRing != currRing)
1213      {
1214        strat->tailRing->pFDeg = strat->pOrigFDeg_TailRing;
1215        strat->tailRing->pLDeg = strat->pOrigLDeg_TailRing;
1216      }
1217      int i;
1218      for (i=strat->Ll; i>=0; i--)
1219      {
1220        strat->L[i].SetpFDeg();
1221      }
1222      for (i=strat->tl; i>=0; i--)
1223      {
1224        strat->T[i].SetpFDeg();
1225      }
1226      if (ecartWeights)
1227      {
1228        omFreeSize((ADDRESS)ecartWeights,(rVar(currRing)+1)*sizeof(short));
1229        ecartWeights=NULL;
1230      }
1231    }
1232    if (TEST_OPT_FASTHC)
1233    {
1234      strat->posInL = strat->posInLOld;
1235      strat->lastAxis = 0;
1236    }
1237    if (TEST_OPT_FINDET)
1238      return;
1239
1240    if ( (!rField_is_Ring(currRing)) || (rHasGlobalOrdering(currRing)))
1241    {
1242      strat->red = redFirst;
1243      strat->use_buckets = kMoraUseBucket(strat);
1244    }
1245    updateT(strat);
1246
1247    if ( (!rField_is_Ring(currRing)) || (rHasGlobalOrdering(currRing)))
1248    {
1249      strat->posInT = posInT2;
1250      reorderT(strat);
1251    }
1252  }
1253  kTest_TS(strat);
1254}
1255
1256/*2
1257*-puts p to the standardbasis s at position at
1258*-reduces the tail of p if TEST_OPT_REDTAIL
1259*-tries to cancel a unit
1260*-HEckeTest
1261*  if TRUE
1262*  - decides about reduction-strategies
1263*  - computes noether
1264*  - stops computation if TEST_OPT_FINDET
1265*  - cuts the tails of the polynomials
1266*    in s,t and the elements in L above noether
1267*    and cancels units if possible
1268*  - reorders s,L
1269*/
1270void enterSMora (LObject &p,int atS,kStrategy strat, int atR = -1)
1271{
1272  enterSBba(p, atS, strat, atR);
1273  #ifdef KDEBUG
1274  if (TEST_OPT_DEBUG)
1275  {
1276    Print("new s%d:",atS);
1277    p_wrp(p.p,currRing,strat->tailRing);
1278    PrintLn();
1279  }
1280  #endif
1281  if ((!strat->kHEdgeFound) || (strat->kNoether!=NULL)) HEckeTest(p.p,strat);
1282  if (strat->kHEdgeFound)
1283  {
1284    if (newHEdge(strat))
1285    {
1286      firstUpdate(strat);
1287      if (TEST_OPT_FINDET)
1288        return;
1289
1290      /*- cuts elements in L above noether and reorders L -*/
1291      updateLHC(strat);
1292      /*- reorders L with respect to posInL -*/
1293      reorderL(strat);
1294    }
1295  }
1296  else if (strat->kNoether!=NULL)
1297    strat->kHEdgeFound = TRUE;
1298  else if (TEST_OPT_FASTHC)
1299  {
1300    if (strat->posInLOldFlag)
1301    {
1302      missingAxis(&strat->lastAxis,strat);
1303      if (strat->lastAxis)
1304      {
1305        strat->posInLOld = strat->posInL;
1306        strat->posInLOldFlag = FALSE;
1307        strat->posInL = posInL10;
1308        strat->posInLDependsOnLength = TRUE;
1309        updateL(strat);
1310        reorderL(strat);
1311      }
1312    }
1313    else if (strat->lastAxis)
1314      updateL(strat);
1315  }
1316}
1317
1318/*2
1319*-puts p to the standardbasis s at position at
1320*-HEckeTest
1321*  if TRUE
1322*  - computes noether
1323*/
1324void enterSMoraNF (LObject &p, int atS,kStrategy strat, int atR = -1)
1325{
1326  enterSBba(p, atS, strat, atR);
1327  if ((!strat->kHEdgeFound) || (strat->kNoether!=NULL)) HEckeTest(p.p,strat);
1328  if (strat->kHEdgeFound)
1329    newHEdge(strat);
1330  else if (strat->kNoether!=NULL)
1331    strat->kHEdgeFound = TRUE;
1332}
1333
1334void initBba(kStrategy strat)
1335{
1336 /* setting global variables ------------------- */
1337  strat->enterS = enterSBba;
1338    strat->red = redHoney;
1339  if (strat->honey)
1340    strat->red = redHoney;
1341  else if (currRing->pLexOrder && !strat->homog)
1342    strat->red = redLazy;
1343  else
1344  {
1345    strat->LazyPass *=4;
1346    strat->red = redHomog;
1347  }
1348  if (rField_is_Ring(currRing))
1349  {
1350    if (rField_is_Z(currRing))
1351      strat->red = redRing_Z;
1352    else
1353      strat->red = redRing;
1354  }
1355  if (currRing->pLexOrder && strat->honey)
1356    strat->initEcart = initEcartNormal;
1357  else
1358    strat->initEcart = initEcartBBA;
1359  if (strat->honey)
1360    strat->initEcartPair = initEcartPairMora;
1361  else
1362    strat->initEcartPair = initEcartPairBba;
1363//  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1364//  {
1365//    //interred  machen   Aenderung
1366//    strat->pOrigFDeg=pFDeg;
1367//    strat->pOrigLDeg=pLDeg;
1368//    //h=ggetid("ecart");
1369//    //if ((h!=NULL) /*&& (IDTYP(h)==INTVEC_CMD)*/)
1370//    //{
1371//    //  ecartWeights=iv2array(IDINTVEC(h));
1372//    //}
1373//    //else
1374//    {
1375//      ecartWeights=(short *)omAlloc(((currRing->N)+1)*sizeof(short));
1376//      /*uses automatic computation of the ecartWeights to set them*/
1377//      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
1378//    }
1379//    pRestoreDegProcs(currRing,totaldegreeWecart, maxdegreeWecart);
1380//    if (TEST_OPT_PROT)
1381//    {
1382//      for(i=1; i<=(currRing->N); i++)
1383//        Print(" %d",ecartWeights[i]);
1384//      PrintLn();
1385//      mflush();
1386//    }
1387//  }
1388}
1389
1390void initSba(ideal F,kStrategy strat)
1391{
1392  int i;
1393  //idhdl h;
1394 /* setting global variables ------------------- */
1395  strat->enterS = enterSSba;
1396    strat->red2 = redHoney;
1397  if (strat->honey)
1398    strat->red2 = redHoney;
1399  else if (currRing->pLexOrder && !strat->homog)
1400    strat->red2 = redLazy;
1401  else
1402  {
1403    strat->LazyPass *=4;
1404    strat->red2 = redHomog;
1405  }
1406  if (rField_is_Ring(currRing))
1407  {
1408    if(rHasLocalOrMixedOrdering(currRing))
1409      {strat->red2 = redRiloc;}
1410    else
1411      {strat->red2 = redRing;}
1412  }
1413  if (currRing->pLexOrder && strat->honey)
1414    strat->initEcart = initEcartNormal;
1415  else
1416    strat->initEcart = initEcartBBA;
1417  if (strat->honey)
1418    strat->initEcartPair = initEcartPairMora;
1419  else
1420    strat->initEcartPair = initEcartPairBba;
1421  //strat->kIdeal = NULL;
1422  //if (strat->ak==0) strat->kIdeal->rtyp=IDEAL_CMD;
1423  //else              strat->kIdeal->rtyp=MODUL_CMD;
1424  //strat->kIdeal->data=(void *)strat->Shdl;
1425  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1426  {
1427    //interred  machen   Aenderung
1428    strat->pOrigFDeg  = currRing->pFDeg;
1429    strat->pOrigLDeg  = currRing->pLDeg;
1430    //h=ggetid("ecart");
1431    //if ((h!=NULL) /*&& (IDTYP(h)==INTVEC_CMD)*/)
1432    //{
1433    //  ecartWeights=iv2array(IDINTVEC(h));
1434    //}
1435    //else
1436    {
1437      ecartWeights=(short *)omAlloc(((currRing->N)+1)*sizeof(short));
1438      /*uses automatic computation of the ecartWeights to set them*/
1439      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights, currRing);
1440    }
1441    pRestoreDegProcs(currRing, totaldegreeWecart, maxdegreeWecart);
1442    if (TEST_OPT_PROT)
1443    {
1444      for(i=1; i<=(currRing->N); i++)
1445        Print(" %d",ecartWeights[i]);
1446      PrintLn();
1447      mflush();
1448    }
1449  }
1450  // for sig-safe reductions in signature-based
1451  // standard basis computations
1452  if(rField_is_Ring(currRing))
1453    strat->red = redSigRing;
1454  else
1455    strat->red        = redSig;
1456  //strat->sbaOrder  = 1;
1457  strat->currIdx      = 1;
1458}
1459
1460void initMora(ideal F,kStrategy strat)
1461{
1462  int i,j;
1463
1464  strat->NotUsedAxis = (BOOLEAN *)omAlloc(((currRing->N)+1)*sizeof(BOOLEAN));
1465  for (j=(currRing->N); j>0; j--) strat->NotUsedAxis[j] = TRUE;
1466  strat->enterS = enterSMora;
1467  strat->initEcartPair = initEcartPairMora; /*- ecart approximation -*/
1468  strat->posInLOld = strat->posInL;
1469  strat->posInLOldFlag = TRUE;
1470  strat->initEcart = initEcartNormal;
1471  strat->kHEdgeFound = (currRing->ppNoether) != NULL;
1472  if ( strat->kHEdgeFound )
1473     strat->kNoether = pCopy((currRing->ppNoether));
1474  else if (strat->kHEdgeFound || strat->homog)
1475    strat->red = redFirst;  /*take the first possible in T*/
1476  else
1477    strat->red = redEcart;/*take the first possible in under ecart-restriction*/
1478  if (strat->kHEdgeFound)
1479  {
1480    strat->HCord = currRing->pFDeg((currRing->ppNoether),currRing)+1;
1481    strat->posInT = posInT2;
1482  }
1483  else
1484  {
1485    strat->HCord = 32000;/*- very large -*/
1486  }
1487
1488  if (rField_is_Ring(currRing))
1489    strat->red = redRiloc;
1490
1491  /*reads the ecartWeights used for Graebes method from the
1492   *intvec ecart and set ecartWeights
1493   */
1494  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1495  {
1496    //interred  machen   Aenderung
1497    strat->pOrigFDeg=currRing->pFDeg;
1498    strat->pOrigLDeg=currRing->pLDeg;
1499    ecartWeights=(short *)omAlloc(((currRing->N)+1)*sizeof(short));
1500    /*uses automatic computation of the ecartWeights to set them*/
1501    kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights,currRing);
1502
1503    pSetDegProcs(currRing,totaldegreeWecart, maxdegreeWecart);
1504    if (TEST_OPT_PROT)
1505    {
1506      for(i=1; i<=(currRing->N); i++)
1507        Print(" %d",ecartWeights[i]);
1508      PrintLn();
1509      mflush();
1510    }
1511  }
1512  kOptimizeLDeg(currRing->pLDeg, strat);
1513}
1514
1515void kDebugPrint(kStrategy strat);
1516
1517ideal mora (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
1518{
1519  int olddeg = 0;
1520  int reduc = 0;
1521  int red_result = 1;
1522  int hilbeledeg=1,hilbcount=0;
1523  BITSET save1;
1524  SI_SAVE_OPT1(save1);
1525  if (rHasMixedOrdering(currRing))
1526  {
1527    si_opt_1 &= ~Sy_bit(OPT_REDSB);
1528    si_opt_1 &= ~Sy_bit(OPT_REDTAIL);
1529  }
1530
1531  strat->update = TRUE;
1532  /*- setting global variables ------------------- -*/
1533  initBuchMoraCrit(strat);
1534  initHilbCrit(F,Q,&hilb,strat);
1535  initMora(F,strat);
1536  if(rField_is_Ring(currRing))
1537    initBuchMoraPosRing(strat);
1538  else
1539    initBuchMoraPos(strat);
1540  /*Shdl=*/initBuchMora(F,Q,strat);
1541  if (TEST_OPT_FASTHC) missingAxis(&strat->lastAxis,strat);
1542  /*updateS in initBuchMora has Hecketest
1543  * and could have put strat->kHEdgdeFound FALSE*/
1544  if ((currRing->ppNoether)!=NULL)
1545  {
1546    strat->kHEdgeFound = TRUE;
1547  }
1548  if (strat->kHEdgeFound && strat->update)
1549  {
1550    firstUpdate(strat);
1551    updateLHC(strat);
1552    reorderL(strat);
1553  }
1554  if (TEST_OPT_FASTHC && (strat->lastAxis) && strat->posInLOldFlag)
1555  {
1556    strat->posInLOld = strat->posInL;
1557    strat->posInLOldFlag = FALSE;
1558    strat->posInL = posInL10;
1559    updateL(strat);
1560    reorderL(strat);
1561  }
1562  kTest_TS(strat);
1563  strat->use_buckets = kMoraUseBucket(strat);
1564
1565#ifdef HAVE_TAIL_RING
1566  if (strat->homog && strat->red == redFirst)
1567    if(!idIs0(F) &&(!rField_is_Ring(currRing)))
1568      kStratInitChangeTailRing(strat);
1569#endif
1570
1571  if (BVERBOSE(23))
1572  {
1573    kDebugPrint(strat);
1574  }
1575//deleteInL(strat->L,&strat->Ll,1,strat);
1576//deleteInL(strat->L,&strat->Ll,0,strat);
1577
1578  /*- compute-------------------------------------------*/
1579  while (strat->Ll >= 0)
1580  {
1581    #ifdef KDEBUG
1582    if (TEST_OPT_DEBUG) messageSets(strat);
1583    #endif
1584    if (siCntrlc)
1585    {
1586      while (strat->Ll >= 0)
1587        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1588      strat->noClearS=TRUE;
1589    }
1590    if (TEST_OPT_DEGBOUND
1591    && (strat->L[strat->Ll].ecart+strat->L[strat->Ll].GetpFDeg()> Kstd1_deg))
1592    {
1593      /*
1594      * stops computation if
1595      * - 24 (degBound)
1596      *   && upper degree is bigger than Kstd1_deg
1597      */
1598      while ((strat->Ll >= 0)
1599        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1600        && (strat->L[strat->Ll].ecart+strat->L[strat->Ll].GetpFDeg()> Kstd1_deg)
1601      )
1602      {
1603        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1604        //if (TEST_OPT_PROT)
1605        //{
1606        //   PrintS("D"); mflush();
1607        //}
1608      }
1609      if (strat->Ll<0) break;
1610      else strat->noClearS=TRUE;
1611    }
1612    strat->P = strat->L[strat->Ll];/*- picks the last element from the lazyset L -*/
1613    if (strat->Ll==0) strat->interpt=TRUE;
1614    strat->Ll--;
1615    // create the real Spoly
1616    if (pNext(strat->P.p) == strat->tail)
1617    {
1618      /*- deletes the short spoly and computes -*/
1619      if (rField_is_Ring(currRing))
1620        pLmDelete(strat->P.p);
1621      else
1622        pLmFree(strat->P.p);
1623      strat->P.p = NULL;
1624      poly m1 = NULL, m2 = NULL;
1625      // check that spoly creation is ok
1626      while (strat->tailRing != currRing &&
1627             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1628      {
1629        assume(m1 == NULL && m2 == NULL);
1630        // if not, change to a ring where exponents are large enough
1631        kStratChangeTailRing(strat);
1632      }
1633      /* create the real one */
1634      ksCreateSpoly(&(strat->P), strat->kNoetherTail(), strat->use_buckets,
1635                    strat->tailRing, m1, m2, strat->R);
1636      if (!strat->use_buckets)
1637        strat->P.SetLength(strat->length_pLength);
1638    }
1639    else if (strat->P.p1 == NULL)
1640    {
1641      // for input polys, prepare reduction (buckets !)
1642      strat->P.SetLength(strat->length_pLength);
1643      strat->P.PrepareRed(strat->use_buckets);
1644    }
1645
1646    // the s-poly
1647    if (!strat->P.IsNull())
1648    {
1649      // might be NULL from noether !!!
1650      if (TEST_OPT_PROT)
1651        message(strat->P.ecart+strat->P.GetpFDeg(),&olddeg,&reduc,strat, red_result);
1652      // reduce
1653      red_result = strat->red(&strat->P,strat);
1654    }
1655
1656    // the reduced s-poly
1657    if (! strat->P.IsNull())
1658    {
1659      strat->P.GetP();
1660      // statistics
1661      if (TEST_OPT_PROT) PrintS("s");
1662      // normalization
1663      if (TEST_OPT_INTSTRATEGY)
1664        strat->P.pCleardenom();
1665      else
1666        strat->P.pNorm();
1667      // tailreduction
1668      strat->P.p = redtail(&(strat->P),strat->sl,strat);
1669      if (strat->P.p==NULL)
1670      {
1671        WerrorS("expoent overflow - wrong ordering");
1672        return(idInit(1,1));
1673      }
1674      // set ecart -- might have changed because of tail reductions
1675      if ((!strat->noTailReduction) && (!strat->honey))
1676        strat->initEcart(&strat->P);
1677      // cancel unit
1678      cancelunit(&strat->P);
1679      // for char 0, clear denominators
1680      if ((strat->P.p->next==NULL) /* i.e. cancelunit did something*/
1681      && TEST_OPT_INTSTRATEGY)
1682        strat->P.pCleardenom();
1683
1684      enterT(strat->P,strat);
1685      // build new pairs
1686      if (rField_is_Ring(currRing))
1687        superenterpairs(strat->P.p,strat->sl,strat->P.ecart,0,strat, strat->tl);
1688      else
1689        enterpairs(strat->P.p,strat->sl,strat->P.ecart,0,strat, strat->tl);
1690      // put in S
1691      strat->enterS(strat->P,
1692                    posInS(strat,strat->sl,strat->P.p, strat->P.ecart),
1693                    strat, strat->tl);
1694      // apply hilbert criterion
1695      if (hilb!=NULL)
1696      {
1697        if (strat->homog==isHomog)
1698          khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1699        else
1700          khCheckLocInhom(Q,w,hilb,hilbcount,strat);
1701      }
1702
1703      // clear strat->P
1704      kDeleteLcm(&strat->P);
1705
1706#ifdef KDEBUG
1707      // make sure kTest_TS does not complain about strat->P
1708      memset(&strat->P,0,sizeof(strat->P));
1709#endif
1710    }
1711    if (strat->kHEdgeFound)
1712    {
1713      if ((TEST_OPT_FINDET)
1714      || ((TEST_OPT_MULTBOUND) && (scMult0Int(strat->Shdl,NULL,strat->tailRing) < Kstd1_mu)))
1715      {
1716        // obachman: is this still used ???
1717        /*
1718        * stops computation if strat->kHEdgeFound and
1719        * - 27 (finiteDeterminacyTest)
1720        * or
1721        * - 23
1722        *   (multBound)
1723        *   && multiplicity of the ideal is smaller then a predefined number mu
1724        */
1725        while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1726      }
1727    }
1728    kTest_TS(strat);
1729  }
1730  /*- complete reduction of the standard basis------------------------ -*/
1731  if (TEST_OPT_REDSB) completeReduce(strat);
1732  else if (TEST_OPT_PROT) PrintLn();
1733  /*- release temp data------------------------------- -*/
1734  exitBuchMora(strat);
1735  /*- polynomials used for HECKE: HC, noether -*/
1736  if (TEST_OPT_FINDET)
1737  {
1738    if (strat->kHEdge!=NULL)
1739      Kstd1_mu=currRing->pFDeg(strat->kHEdge,currRing);
1740    else
1741      Kstd1_mu=-1;
1742  }
1743  if (strat->kHEdge!=NULL) pLmFree(&strat->kHEdge);
1744  strat->update = TRUE; //???
1745  strat->lastAxis = 0; //???
1746  if (strat->kNoether!=NULL) pLmDelete(&strat->kNoether);
1747  omFreeSize((ADDRESS)strat->NotUsedAxis,((currRing->N)+1)*sizeof(BOOLEAN));
1748  if ((TEST_OPT_PROT)||(TEST_OPT_DEBUG))  messageStat(hilbcount,strat);
1749//  if (TEST_OPT_WEIGHTM)
1750//  {
1751//    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
1752//    if (ecartWeights)
1753//    {
1754//      omFreeSize((ADDRESS)ecartWeights,((currRing->N)+1)*sizeof(short));
1755//      ecartWeights=NULL;
1756//    }
1757//  }
1758  if(nCoeff_is_Z(currRing->cf))
1759    finalReduceByMon(strat);
1760  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1761  SI_RESTORE_OPT1(save1);
1762  idTest(strat->Shdl);
1763  return (strat->Shdl);
1764}
1765
1766poly kNF1 (ideal F,ideal Q,poly q, kStrategy strat, int lazyReduce)
1767{
1768  assume(q!=NULL);
1769  assume(!(idIs0(F)&&(Q==NULL)));
1770
1771// lazy_reduce flags: can be combined by |
1772//#define KSTD_NF_LAZY   1
1773  // do only a reduction of the leading term
1774//#define KSTD_NF_ECART  2
1775  // only local: recude even with bad ecart
1776  poly   p;
1777  int   i;
1778  int   j;
1779  int   o;
1780  LObject   h;
1781  BITSET save1;
1782  SI_SAVE_OPT1(save1);
1783
1784  //if ((idIs0(F))&&(Q==NULL))
1785  //  return pCopy(q); /*F=0*/
1786  //strat->ak = si_max(idRankFreeModule(F),pMaxComp(q));
1787  /*- creating temp data structures------------------- -*/
1788  strat->kHEdgeFound = (currRing->ppNoether) != NULL;
1789  strat->kNoether    = pCopy((currRing->ppNoether));
1790  si_opt_1|=Sy_bit(OPT_REDTAIL);
1791  si_opt_1&=~Sy_bit(OPT_INTSTRATEGY);
1792  if (TEST_OPT_STAIRCASEBOUND
1793  && (! TEST_V_DEG_STOP)
1794  && (0<Kstd1_deg)
1795  && ((!strat->kHEdgeFound)
1796    ||(TEST_OPT_DEGBOUND && (pWTotaldegree(strat->kNoether)<Kstd1_deg))))
1797  {
1798    pLmDelete(&strat->kNoether);
1799    strat->kNoether=pOne();
1800    pSetExp(strat->kNoether,1, Kstd1_deg+1);
1801    pSetm(strat->kNoether);
1802    strat->kHEdgeFound=TRUE;
1803  }
1804  initBuchMoraCrit(strat);
1805  if(rField_is_Ring(currRing))
1806    initBuchMoraPosRing(strat);
1807  else
1808    initBuchMoraPos(strat);
1809  initMora(F,strat);
1810  strat->enterS = enterSMoraNF;
1811  /*- set T -*/
1812  strat->tl = -1;
1813  strat->tmax = setmaxT;
1814  strat->T = initT();
1815  strat->R = initR();
1816  strat->sevT = initsevT();
1817  /*- set S -*/
1818  strat->sl = -1;
1819  /*- init local data struct.-------------------------- -*/
1820  /*Shdl=*/initS(F,Q,strat);
1821  if ((strat->ak!=0)
1822  && (strat->kHEdgeFound))
1823  {
1824    if (strat->ak!=1)
1825    {
1826      pSetComp(strat->kNoether,1);
1827      pSetmComp(strat->kNoether);
1828      poly p=pHead(strat->kNoether);
1829      pSetComp(p,strat->ak);
1830      pSetmComp(p);
1831      p=pAdd(strat->kNoether,p);
1832      strat->kNoether=pNext(p);
1833      p_LmDelete(p,currRing);
1834    }
1835  }
1836  if ((lazyReduce & KSTD_NF_LAZY)==0)
1837  {
1838    for (i=strat->sl; i>=0; i--)
1839      pNorm(strat->S[i]);
1840  }
1841  /*- puts the elements of S also to T -*/
1842  for (i=0; i<=strat->sl; i++)
1843  {
1844    h.p = strat->S[i];
1845    h.ecart = strat->ecartS[i];
1846    if (strat->sevS[i] == 0) strat->sevS[i] = pGetShortExpVector(h.p);
1847    else assume(strat->sevS[i] == pGetShortExpVector(h.p));
1848    h.length = pLength(h.p);
1849    h.sev = strat->sevS[i];
1850    h.SetpFDeg();
1851    enterT(h,strat);
1852  }
1853#ifdef KDEBUG
1854//  kDebugPrint(strat);
1855#endif
1856  /*- compute------------------------------------------- -*/
1857  p = pCopy(q);
1858  deleteHC(&p,&o,&j,strat);
1859  kTest(strat);
1860  if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
1861  if (BVERBOSE(23)) kDebugPrint(strat);
1862  if(rField_is_Ring(currRing))
1863  {
1864    if (p!=NULL) p = redMoraNFRing(p,strat, lazyReduce & KSTD_NF_ECART);
1865  }
1866  else
1867  {
1868    if (p!=NULL) p = redMoraNF(p,strat, lazyReduce & KSTD_NF_ECART);
1869  }
1870  if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
1871  {
1872    if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
1873    p = redtail(p,strat->sl,strat);
1874  }
1875  /*- release temp data------------------------------- -*/
1876  cleanT(strat);
1877  assume(strat->L==NULL); /*strat->L unsed */
1878  assume(strat->B==NULL); /*strat->B unused */
1879  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
1880  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
1881  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
1882  omFreeSize((ADDRESS)strat->NotUsedAxis,((currRing->N)+1)*sizeof(BOOLEAN));
1883  omFree(strat->sevT);
1884  omFree(strat->S_2_R);
1885  omFree(strat->R);
1886
1887  if ((Q!=NULL)&&(strat->fromQ!=NULL))
1888  {
1889    i=((IDELEMS(Q)+IDELEMS(F)+15)/16)*16;
1890    omFreeSize((ADDRESS)strat->fromQ,i*sizeof(int));
1891    strat->fromQ=NULL;
1892  }
1893  if (strat->kHEdge!=NULL) pLmFree(&strat->kHEdge);
1894  if (strat->kNoether!=NULL) pLmDelete(&strat->kNoether);
1895//  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1896//  {
1897//    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
1898//    if (ecartWeights)
1899//    {
1900//      omFreeSize((ADDRESS *)&ecartWeights,((currRing->N)+1)*sizeof(short));
1901//      ecartWeights=NULL;
1902//    }
1903//  }
1904  idDelete(&strat->Shdl);
1905  SI_RESTORE_OPT1(save1);
1906  if (TEST_OPT_PROT) PrintLn();
1907  return p;
1908}
1909
1910ideal kNF1 (ideal F,ideal Q,ideal q, kStrategy strat, int lazyReduce)
1911{
1912  assume(!idIs0(q));
1913  assume(!(idIs0(F)&&(Q==NULL)));
1914
1915// lazy_reduce flags: can be combined by |
1916//#define KSTD_NF_LAZY   1
1917  // do only a reduction of the leading term
1918//#define KSTD_NF_ECART  2
1919  // only local: recude even with bad ecart
1920  poly   p;
1921  int   i;
1922  int   j;
1923  int   o;
1924  LObject   h;
1925  ideal res;
1926  BITSET save1;
1927  SI_SAVE_OPT1(save1);
1928
1929  //if (idIs0(q)) return idInit(IDELEMS(q),si_max(q->rank,F->rank));
1930  //if ((idIs0(F))&&(Q==NULL))
1931  //  return idCopy(q); /*F=0*/
1932  //strat->ak = si_max(idRankFreeModule(F),idRankFreeModule(q));
1933  /*- creating temp data structures------------------- -*/
1934  strat->kHEdgeFound = (currRing->ppNoether) != NULL;
1935  strat->kNoether=pCopy((currRing->ppNoether));
1936  si_opt_1|=Sy_bit(OPT_REDTAIL);
1937  if (TEST_OPT_STAIRCASEBOUND
1938  && (0<Kstd1_deg)
1939  && ((!strat->kHEdgeFound)
1940    ||(TEST_OPT_DEGBOUND && (pWTotaldegree(strat->kNoether)<Kstd1_deg))))
1941  {
1942    pLmDelete(&strat->kNoether);
1943    strat->kNoether=pOne();
1944    pSetExp(strat->kNoether,1, Kstd1_deg+1);
1945    pSetm(strat->kNoether);
1946    strat->kHEdgeFound=TRUE;
1947  }
1948  initBuchMoraCrit(strat);
1949  if(rField_is_Ring(currRing))
1950    initBuchMoraPosRing(strat);
1951  else
1952    initBuchMoraPos(strat);
1953  initMora(F,strat);
1954  strat->enterS = enterSMoraNF;
1955  /*- set T -*/
1956  strat->tl = -1;
1957  strat->tmax = setmaxT;
1958  strat->T = initT();
1959  strat->R = initR();
1960  strat->sevT = initsevT();
1961  /*- set S -*/
1962  strat->sl = -1;
1963  /*- init local data struct.-------------------------- -*/
1964  /*Shdl=*/initS(F,Q,strat);
1965  if ((strat->ak!=0)
1966  && (strat->kHEdgeFound))
1967  {
1968    if (strat->ak!=1)
1969    {
1970      pSetComp(strat->kNoether,1);
1971      pSetmComp(strat->kNoether);
1972      poly p=pHead(strat->kNoether);
1973      pSetComp(p,strat->ak);
1974      pSetmComp(p);
1975      p=pAdd(strat->kNoether,p);
1976      strat->kNoether=pNext(p);
1977      p_LmDelete(p,currRing);
1978    }
1979  }
1980  if (TEST_OPT_INTSTRATEGY && ((lazyReduce & KSTD_NF_LAZY)==0))
1981  {
1982    for (i=strat->sl; i>=0; i--)
1983      pNorm(strat->S[i]);
1984  }
1985  /*- compute------------------------------------------- -*/
1986  res=idInit(IDELEMS(q),strat->ak);
1987  for (i=0; i<IDELEMS(q); i++)
1988  {
1989    if (q->m[i]!=NULL)
1990    {
1991      p = pCopy(q->m[i]);
1992      deleteHC(&p,&o,&j,strat);
1993      if (p!=NULL)
1994      {
1995        /*- puts the elements of S also to T -*/
1996        for (j=0; j<=strat->sl; j++)
1997        {
1998          h.p = strat->S[j];
1999          h.ecart = strat->ecartS[j];
2000          h.pLength = h.length = pLength(h.p);
2001          if (strat->sevS[j] == 0) strat->sevS[j] = pGetShortExpVector(h.p);
2002          else assume(strat->sevS[j] == pGetShortExpVector(h.p));
2003          h.sev = strat->sevS[j];
2004          h.SetpFDeg();
2005          if(rField_is_Ring(currRing) && rHasLocalOrMixedOrdering(currRing))
2006            enterT_strong(h,strat);
2007          else
2008            enterT(h,strat);
2009        }
2010        if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
2011        if(rField_is_Ring(currRing))
2012        {
2013          p = redMoraNFRing(p,strat, lazyReduce & KSTD_NF_ECART);
2014        }
2015        else
2016          p = redMoraNF(p,strat, lazyReduce & KSTD_NF_ECART);
2017        if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
2018        {
2019          if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
2020          p = redtail(p,strat->sl,strat);
2021        }
2022        cleanT(strat);
2023      }
2024      res->m[i]=p;
2025    }
2026    //else
2027    //  res->m[i]=NULL;
2028  }
2029  /*- release temp data------------------------------- -*/
2030  assume(strat->L==NULL); /*strat->L unsed */
2031  assume(strat->B==NULL); /*strat->B unused */
2032  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
2033  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
2034  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
2035  omFreeSize((ADDRESS)strat->NotUsedAxis,((currRing->N)+1)*sizeof(BOOLEAN));
2036  omFree(strat->sevT);
2037  omFree(strat->S_2_R);
2038  omFree(strat->R);
2039  if ((Q!=NULL)&&(strat->fromQ!=NULL))
2040  {
2041    i=((IDELEMS(F)+IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
2042    omFreeSize((ADDRESS)strat->fromQ,i*sizeof(int));
2043    strat->fromQ=NULL;
2044  }
2045  if (strat->kHEdge!=NULL) pLmFree(&strat->kHEdge);
2046  if (strat->kNoether!=NULL) pLmDelete(&strat->kNoether);
2047//  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
2048//  {
2049//    pFDeg=strat->pOrigFDeg;
2050//    pLDeg=strat->pOrigLDeg;
2051//    if (ecartWeights)
2052//    {
2053//      omFreeSize((ADDRESS *)&ecartWeights,((currRing->N)+1)*sizeof(short));
2054//      ecartWeights=NULL;
2055//    }
2056//  }
2057  idDelete(&strat->Shdl);
2058  SI_RESTORE_OPT1(save1);
2059  if (TEST_OPT_PROT) PrintLn();
2060  return res;
2061}
2062
2063VAR intvec * kModW, * kHomW;
2064
2065long kModDeg(poly p, ring r)
2066{
2067  long o=p_WDegree(p, r);
2068  long i=__p_GetComp(p, r);
2069  if (i==0) return o;
2070  //assume((i>0) && (i<=kModW->length()));
2071  if (i<=kModW->length())
2072    return o+(*kModW)[i-1];
2073  return o;
2074}
2075long kHomModDeg(poly p, ring r)
2076{
2077  int i;
2078  long j=0;
2079
2080  for (i=r->N;i>0;i--)
2081    j+=p_GetExp(p,i,r)*(*kHomW)[i-1];
2082  if (kModW == NULL) return j;
2083  i = __p_GetComp(p,r);
2084  if (i==0) return j;
2085  return j+(*kModW)[i-1];
2086}
2087
2088ideal kStd(ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
2089          int newIdeal, intvec *vw, s_poly_proc_t sp)
2090{
2091  if(idIs0(F))
2092    return idInit(1,F->rank);
2093
2094#ifdef HAVE_SHIFTBBA
2095  if(rIsLPRing(currRing)) return freegb(F);
2096#endif
2097
2098  ideal r;
2099  BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2100  BOOLEAN delete_w=(w==NULL);
2101  kStrategy strat=new skStrategy;
2102
2103  strat->s_poly=sp;
2104  if(!TEST_OPT_RETURN_SB)
2105    strat->syzComp = syzComp;
2106  if (TEST_OPT_SB_1
2107    &&(!rField_is_Ring(currRing))
2108    )
2109    strat->newIdeal = newIdeal;
2110  if (rField_has_simple_inverse(currRing))
2111    strat->LazyPass=20;
2112  else
2113    strat->LazyPass=2;
2114  strat->LazyDegree = 1;
2115  strat->ak = id_RankFreeModule(F,currRing);
2116  strat->kModW=kModW=NULL;
2117  strat->kHomW=kHomW=NULL;
2118  if (vw != NULL)
2119  {
2120    currRing->pLexOrder=FALSE;
2121    strat->kHomW=kHomW=vw;
2122    strat->pOrigFDeg = currRing->pFDeg;
2123    strat->pOrigLDeg = currRing->pLDeg;
2124    pSetDegProcs(currRing,kHomModDeg);
2125    toReset = TRUE;
2126  }
2127  if (h==testHomog)
2128  {
2129    if (strat->ak == 0)
2130    {
2131      h = (tHomog)idHomIdeal(F,Q);
2132      w=NULL;
2133    }
2134    else if (!TEST_OPT_DEGBOUND)
2135    {
2136      if (w!=NULL)
2137        h = (tHomog)idHomModule(F,Q,w);
2138      else
2139        h = (tHomog)idHomIdeal(F,Q);
2140    }
2141  }
2142  currRing->pLexOrder=b;
2143  if (h==isHomog)
2144  {
2145    if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2146    {
2147      strat->kModW = kModW = *w;
2148      if (vw == NULL)
2149      {
2150        strat->pOrigFDeg = currRing->pFDeg;
2151        strat->pOrigLDeg = currRing->pLDeg;
2152        pSetDegProcs(currRing,kModDeg);
2153        toReset = TRUE;
2154      }
2155    }
2156    currRing->pLexOrder = TRUE;
2157    if (hilb==NULL) strat->LazyPass*=2;
2158  }
2159  strat->homog=h;
2160#ifdef KDEBUG
2161  idTest(F);
2162  if (Q!=NULL) idTest(Q);
2163#endif
2164#ifdef HAVE_PLURAL
2165  if (rIsPluralRing(currRing))
2166  {
2167    const BOOLEAN bIsSCA  = rIsSCA(currRing) && strat->z2homog; // for Z_2 prod-crit
2168    strat->no_prod_crit   = ! bIsSCA;
2169    if (w!=NULL)
2170      r = nc_GB(F, Q, *w, hilb, strat, currRing);
2171    else
2172      r = nc_GB(F, Q, NULL, hilb, strat, currRing);
2173  }
2174  else
2175#endif
2176  {
2177    #if PRE_INTEGER_CHECK
2178    //the preinteger check strategy is not for modules
2179    if(nCoeff_is_Z(currRing->cf) && strat->ak <= 0)
2180    {
2181      ideal FCopy = idCopy(F);
2182      poly pFmon = preIntegerCheck(FCopy, Q);
2183      if(pFmon != NULL)
2184      {
2185        idInsertPoly(FCopy, pFmon);
2186        strat->kModW=kModW=NULL;
2187        if (h==testHomog)
2188        {
2189            if (strat->ak == 0)
2190            {
2191              h = (tHomog)idHomIdeal(FCopy,Q);
2192              w=NULL;
2193            }
2194            else if (!TEST_OPT_DEGBOUND)
2195            {
2196              if (w!=NULL)
2197                h = (tHomog)idHomModule(FCopy,Q,w);
2198              else
2199                h = (tHomog)idHomIdeal(FCopy,Q);
2200            }
2201        }
2202        currRing->pLexOrder=b;
2203        if (h==isHomog)
2204        {
2205          if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2206          {
2207            strat->kModW = kModW = *w;
2208            if (vw == NULL)
2209            {
2210              strat->pOrigFDeg = currRing->pFDeg;
2211              strat->pOrigLDeg = currRing->pLDeg;
2212              pSetDegProcs(currRing,kModDeg);
2213              toReset = TRUE;
2214            }
2215          }
2216          currRing->pLexOrder = TRUE;
2217          if (hilb==NULL) strat->LazyPass*=2;
2218        }
2219        strat->homog=h;
2220      }
2221      omTestMemory(1);
2222      if(w == NULL)
2223      {
2224        if(rHasLocalOrMixedOrdering(currRing))
2225            r=mora(FCopy,Q,NULL,hilb,strat);
2226        else
2227            r=bba(FCopy,Q,NULL,hilb,strat);
2228      }
2229      else
2230      {
2231        if(rHasLocalOrMixedOrdering(currRing))
2232            r=mora(FCopy,Q,*w,hilb,strat);
2233        else
2234            r=bba(FCopy,Q,*w,hilb,strat);
2235      }
2236      idDelete(&FCopy);
2237    }
2238    else
2239    #endif
2240    {
2241      if(w==NULL)
2242      {
2243        if(rHasLocalOrMixedOrdering(currRing))
2244          r=mora(F,Q,NULL,hilb,strat);
2245        else
2246          r=bba(F,Q,NULL,hilb,strat);
2247      }
2248      else
2249      {
2250        if(rHasLocalOrMixedOrdering(currRing))
2251          r=mora(F,Q,*w,hilb,strat);
2252        else
2253          r=bba(F,Q,*w,hilb,strat);
2254      }
2255    }
2256  }
2257#ifdef KDEBUG
2258  idTest(r);
2259#endif
2260  if (toReset)
2261  {
2262    kModW = NULL;
2263    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2264  }
2265  currRing->pLexOrder = b;
2266//Print("%d reductions canceled \n",strat->cel);
2267  HCord=strat->HCord;
2268  delete(strat);
2269  if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
2270  return r;
2271}
2272
2273ideal kSba(ideal F, ideal Q, tHomog h,intvec ** w, int sbaOrder, int arri, intvec *hilb,int syzComp,
2274          int newIdeal, intvec *vw)
2275{
2276  if(idIs0(F))
2277    return idInit(1,F->rank);
2278  if(!rField_is_Ring(currRing))
2279  {
2280    ideal r;
2281    BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2282    BOOLEAN delete_w=(w==NULL);
2283    kStrategy strat=new skStrategy;
2284    strat->sbaOrder = sbaOrder;
2285    if (arri!=0)
2286    {
2287      strat->rewCrit1 = arriRewDummy;
2288      strat->rewCrit2 = arriRewCriterion;
2289      strat->rewCrit3 = arriRewCriterionPre;
2290    }
2291    else
2292    {
2293      strat->rewCrit1 = faugereRewCriterion;
2294      strat->rewCrit2 = faugereRewCriterion;
2295      strat->rewCrit3 = faugereRewCriterion;
2296    }
2297
2298    if(!TEST_OPT_RETURN_SB)
2299      strat->syzComp = syzComp;
2300    if (TEST_OPT_SB_1)
2301      //if(!rField_is_Ring(currRing)) // always true here
2302        strat->newIdeal = newIdeal;
2303    if (rField_has_simple_inverse(currRing))
2304      strat->LazyPass=20;
2305    else
2306      strat->LazyPass=2;
2307    strat->LazyDegree = 1;
2308    strat->enterOnePair=enterOnePairNormal;
2309    strat->chainCrit=chainCritNormal;
2310    if (TEST_OPT_SB_1) strat->chainCrit=chainCritOpt_1;
2311    strat->ak = id_RankFreeModule(F,currRing);
2312    strat->kModW=kModW=NULL;
2313    strat->kHomW=kHomW=NULL;
2314    if (vw != NULL)
2315    {
2316      currRing->pLexOrder=FALSE;
2317      strat->kHomW=kHomW=vw;
2318      strat->pOrigFDeg = currRing->pFDeg;
2319      strat->pOrigLDeg = currRing->pLDeg;
2320      pSetDegProcs(currRing,kHomModDeg);
2321      toReset = TRUE;
2322    }
2323    if (h==testHomog)
2324    {
2325      if (strat->ak == 0)
2326      {
2327        h = (tHomog)idHomIdeal(F,Q);
2328        w=NULL;
2329      }
2330      else if (!TEST_OPT_DEGBOUND)
2331      {
2332        if (w!=NULL)
2333          h = (tHomog)idHomModule(F,Q,w);
2334        else
2335          h = (tHomog)idHomIdeal(F,Q);
2336      }
2337    }
2338    currRing->pLexOrder=b;
2339    if (h==isHomog)
2340    {
2341      if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2342      {
2343        strat->kModW = kModW = *w;
2344        if (vw == NULL)
2345        {
2346          strat->pOrigFDeg = currRing->pFDeg;
2347          strat->pOrigLDeg = currRing->pLDeg;
2348          pSetDegProcs(currRing,kModDeg);
2349          toReset = TRUE;
2350        }
2351      }
2352      currRing->pLexOrder = TRUE;
2353      if (hilb==NULL) strat->LazyPass*=2;
2354    }
2355    strat->homog=h;
2356  #ifdef KDEBUG
2357    idTest(F);
2358    if(Q != NULL)
2359      idTest(Q);
2360  #endif
2361  #ifdef HAVE_PLURAL
2362    if (rIsPluralRing(currRing))
2363    {
2364      const BOOLEAN bIsSCA  = rIsSCA(currRing) && strat->z2homog; // for Z_2 prod-crit
2365      strat->no_prod_crit   = ! bIsSCA;
2366      if (w!=NULL)
2367        r = nc_GB(F, Q, *w, hilb, strat, currRing);
2368      else
2369        r = nc_GB(F, Q, NULL, hilb, strat, currRing);
2370    }
2371    else
2372  #endif
2373    {
2374      if (rHasLocalOrMixedOrdering(currRing))
2375      {
2376        if (w!=NULL)
2377          r=mora(F,Q,*w,hilb,strat);
2378        else
2379          r=mora(F,Q,NULL,hilb,strat);
2380      }
2381      else
2382      {
2383        strat->sigdrop = FALSE;
2384        if (w!=NULL)
2385          r=sba(F,Q,*w,hilb,strat);
2386        else
2387          r=sba(F,Q,NULL,hilb,strat);
2388      }
2389    }
2390  #ifdef KDEBUG
2391    idTest(r);
2392  #endif
2393    if (toReset)
2394    {
2395      kModW = NULL;
2396      pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2397    }
2398    currRing->pLexOrder = b;
2399  //Print("%d reductions canceled \n",strat->cel);
2400    HCord=strat->HCord;
2401    //delete(strat);
2402    if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
2403    return r;
2404  }
2405  else
2406  {
2407    //--------------------------RING CASE-------------------------
2408    assume(sbaOrder == 1);
2409    assume(arri == 0);
2410    ideal r;
2411    r = idCopy(F);
2412    int sbaEnterS = -1;
2413    bool sigdrop = TRUE;
2414    //This is how we set the SBA algorithm;
2415    int totalsbaruns = 1,blockedreductions = 20,blockred = 0,loops = 0;
2416    while(sigdrop && (loops < totalsbaruns || totalsbaruns == -1)
2417                  && (blockred <= blockedreductions))
2418    {
2419      loops++;
2420      if(loops == 1)
2421        sigdrop = FALSE;
2422      BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2423      BOOLEAN delete_w=(w==NULL);
2424      kStrategy strat=new skStrategy;
2425      strat->sbaEnterS = sbaEnterS;
2426      strat->sigdrop = sigdrop;
2427      #if 0
2428      strat->blockred = blockred;
2429      #else
2430      strat->blockred = 0;
2431      #endif
2432      strat->blockredmax = blockedreductions;
2433      //printf("\nsbaEnterS beginning = %i\n",strat->sbaEnterS);
2434      //printf("\nsigdrop beginning = %i\n",strat->sigdrop);
2435      strat->sbaOrder = sbaOrder;
2436      if (arri!=0)
2437      {
2438        strat->rewCrit1 = arriRewDummy;
2439        strat->rewCrit2 = arriRewCriterion;
2440        strat->rewCrit3 = arriRewCriterionPre;
2441      }
2442      else
2443      {
2444        strat->rewCrit1 = faugereRewCriterion;
2445        strat->rewCrit2 = faugereRewCriterion;
2446        strat->rewCrit3 = faugereRewCriterion;
2447      }
2448
2449      if(!TEST_OPT_RETURN_SB)
2450        strat->syzComp = syzComp;
2451      if (TEST_OPT_SB_1)
2452        if(!rField_is_Ring(currRing))
2453          strat->newIdeal = newIdeal;
2454      if (rField_has_simple_inverse(currRing))
2455        strat->LazyPass=20;
2456      else
2457        strat->LazyPass=2;
2458      strat->LazyDegree = 1;
2459      strat->enterOnePair=enterOnePairNormal;
2460      strat->chainCrit=chainCritNormal;
2461      if (TEST_OPT_SB_1) strat->chainCrit=chainCritOpt_1;
2462      strat->ak = id_RankFreeModule(F,currRing);
2463      strat->kModW=kModW=NULL;
2464      strat->kHomW=kHomW=NULL;
2465      if (vw != NULL)
2466      {
2467        currRing->pLexOrder=FALSE;
2468        strat->kHomW=kHomW=vw;
2469        strat->pOrigFDeg = currRing->pFDeg;
2470        strat->pOrigLDeg = currRing->pLDeg;
2471        pSetDegProcs(currRing,kHomModDeg);
2472        toReset = TRUE;
2473      }
2474      if (h==testHomog)
2475      {
2476        if (strat->ak == 0)
2477        {
2478          h = (tHomog)idHomIdeal(F,Q);
2479          w=NULL;
2480        }
2481        else if (!TEST_OPT_DEGBOUND)
2482        {
2483          if (w!=NULL)
2484            h = (tHomog)idHomModule(F,Q,w);
2485          else
2486            h = (tHomog)idHomIdeal(F,Q);
2487        }
2488      }
2489      currRing->pLexOrder=b;
2490      if (h==isHomog)
2491      {
2492        if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2493        {
2494          strat->kModW = kModW = *w;
2495          if (vw == NULL)
2496          {
2497            strat->pOrigFDeg = currRing->pFDeg;
2498            strat->pOrigLDeg = currRing->pLDeg;
2499            pSetDegProcs(currRing,kModDeg);
2500            toReset = TRUE;
2501          }
2502        }
2503        currRing->pLexOrder = TRUE;
2504        if (hilb==NULL) strat->LazyPass*=2;
2505      }
2506      strat->homog=h;
2507    #ifdef KDEBUG
2508      idTest(F);
2509      if(Q != NULL)
2510        idTest(Q);
2511    #endif
2512    #ifdef HAVE_PLURAL
2513      if (rIsPluralRing(currRing))
2514      {
2515        const BOOLEAN bIsSCA  = rIsSCA(currRing) && strat->z2homog; // for Z_2 prod-crit
2516        strat->no_prod_crit   = ! bIsSCA;
2517        if (w!=NULL)
2518          r = nc_GB(F, Q, *w, hilb, strat, currRing);
2519        else
2520          r = nc_GB(F, Q, NULL, hilb, strat, currRing);
2521      }
2522      else
2523    #endif
2524      {
2525        if (rHasLocalOrMixedOrdering(currRing))
2526        {
2527          if (w!=NULL)
2528            r=mora(F,Q,*w,hilb,strat);
2529          else
2530            r=mora(F,Q,NULL,hilb,strat);
2531        }
2532        else
2533        {
2534          if (w!=NULL)
2535            r=sba(r,Q,*w,hilb,strat);
2536          else
2537          {
2538            r=sba(r,Q,NULL,hilb,strat);
2539          }
2540        }
2541      }
2542    #ifdef KDEBUG
2543      idTest(r);
2544    #endif
2545      if (toReset)
2546      {
2547        kModW = NULL;
2548        pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2549      }
2550      currRing->pLexOrder = b;
2551    //Print("%d reductions canceled \n",strat->cel);
2552      HCord=strat->HCord;
2553      sigdrop = strat->sigdrop;
2554      sbaEnterS = strat->sbaEnterS;
2555      blockred = strat->blockred;
2556      delete(strat);
2557      if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
2558    }
2559    // Go to std
2560    if(sigdrop || blockred > blockedreductions)
2561    {
2562      r = kStd(r, Q, h, w, hilb, syzComp, newIdeal, vw);
2563    }
2564    return r;
2565  }
2566}
2567
2568#ifdef HAVE_SHIFTBBA
2569ideal kStdShift(ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
2570                int newIdeal, intvec *vw, BOOLEAN rightGB)
2571{
2572  ideal r;
2573  BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2574  BOOLEAN delete_w=(w==NULL);
2575  kStrategy strat=new skStrategy;
2576  intvec* temp_w=NULL;
2577
2578  strat->rightGB = rightGB;
2579
2580  if(!TEST_OPT_RETURN_SB)
2581    strat->syzComp = syzComp;
2582  if (TEST_OPT_SB_1)
2583    if(!rField_is_Ring(currRing))
2584      strat->newIdeal = newIdeal;
2585  if (rField_has_simple_inverse(currRing))
2586    strat->LazyPass=20;
2587  else
2588    strat->LazyPass=2;
2589  strat->LazyDegree = 1;
2590  strat->ak = id_RankFreeModule(F,currRing);
2591  strat->kModW=kModW=NULL;
2592  strat->kHomW=kHomW=NULL;
2593  if (vw != NULL)
2594  {
2595    currRing->pLexOrder=FALSE;
2596    strat->kHomW=kHomW=vw;
2597    strat->pOrigFDeg = currRing->pFDeg;
2598    strat->pOrigLDeg = currRing->pLDeg;
2599    pSetDegProcs(currRing,kHomModDeg);
2600    toReset = TRUE;
2601  }
2602  if (h==testHomog)
2603  {
2604    if (strat->ak == 0)
2605    {
2606      h = (tHomog)idHomIdeal(F,Q);
2607      w=NULL;
2608    }
2609    else if (!TEST_OPT_DEGBOUND)
2610    {
2611      if (w!=NULL)
2612        h = (tHomog)idHomModule(F,Q,w);
2613      else
2614        h = (tHomog)idHomIdeal(F,Q);
2615    }
2616  }
2617  currRing->pLexOrder=b;
2618  if (h==isHomog)
2619  {
2620    if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2621    {
2622      strat->kModW = kModW = *w;
2623      if (vw == NULL)
2624      {
2625        strat->pOrigFDeg = currRing->pFDeg;
2626        strat->pOrigLDeg = currRing->pLDeg;
2627        pSetDegProcs(currRing,kModDeg);
2628        toReset = TRUE;
2629      }
2630    }
2631    currRing->pLexOrder = TRUE;
2632    if (hilb==NULL) strat->LazyPass*=2;
2633  }
2634  strat->homog=h;
2635#ifdef KDEBUG
2636  idTest(F);
2637#endif
2638  if (rHasLocalOrMixedOrdering(currRing))
2639  {
2640    /* error: no local ord yet with shifts */
2641    WerrorS("No local ordering possible for shift algebra");
2642    return(NULL);
2643  }
2644  else
2645  {
2646    /* global ordering */
2647    if (w!=NULL)
2648      r=bbaShift(F,Q,*w,hilb,strat);
2649    else
2650      r=bbaShift(F,Q,NULL,hilb,strat);
2651  }
2652#ifdef KDEBUG
2653  idTest(r);
2654#endif
2655  if (toReset)
2656  {
2657    kModW = NULL;
2658    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2659  }
2660  currRing->pLexOrder = b;
2661//Print("%d reductions canceled \n",strat->cel);
2662  HCord=strat->HCord;
2663  delete(strat);
2664  if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
2665  return r;
2666}
2667#endif
2668
2669//##############################################################
2670//##############################################################
2671//##############################################################
2672//##############################################################
2673//##############################################################
2674
2675ideal kMin_std(ideal F, ideal Q, tHomog h,intvec ** w, ideal &M, intvec *hilb,
2676              int syzComp, int reduced)
2677{
2678  if(idIs0(F))
2679  {
2680    M=idInit(1,F->rank);
2681    return idInit(1,F->rank);
2682  }
2683  if(rField_is_Ring(currRing))
2684  {
2685    ideal sb;
2686    sb = kStd(F, Q, h, w, hilb);
2687    idSkipZeroes(sb);
2688    if(IDELEMS(sb) <= IDELEMS(F))
2689    {
2690        M = idCopy(sb);
2691        idSkipZeroes(M);
2692        return(sb);
2693    }
2694    else
2695    {
2696        M = idCopy(F);
2697        idSkipZeroes(M);
2698        return(sb);
2699    }
2700  }
2701  ideal r=NULL;
2702  int Kstd1_OldDeg = Kstd1_deg,i;
2703  intvec* temp_w=NULL;
2704  BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2705  BOOLEAN delete_w=(w==NULL);
2706  BOOLEAN oldDegBound=TEST_OPT_DEGBOUND;
2707  kStrategy strat=new skStrategy;
2708
2709  if(!TEST_OPT_RETURN_SB)
2710     strat->syzComp = syzComp;
2711  if (rField_has_simple_inverse(currRing))
2712    strat->LazyPass=20;
2713  else
2714    strat->LazyPass=2;
2715  strat->LazyDegree = 1;
2716  strat->minim=(reduced % 2)+1;
2717  strat->ak = id_RankFreeModule(F,currRing);
2718  if (delete_w)
2719  {
2720    temp_w=new intvec((strat->ak)+1);
2721    w = &temp_w;
2722  }
2723  if (h==testHomog)
2724  {
2725    if (strat->ak == 0)
2726    {
2727      h = (tHomog)idHomIdeal(F,Q);
2728      w=NULL;
2729    }
2730    else
2731    {
2732      h = (tHomog)idHomModule(F,Q,w);
2733    }
2734  }
2735  if (h==isHomog)
2736  {
2737    if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2738    {
2739      kModW = *w;
2740      strat->kModW = *w;
2741      assume(currRing->pFDeg != NULL && currRing->pLDeg != NULL);
2742      strat->pOrigFDeg = currRing->pFDeg;
2743      strat->pOrigLDeg = currRing->pLDeg;
2744      pSetDegProcs(currRing,kModDeg);
2745
2746      toReset = TRUE;
2747      if (reduced>1)
2748      {
2749        Kstd1_OldDeg=Kstd1_deg;
2750        Kstd1_deg = -1;
2751        for (i=IDELEMS(F)-1;i>=0;i--)
2752        {
2753          if ((F->m[i]!=NULL) && (currRing->pFDeg(F->m[i],currRing)>=Kstd1_deg))
2754            Kstd1_deg = currRing->pFDeg(F->m[i],currRing)+1;
2755        }
2756      }
2757    }
2758    currRing->pLexOrder = TRUE;
2759    strat->LazyPass*=2;
2760  }
2761  strat->homog=h;
2762  if (rHasLocalOrMixedOrdering(currRing))
2763  {
2764    if (w!=NULL)
2765      r=mora(F,Q,*w,hilb,strat);
2766    else
2767      r=mora(F,Q,NULL,hilb,strat);
2768  }
2769  else
2770  {
2771    if (w!=NULL)
2772      r=bba(F,Q,*w,hilb,strat);
2773    else
2774      r=bba(F,Q,NULL,hilb,strat);
2775  }
2776#ifdef KDEBUG
2777  {
2778    int i;
2779    for (i=IDELEMS(r)-1; i>=0; i--) pTest(r->m[i]);
2780  }
2781#endif
2782  idSkipZeroes(r);
2783  if (toReset)
2784  {
2785    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2786    kModW = NULL;
2787  }
2788  currRing->pLexOrder = b;
2789  HCord=strat->HCord;
2790  if ((delete_w)&&(temp_w!=NULL)) delete temp_w;
2791  if ((IDELEMS(r)==1) && (r->m[0]!=NULL) && pIsConstant(r->m[0]) && (strat->ak==0))
2792  {
2793    M=idInit(1,F->rank);
2794    M->m[0]=pOne();
2795    //if (strat->ak!=0) { pSetComp(M->m[0],strat->ak); pSetmComp(M->m[0]); }
2796    if (strat->M!=NULL) idDelete(&strat->M);
2797  }
2798  else if (strat->M==NULL)
2799  {
2800    M=idInit(1,F->rank);
2801    WarnS("no minimal generating set computed");
2802  }
2803  else
2804  {
2805    idSkipZeroes(strat->M);
2806    M=strat->M;
2807  }
2808  delete(strat);
2809  if (reduced>2)
2810  {
2811    Kstd1_deg=Kstd1_OldDeg;
2812    if (!oldDegBound)
2813      si_opt_1 &= ~Sy_bit(OPT_DEGBOUND);
2814  }
2815  else
2816  {
2817    if (IDELEMS(M)>IDELEMS(r)) {
2818       idDelete(&M);
2819       M=idCopy(r); }
2820  }
2821  return r;
2822}
2823
2824poly kNF(ideal F, ideal Q, poly p,int syzComp, int lazyReduce)
2825{
2826  if (p==NULL)
2827     return NULL;
2828
2829  poly pp = p;
2830
2831#ifdef HAVE_PLURAL
2832  if(rIsSCA(currRing))
2833  {
2834    const unsigned int m_iFirstAltVar = scaFirstAltVar(currRing);
2835    const unsigned int m_iLastAltVar  = scaLastAltVar(currRing);
2836    pp = p_KillSquares(pp, m_iFirstAltVar, m_iLastAltVar, currRing);
2837
2838    if(Q == currRing->qideal)
2839      Q = SCAQuotient(currRing);
2840  }
2841#endif
2842
2843  if ((idIs0(F))&&(Q==NULL))
2844  {
2845#ifdef HAVE_PLURAL
2846    if(p != pp)
2847      return pp;
2848#endif
2849    return pCopy(p); /*F+Q=0*/
2850  }
2851
2852  kStrategy strat=new skStrategy;
2853  strat->syzComp = syzComp;
2854  strat->ak = si_max(id_RankFreeModule(F,currRing),pMaxComp(p));
2855  poly res;
2856
2857  if (rHasLocalOrMixedOrdering(currRing))
2858  {
2859#ifdef HAVE_SHIFTBBA
2860    if (currRing->isLPring)
2861    {
2862      WerrorS("No local ordering possible for shift algebra");
2863      return(NULL);
2864    }
2865#endif
2866    res=kNF1(F,Q,pp,strat,lazyReduce);
2867  }
2868  else
2869    res=kNF2(F,Q,pp,strat,lazyReduce);
2870  delete(strat);
2871
2872#ifdef HAVE_PLURAL
2873  if(pp != p)
2874    p_Delete(&pp, currRing);
2875#endif
2876  return res;
2877}
2878
2879poly kNFBound(ideal F, ideal Q, poly p,int bound,int syzComp, int lazyReduce)
2880{
2881  if (p==NULL)
2882     return NULL;
2883
2884  poly pp = p;
2885
2886#ifdef HAVE_PLURAL
2887  if(rIsSCA(currRing))
2888  {
2889    const unsigned int m_iFirstAltVar = scaFirstAltVar(currRing);
2890    const unsigned int m_iLastAltVar  = scaLastAltVar(currRing);
2891    pp = p_KillSquares(pp, m_iFirstAltVar, m_iLastAltVar, currRing);
2892
2893    if(Q == currRing->qideal)
2894      Q = SCAQuotient(currRing);
2895  }
2896#endif
2897
2898  if ((idIs0(F))&&(Q==NULL))
2899  {
2900#ifdef HAVE_PLURAL
2901    if(p != pp)
2902      return pp;
2903#endif
2904    return pCopy(p); /*F+Q=0*/
2905  }
2906
2907  kStrategy strat=new skStrategy;
2908  strat->syzComp = syzComp;
2909  strat->ak = si_max(id_RankFreeModule(F,currRing),pMaxComp(p));
2910  poly res;
2911  res=kNF2Bound(F,Q,pp,bound,strat,lazyReduce);
2912  delete(strat);
2913
2914#ifdef HAVE_PLURAL
2915  if(pp != p)
2916    p_Delete(&pp, currRing);
2917#endif
2918  return res;
2919}
2920
2921ideal kNF(ideal F, ideal Q, ideal p,int syzComp,int lazyReduce)
2922{
2923  ideal res;
2924  if (TEST_OPT_PROT)
2925  {
2926    Print("(S:%d)",IDELEMS(p));mflush();
2927  }
2928  if (idIs0(p))
2929    return idInit(IDELEMS(p),si_max(p->rank,F->rank));
2930
2931  ideal pp = p;
2932#ifdef HAVE_PLURAL
2933  if(rIsSCA(currRing))
2934  {
2935    const unsigned int m_iFirstAltVar = scaFirstAltVar(currRing);
2936    const unsigned int m_iLastAltVar  = scaLastAltVar(currRing);
2937    pp = id_KillSquares(pp, m_iFirstAltVar, m_iLastAltVar, currRing, false);
2938
2939    if(Q == currRing->qideal)
2940      Q = SCAQuotient(currRing);
2941  }
2942#endif
2943
2944  if ((idIs0(F))&&(Q==NULL))
2945  {
2946#ifdef HAVE_PLURAL
2947    if(p != pp)
2948      return pp;
2949#endif
2950    return idCopy(p); /*F+Q=0*/
2951  }
2952
2953  kStrategy strat=new skStrategy;
2954  strat->syzComp = syzComp;
2955  strat->ak = si_max(id_RankFreeModule(F,currRing),id_RankFreeModule(p,currRing));
2956  if (strat->ak>0) // only for module case, see Tst/Short/bug_reduce.tst
2957  {
2958    strat->ak = si_max(strat->ak,(int)F->rank);
2959  }
2960
2961  if (rHasLocalOrMixedOrdering(currRing))
2962  {
2963#ifdef HAVE_SHIFTBBA
2964    if (currRing->isLPring)
2965    {
2966      WerrorS("No local ordering possible for shift algebra");
2967      return(NULL);
2968    }
2969#endif
2970    res=kNF1(F,Q,pp,strat,lazyReduce);
2971  }
2972  else
2973    res=kNF2(F,Q,pp,strat,lazyReduce);
2974  delete(strat);
2975
2976#ifdef HAVE_PLURAL
2977  if(pp != p)
2978    id_Delete(&pp, currRing);
2979#endif
2980
2981  return res;
2982}
2983
2984ideal kNFBound(ideal F, ideal Q, ideal p,int bound,int syzComp,int lazyReduce)
2985{
2986  ideal res;
2987  if (TEST_OPT_PROT)
2988  {
2989    Print("(S:%d)",IDELEMS(p));mflush();
2990  }
2991  if (idIs0(p))
2992    return idInit(IDELEMS(p),si_max(p->rank,F->rank));
2993
2994  ideal pp = p;
2995#ifdef HAVE_PLURAL
2996  if(rIsSCA(currRing))
2997  {
2998    const unsigned int m_iFirstAltVar = scaFirstAltVar(currRing);
2999    const unsigned int m_iLastAltVar  = scaLastAltVar(currRing);
3000    pp = id_KillSquares(pp, m_iFirstAltVar, m_iLastAltVar, currRing, false);
3001
3002    if(Q == currRing->qideal)
3003      Q = SCAQuotient(currRing);
3004  }
3005#endif
3006
3007  if ((idIs0(F))&&(Q==NULL))
3008  {
3009#ifdef HAVE_PLURAL
3010    if(p != pp)
3011      return pp;
3012#endif
3013    return idCopy(p); /*F+Q=0*/
3014  }
3015
3016  kStrategy strat=new skStrategy;
3017  strat->syzComp = syzComp;
3018  strat->ak = si_max(id_RankFreeModule(F,currRing),id_RankFreeModule(p,currRing));
3019  if (strat->ak>0) // only for module case, see Tst/Short/bug_reduce.tst
3020  {
3021    strat->ak = si_max(strat->ak,(int)F->rank);
3022  }
3023
3024  res=kNF2Bound(F,Q,pp,bound,strat,lazyReduce);
3025  delete(strat);
3026
3027#ifdef HAVE_PLURAL
3028  if(pp != p)
3029    id_Delete(&pp, currRing);
3030#endif
3031
3032  return res;
3033}
3034
3035poly k_NF (ideal F, ideal Q, poly p,int syzComp, int lazyReduce, const ring _currRing)
3036{
3037  const ring save = currRing;
3038  if( currRing != _currRing ) rChangeCurrRing(_currRing);
3039  poly ret = kNF(F, Q, p, syzComp, lazyReduce);
3040  if( currRing != save )     rChangeCurrRing(save);
3041  return ret;
3042}
3043
3044/*2
3045*interreduces F
3046*/
3047// old version
3048ideal kInterRedOld (ideal F, ideal Q)
3049{
3050  int j;
3051  kStrategy strat = new skStrategy;
3052
3053  ideal tempF = F;
3054  ideal tempQ = Q;
3055
3056#ifdef HAVE_PLURAL
3057  if(rIsSCA(currRing))
3058  {
3059    const unsigned int m_iFirstAltVar = scaFirstAltVar(currRing);
3060    const unsigned int m_iLastAltVar  = scaLastAltVar(currRing);
3061    tempF = id_KillSquares(F, m_iFirstAltVar, m_iLastAltVar, currRing);
3062
3063    // this should be done on the upper level!!! :
3064    //    tempQ = SCAQuotient(currRing);
3065
3066    if(Q == currRing->qideal)
3067      tempQ = SCAQuotient(currRing);
3068  }
3069#endif
3070
3071//  if (TEST_OPT_PROT)
3072//  {
3073//    writeTime("start InterRed:");
3074//    mflush();
3075//  }
3076  //strat->syzComp     = 0;
3077  strat->kHEdgeFound = (currRing->ppNoether) != NULL;
3078  strat->kNoether=pCopy((currRing->ppNoether));
3079  strat->ak = id_RankFreeModule(tempF,currRing);
3080  initBuchMoraCrit(strat);
3081  strat->NotUsedAxis = (BOOLEAN *)omAlloc(((currRing->N)+1)*sizeof(BOOLEAN));
3082  for (j=(currRing->N); j>0; j--) strat->NotUsedAxis[j] = TRUE;
3083  strat->enterS      = enterSBba;
3084  strat->posInT      = posInT17;
3085  strat->initEcart   = initEcartNormal;
3086  strat->sl   = -1;
3087  strat->tl          = -1;
3088  strat->tmax        = setmaxT;
3089  strat->T           = initT();
3090  strat->R           = initR();
3091  strat->sevT        = initsevT();
3092  if (rHasLocalOrMixedOrdering(currRing))   strat->honey = TRUE;
3093  initS(tempF, tempQ, strat);
3094  if (TEST_OPT_REDSB)
3095    strat->noTailReduction=FALSE;
3096  updateS(TRUE,strat);
3097  if (TEST_OPT_REDSB && TEST_OPT_INTSTRATEGY)
3098    completeReduce(strat);
3099  //else if (TEST_OPT_PROT) PrintLn();
3100  cleanT(strat);
3101  if (strat->kHEdge!=NULL) pLmFree(&strat->kHEdge);
3102  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
3103  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
3104  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
3105  omFreeSize((ADDRESS)strat->NotUsedAxis,((currRing->N)+1)*sizeof(BOOLEAN));
3106  omfree(strat->sevT);
3107  omfree(strat->S_2_R);
3108  omfree(strat->R);
3109
3110  if (strat->fromQ)
3111  {
3112    for (j=IDELEMS(strat->Shdl)-1;j>=0;j--)
3113    {
3114      if(strat->fromQ[j]) pDelete(&strat->Shdl->m[j]);
3115    }
3116    omFreeSize((ADDRESS)strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
3117  }
3118//  if (TEST_OPT_PROT)
3119//  {
3120//    writeTime("end Interred:");
3121//    mflush();
3122//  }
3123  ideal shdl=strat->Shdl;
3124  idSkipZeroes(shdl);
3125  if (strat->fromQ)
3126  {
3127    strat->fromQ=NULL;
3128    ideal res=kInterRed(shdl,NULL);
3129    idDelete(&shdl);
3130    shdl=res;
3131  }
3132  delete(strat);
3133#ifdef HAVE_PLURAL
3134  if( tempF != F )
3135    id_Delete( &tempF, currRing);
3136#endif
3137  return shdl;
3138}
3139// new version
3140ideal kInterRedBba (ideal F, ideal Q, int &need_retry)
3141{
3142  need_retry=0;
3143  int   red_result = 1;
3144  int   olddeg,reduc;
3145  BOOLEAN withT = FALSE;
3146  // BOOLEAN toReset=FALSE;
3147  kStrategy strat=new skStrategy;
3148  tHomog h;
3149
3150  if (rField_has_simple_inverse(currRing))
3151    strat->LazyPass=20;
3152  else
3153    strat->LazyPass=2;
3154  strat->LazyDegree = 1;
3155  strat->ak = id_RankFreeModule(F,currRing);
3156  strat->syzComp = strat->ak;
3157  strat->kModW=kModW=NULL;
3158  strat->kHomW=kHomW=NULL;
3159  if (strat->ak == 0)
3160  {
3161    h = (tHomog)idHomIdeal(F,Q);
3162  }
3163  else if (!TEST_OPT_DEGBOUND)
3164  {
3165    h = (tHomog)idHomIdeal(F,Q);
3166  }
3167  else
3168    h = isNotHomog;
3169  if (h==isHomog)
3170  {
3171    strat->LazyPass*=2;
3172  }
3173  strat->homog=h;
3174#ifdef KDEBUG
3175  idTest(F);
3176#endif
3177
3178  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
3179  if(rField_is_Ring(currRing))
3180    initBuchMoraPosRing(strat);
3181  else
3182    initBuchMoraPos(strat);
3183  initBba(strat);
3184  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
3185  strat->posInL=posInL0; /* ord according pComp */
3186
3187  /*Shdl=*/initBuchMora(F, Q, strat);
3188  reduc = olddeg = 0;
3189
3190#ifndef NO_BUCKETS
3191  if (!TEST_OPT_NOT_BUCKETS)
3192    strat->use_buckets = 1;
3193#endif
3194
3195  // redtailBBa against T for inhomogenous input
3196  if (!TEST_OPT_OLDSTD)
3197    withT = ! strat->homog;
3198
3199  // strat->posInT = posInT_pLength;
3200  kTest_TS(strat);
3201
3202#ifdef HAVE_TAIL_RING
3203  kStratInitChangeTailRing(strat);
3204#endif
3205
3206  /* compute------------------------------------------------------- */
3207  while (strat->Ll >= 0)
3208  {
3209    #ifdef KDEBUG
3210      if (TEST_OPT_DEBUG) messageSets(strat);
3211    #endif
3212    if (strat->Ll== 0) strat->interpt=TRUE;
3213    /* picks the last element from the lazyset L */
3214    strat->P = strat->L[strat->Ll];
3215    strat->Ll--;
3216
3217    if (strat->P.p1 == NULL)
3218    {
3219      // for input polys, prepare reduction
3220      strat->P.PrepareRed(strat->use_buckets);
3221    }
3222
3223    if (strat->P.p == NULL && strat->P.t_p == NULL)
3224    {
3225      red_result = 0;
3226    }
3227    else
3228    {
3229      if (TEST_OPT_PROT)
3230        message(strat->P.pFDeg(),
3231                &olddeg,&reduc,strat, red_result);
3232
3233      /* reduction of the element chosen from L */
3234      red_result = strat->red(&strat->P,strat);
3235    }
3236
3237    // reduction to non-zero new poly
3238    if (red_result == 1)
3239    {
3240      /* statistic */
3241      if (TEST_OPT_PROT) PrintS("s");
3242
3243      // get the polynomial (canonicalize bucket, make sure P.p is set)
3244      strat->P.GetP(strat->lmBin);
3245
3246      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
3247
3248      // reduce the tail and normalize poly
3249      // in the ring case we cannot expect LC(f) = 1,
3250      // therefore we call pCleardenom instead of pNorm
3251      if ((TEST_OPT_INTSTRATEGY) || (rField_is_Ring(currRing)))
3252      {
3253        strat->P.pCleardenom();
3254        if (0)
3255        //if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
3256        {
3257          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
3258          strat->P.pCleardenom();
3259        }
3260      }
3261      else
3262      {
3263        strat->P.pNorm();
3264        if (0)
3265        //if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
3266          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
3267      }
3268
3269#ifdef KDEBUG
3270      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
3271#endif
3272
3273      // enter into S, L, and T
3274      if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
3275      {
3276        enterT(strat->P, strat);
3277        // posInS only depends on the leading term
3278        strat->enterS(strat->P, pos, strat, strat->tl);
3279
3280        if (pos<strat->sl)
3281        {
3282          need_retry++;
3283          // move all "larger" elements fromS to L
3284          // remove them from T
3285          int ii=pos+1;
3286          for(;ii<=strat->sl;ii++)
3287          {
3288            LObject h;
3289            memset(&h,0,sizeof(h));
3290            h.tailRing=strat->tailRing;
3291            h.p=strat->S[ii]; strat->S[ii]=NULL;
3292            strat->initEcart(&h);
3293            h.sev=strat->sevS[ii];
3294            int jj=strat->tl;
3295            while (jj>=0)
3296            {
3297              if (strat->T[jj].p==h.p)
3298              {
3299                strat->T[jj].p=NULL;
3300                if (jj<strat->tl)
3301                {
3302                  memmove(&(strat->T[jj]),&(strat->T[jj+1]),
3303                          (strat->tl-jj)*sizeof(strat->T[jj]));
3304                  memmove(&(strat->sevT[jj]),&(strat->sevT[jj+1]),
3305                          (strat->tl-jj)*sizeof(strat->sevT[jj]));
3306                }
3307                strat->tl--;
3308                break;
3309              }
3310              jj--;
3311            }
3312            int lpos=strat->posInL(strat->L,strat->Ll,&h,strat);
3313            enterL(&strat->L,&strat->Ll,&strat->Lmax,h,lpos);
3314            #ifdef KDEBUG
3315            if (TEST_OPT_DEBUG)
3316            {
3317              Print("move S[%d] -> L[%d]: ",ii,pos);
3318              p_wrp(h.p,currRing, strat->tailRing);
3319              PrintLn();
3320            }
3321            #endif
3322          }
3323          if (strat->fromQ!=NULL)
3324          {
3325            for(ii=pos+1;ii<=strat->sl;ii++) strat->fromQ[ii]=0;
3326          }
3327          strat->sl=pos;
3328        }
3329      }
3330      else
3331      {
3332        // clean P
3333      }
3334      kDeleteLcm(&strat->P);
3335    }
3336
3337#ifdef KDEBUG
3338    if (TEST_OPT_DEBUG)
3339    {
3340      messageSets(strat);
3341    }
3342    memset(&(strat->P), 0, sizeof(strat->P));
3343#endif
3344    //kTest_TS(strat);: i_r out of sync in kInterRedBba, but not used!
3345  }
3346#ifdef KDEBUG
3347  //if (TEST_OPT_DEBUG) messageSets(strat);
3348#endif
3349  /* complete reduction of the standard basis--------- */
3350
3351  if((need_retry<=0) && (TEST_OPT_REDSB))
3352  {
3353    completeReduce(strat);
3354    if (strat->completeReduce_retry)
3355    {
3356      // completeReduce needed larger exponents, retry
3357      // hopefully: kStratChangeTailRing already provided a larger tailRing
3358      //    (otherwise: it will fail again)
3359      strat->completeReduce_retry=FALSE;
3360      completeReduce(strat);
3361      if (strat->completeReduce_retry)
3362      {
3363#ifdef HAVE_TAIL_RING
3364        if(currRing->bitmask>strat->tailRing->bitmask)
3365        {
3366          // retry without T
3367          strat->completeReduce_retry=FALSE;
3368          cleanT(strat);strat->tailRing=currRing;
3369          int i;
3370          for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
3371          completeReduce(strat);
3372        }
3373        if (strat->completeReduce_retry)
3374#endif
3375          Werror("exponent bound is %ld",currRing->bitmask);
3376      }
3377    }
3378  }
3379  else if (TEST_OPT_PROT) PrintLn();
3380
3381
3382  /* release temp data-------------------------------- */
3383  exitBuchMora(strat);
3384//  if (TEST_OPT_WEIGHTM)
3385//  {
3386//    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
3387//    if (ecartWeights)
3388//    {
3389//      omFreeSize((ADDRESS)ecartWeights,((currRing->N)+1)*sizeof(short));
3390//      ecartWeights=NULL;
3391//    }
3392//  }
3393  //if (TEST_OPT_PROT) messageStat(0/*hilbcount*/,strat);
3394  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
3395  ideal res=strat->Shdl;
3396  strat->Shdl=NULL;
3397  delete strat;
3398  return res;
3399}
3400ideal kInterRed (ideal F, ideal Q)
3401{
3402#ifdef HAVE_PLURAL
3403  if(rIsPluralRing(currRing)) return kInterRedOld(F,Q);
3404#endif
3405  if ((rHasLocalOrMixedOrdering(currRing))|| (rField_is_numeric(currRing))
3406  ||(rField_is_Ring(currRing))
3407  )
3408    return kInterRedOld(F,Q);
3409
3410    //return kInterRedOld(F,Q);
3411
3412  BITSET save1;
3413  SI_SAVE_OPT1(save1);
3414  //si_opt_1|=Sy_bit(OPT_NOT_SUGAR);
3415  si_opt_1|=Sy_bit(OPT_REDTHROUGH);
3416  //si_opt_1&= ~Sy_bit(OPT_REDTAIL);
3417  //si_opt_1&= ~Sy_bit(OPT_REDSB);
3418  //extern char * showOption() ;
3419  //Print("%s\n",showOption());
3420
3421  int need_retry;
3422  int counter=3;
3423  ideal res, res1;
3424  int elems;
3425  ideal null=NULL;
3426  if ((Q==NULL) || (!TEST_OPT_REDSB))
3427  {
3428    elems=idElem(F);
3429    res=kInterRedBba(F,Q,need_retry);
3430  }
3431  else
3432  {
3433    ideal FF=idSimpleAdd(F,Q);
3434    res=kInterRedBba(FF,NULL,need_retry);
3435    idDelete(&FF);
3436    null=idInit(1,1);
3437    if (need_retry)
3438      res1=kNF(null,Q,res,0,KSTD_NF_LAZY);
3439    else
3440      res1=kNF(null,Q,res);
3441    idDelete(&res);
3442    res=res1;
3443    need_retry=1;
3444  }
3445  if (idElem(res)<=1) need_retry=0;
3446  while (need_retry && (counter>0))
3447  {
3448    #ifdef KDEBUG
3449    if (TEST_OPT_DEBUG) { Print("retry counter %d\n",counter); }
3450    #endif
3451    res1=kInterRedBba(res,Q,need_retry);
3452    int new_elems=idElem(res1);
3453    counter -= (new_elems >= elems);
3454    elems = new_elems;
3455    idDelete(&res);
3456    if (idElem(res1)<=1) need_retry=0;
3457    if ((Q!=NULL) && (TEST_OPT_REDSB))
3458    {
3459      if (need_retry)
3460        res=kNF(null,Q,res1,0,KSTD_NF_LAZY);
3461      else
3462        res=kNF(null,Q,res1);
3463      idDelete(&res1);
3464    }
3465    else
3466      res = res1;
3467    if (idElem(res)<=1) need_retry=0;
3468  }
3469  if (null!=NULL) idDelete(&null);
3470  SI_RESTORE_OPT1(save1);
3471  idSkipZeroes(res);
3472  return res;
3473}
3474
3475// returns TRUE if mora should use buckets, false otherwise
3476static BOOLEAN kMoraUseBucket(kStrategy strat)
3477{
3478#ifdef MORA_USE_BUCKETS
3479  if (TEST_OPT_NOT_BUCKETS)
3480    return FALSE;
3481  if (strat->red == redFirst)
3482  {
3483#ifdef NO_LDEG
3484    if (strat->syzComp==0)
3485      return TRUE;
3486#else
3487    if ((strat->homog || strat->honey) && (strat->syzComp==0))
3488      return TRUE;
3489#endif
3490  }
3491  else
3492  {
3493    #ifdef HAVE_RINGS
3494    assume(strat->red == redEcart || strat->red == redRiloc);
3495    #else
3496    assume(strat->red == redEcart);
3497    #endif
3498    if (strat->honey && (strat->syzComp==0))
3499      return TRUE;
3500  }
3501#endif
3502  return FALSE;
3503}
Note: See TracBrowser for help on using the repository browser.