source: git/kernel/GBEngine/kstd1.cc @ 3ffb5ca

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