source: git/kernel/kstd1.cc @ 0fb5d0c

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