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

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