source: git/kernel/kstd1.cc @ acff7e7

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