source: git/kernel/kstd1.cc @ f0f1f2

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