source: git/kernel/kstd1.cc @ 327d41

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