source: git/kernel/GBEngine/kstd1.cc @ 456eb62

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