source: git/kernel/kstd1.cc @ d95cee

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