source: git/kernel/kstd1.cc @ 232bbd5

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