source: git/kernel/kstd1.cc @ 0b356b

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