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

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