source: git/kernel/kstd1.cc @ 1c94e4

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