source: git/Singular/kstd1.cc @ e3dc1c

spielwiese
Last change on this file since e3dc1c was e3dc1c, checked in by Olaf Bachmann <obachman@…>, 23 years ago
* new strat and option(prot) for std git-svn-id: file:///usr/local/Singular/svn/trunk@4934 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 45.9 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kstd1.cc,v 1.74 2000-12-18 17:26:39 obachman Exp $ */
5/*
6* ABSTRACT:
7*/
8
9// define if buckets should be used
10#define MORA_USE_BUCKETS
11
12// define if tailrings should be used
13// #define HAVE_TAIL_RING
14
15#include "mod2.h"
16#include "tok.h"
17#include "omalloc.h"
18#include "kutil.h"
19#include "kInline.cc"
20#include "polys.h"
21#include "febase.h"
22#include "kstd1.h"
23#include "khstd.h"
24#include "stairc.h"
25#include "weight.h"
26#include "cntrlc.h"
27#include "intvec.h"
28#include "ideals.h"
29#include "ipshell.h"
30#include "ipid.h"
31#include "timer.h"
32#include "lists.h"
33
34//#include "ipprint.h"
35
36/* the list of all options which give a warning by test */
37BITSET kOptions=Sy_bit(OPT_PROT)           /*  0 */
38                |Sy_bit(OPT_REDSB)         /*  1 */
39                |Sy_bit(OPT_NOT_SUGAR)     /*  3 */
40                |Sy_bit(OPT_INTERRUPT)     /*  4 */
41                |Sy_bit(OPT_SUGARCRIT)     /*  5 */
42                |Sy_bit(OPT_REDTHROUGH)
43                |Sy_bit(OPT_OLDSTD)
44                |Sy_bit(OPT_FASTHC)        /* 10 */
45                |Sy_bit(OPT_KEEPVARS)      /* 21 */
46                |Sy_bit(OPT_INTSTRATEGY)   /* 26 */
47                |Sy_bit(OPT_INFREDTAIL)    /* 28 */
48                |Sy_bit(OPT_NOTREGULARITY) /* 30 */
49                |Sy_bit(OPT_WEIGHTM);      /* 31 */
50
51/* the list of all options which may be used by option and test */
52BITSET validOpts=Sy_bit(0)
53                |Sy_bit(1)
54                |Sy_bit(2) // obachman 10/00: replaced by notBucket
55                |Sy_bit(3)
56                |Sy_bit(4)
57                |Sy_bit(5)
58                |Sy_bit(6)
59//                |Sy_bit(7) obachman 11/00 tossed: 12/00 used for redThrough
60  |Sy_bit(OPT_REDTHROUGH)
61//                |Sy_bit(8) obachman 11/00 tossed
62                |Sy_bit(9)
63                |Sy_bit(10)
64                |Sy_bit(11)
65                |Sy_bit(12)
66                |Sy_bit(13)
67                |Sy_bit(14)
68                |Sy_bit(15)
69                |Sy_bit(16)
70                |Sy_bit(17)
71                |Sy_bit(18)
72                |Sy_bit(19)
73//                |Sy_bit(20) obachman 11/00 tossed: 12/00 used for redOldStd
74  |Sy_bit(OPT_OLDSTD)
75                |Sy_bit(21)
76                |Sy_bit(22)
77                /*|Sy_bit(23)*/
78                /*|Sy_bit(24)*/
79                |Sy_bit(OPT_REDTAIL)
80                |Sy_bit(OPT_INTSTRATEGY)
81                |Sy_bit(27)
82                |Sy_bit(28)
83                |Sy_bit(29)
84                |Sy_bit(30)
85                |Sy_bit(31);
86
87//static BOOLEAN posInLOldFlag;
88           /*FALSE, if posInL == posInL10*/
89// returns TRUE if mora should use buckets, false otherwise
90static BOOLEAN kMoraUseBucket(kStrategy strat);
91
92static void kOptimizeLDeg(pFDegProc fdeg, pLDegProc ldeg, kStrategy strat)
93{
94  if (fdeg == pDeg)
95  {
96    if (ldeg == pLDeg1) 
97      pLDeg = pLDeg1_Deg;
98    if (ldeg == pLDeg1c)
99      pLDeg = pLDeg1c_Deg;
100  }
101  else if (fdeg == pTotaldegree)
102  {
103    if (ldeg == pLDeg1) 
104      pLDeg = pLDeg1_Totaldegree;
105    if (ldeg == pLDeg1c)
106      pLDeg = pLDeg1c_Totaldegree;
107  }
108
109  if (strat->ak == 0 && !rIsSyzIndexRing(currRing))
110    strat->length_pLength = TRUE;
111   
112  if ((ldeg == pLDeg0c && !rIsSyzIndexRing(currRing)) ||
113      (ldeg == pLDeg0 && strat->ak == 0))
114  {
115    strat->LDegLast = TRUE;
116  }
117  else
118  {
119    strat->LDegLast = FALSE;
120  }
121}
122
123 
124static int doRed (LObject* h, TObject* with,BOOLEAN intoT,kStrategy strat)
125{
126  poly hp;
127  int ret;
128#if KDEBUG > 0
129  kTest_L(h);
130  kTest_T(with);
131#endif
132  // Hmmm ... why do we do this -- polys from T should already be normalized
133  if (!TEST_OPT_INTSTRATEGY)
134    with->pNorm();
135#ifdef KDEBUG
136  if (TEST_OPT_DEBUG)
137  {
138    PrintS("reduce ");h->wrp();PrintS(" with ");with->wrp();PrintLn();
139  }
140#endif
141  if (intoT)
142  {
143    // need to do it exacly like this: otherwise
144    // we might get errors
145    LObject L= *h;
146    L.Copy();
147    h->GetP();
148    h->SetLength(strat->length_pLength);
149    ret = ksReducePoly(&L, with, strat->kNoether, NULL, strat);
150    if (ret)
151    {
152      if (ret < 0) return ret;
153      if (h->tailRing != strat->tailRing)
154        h->ShallowCopyDelete(strat->tailRing,
155                             pGetShallowCopyDeleteProc(h->tailRing,
156                                                       strat->tailRing));
157    }
158    enterT(*h,strat);
159    *h = L;
160  }
161  else
162    ret = ksReducePoly(h, with, strat->kNoether, NULL, strat);
163#ifdef KDEBUG
164  if (TEST_OPT_DEBUG)
165  {
166    PrintS("to ");h->wrp();PrintLn();
167  }
168#endif
169  return ret;
170}
171
172int redEcart (LObject* h,kStrategy strat)
173{
174  poly pi;
175  int i,at,reddeg,d,ei,li,ii;
176  int j = 0;
177  int pass = 0;
178
179  d = h->GetpFDeg()+ h->ecart;
180  reddeg = strat->LazyDegree+d;
181  h->SetShortExpVector();
182  while (1)
183  {
184    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
185    if (j < 0)
186    {
187      if (strat->honey) h->SetLength(strat->length_pLength);
188      return 1;
189    }
190
191    ei = strat->T[j].ecart;
192    ii = j;
193
194    if (ei > h->ecart && ii < strat->tl)
195    {
196      li = strat->T[j].length;
197      // the polynomial to reduce with (up to the moment) is;
198      // pi with ecart ei and length li
199      // look for one with smaller ecart
200      i = j;
201      while (1)
202      {
203        /*- takes the first possible with respect to ecart -*/
204        i++;
205#if 1
206        if (i > strat->tl) break;
207        if ((strat->T[i].ecart < ei || (strat->T[i].ecart == ei &&
208                                        strat->T[i].length < li))
209            &&
210            p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i], h->GetLmTailRing(), ~h->sev, strat->tailRing))
211#else
212          j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h, i);
213        if (j < 0) break;
214        i = j;
215        if (strat->T[i].ecart < ei || (strat->T[i].ecart == ei &&
216                                        strat->T[i].length < li))
217#endif
218        {
219          // the polynomial to reduce with is now
220          ii = i;
221          ei = strat->T[i].ecart;
222          if (ei <= h->ecart) break;
223          li = strat->T[i].length;
224        }
225      }
226    }
227
228    // end of search: have to reduce with pi
229    if (!K_TEST_OPT_REDTHROUGH && ei > h->ecart)
230    {
231      // It is not possible to reduce h with smaller ecart;
232      // if possible h goes to the lazy-set L,i.e
233      // if its position in L would be not the last one
234      strat->fromT = TRUE;
235      if (strat->Ll >= 0) /*- L is not empty -*/
236      {
237        h->SetLmCurrRing();
238        if (strat->honey && strat->posInLDependsOnLength)
239          h->SetLength(strat->length_pLength);
240        assume(h->FDeg == h->pFDeg());
241        at = strat->posInL(strat->L,strat->Ll,h,strat);
242        if (at <= strat->Ll)
243        {
244          /*- h will not become the next element to reduce -*/
245          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
246#ifdef KDEBUG
247          if (TEST_OPT_DEBUG) Print(" ecart too big; -> L%d\n",at);
248#endif
249          h->Clear();
250          strat->fromT = FALSE;
251          return -1;
252        }
253      }
254    }
255
256    // now we finally can reduce
257    doRed(h,&(strat->T[ii]),strat->fromT,strat);
258    strat->fromT=FALSE;
259
260    // are we done ???
261    if (h->IsNull())
262    {
263      if (h->lcm!=NULL) pLmFree(h->lcm);
264      h->Clear();
265      return 0;
266    }
267
268    // NO!
269    h->SetShortExpVector();
270    h->SetpFDeg();
271    if (strat->honey)
272    {
273      if (ei <= h->ecart)
274        h->ecart = d-h->GetpFDeg();
275      else
276        h->ecart = d-h->GetpFDeg()+ei-h->ecart;
277    }
278    else
279      // this has the side effect of setting h->length
280      h->ecart = h->pLDeg(strat->LDegLast) - h->GetpFDeg();
281
282    if (strat->syzComp!=0)
283    {
284      if ((strat->syzComp>0) && (h->Comp() > strat->syzComp))
285      {
286        assume(h->MinComp() > strat->syzComp);
287        if (strat->honey) h->SetLength();
288#ifdef KDEBUG
289        if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
290#endif
291        return -2;
292      }
293    }
294    /*- try to reduce the s-polynomial -*/
295    pass++;
296    d = h->GetpFDeg()+h->ecart;
297    /*
298     *test whether the polynomial should go to the lazyset L
299     *-if the degree jumps
300     *-if the number of pre-defined reductions jumps
301     */
302    if (!K_TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
303        && ((d >= reddeg) || (pass > strat->LazyPass)))
304    {
305      h->SetLmCurrRing();
306      if (strat->honey && strat->posInLDependsOnLength) 
307        h->SetLength(strat->length_pLength);
308      assume(h->FDeg == h->pFDeg());
309      at = strat->posInL(strat->L,strat->Ll,h,strat);
310      if (at <= strat->Ll)
311      {
312        if (kFindDivisibleByInS(strat->S, strat->sevS, strat->sl, h) < 0)
313        {
314          if (strat->honey && !strat->posInLDependsOnLength) 
315            h->SetLength(strat->length_pLength);
316          return 1;
317        }
318        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
319#ifdef KDEBUG
320        if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
321#endif
322        h->Clear();
323        return -1;
324      }
325    }
326    else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
327    {
328      Print(".%d",d);mflush();
329      reddeg = d+1;
330    }
331  }
332}
333
334/*2
335*reduces h with elements from T choosing  the first possible
336* element in t with respect to the given pDivisibleBy
337*/
338int redFirst (LObject* h,kStrategy strat)
339{
340  if (h->IsNull()) return 0;
341
342  int at, reddeg,d;
343  int pass = 0;
344  int j = 0;
345
346  if (! strat->homog)
347  {
348    d = h->GetpFDeg() + h->ecart;
349    reddeg = strat->LazyDegree+d;
350  }
351  h->SetShortExpVector();
352  while (1)
353  {
354    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
355    if (j < 0)
356    {
357      h->SetDegStuffReturnLDeg(strat->LDegLast);
358      return 1;
359    }
360
361    if (!TEST_OPT_INTSTRATEGY)
362      strat->T[j].pNorm();
363#ifdef KDEBUG
364    if (TEST_OPT_DEBUG)
365    {
366      PrintS("reduce ");
367      h->wrp();
368      PrintS(" with ");
369      strat->T[j].wrp();
370    }
371#endif
372    ksReducePoly(h, &(strat->T[j]), strat->kNoether, NULL, strat);
373#ifdef KDEBUG
374    if (TEST_OPT_DEBUG)
375    {
376      PrintS(" to ");
377      wrp(h->p);
378      PrintLn();
379    }
380#endif
381    if (h->IsNull())
382    {
383      if (h->lcm!=NULL) pLmFree(h->lcm);
384      h->Clear();
385      return 0;
386    }
387    h->SetShortExpVector();
388
389    if ((strat->syzComp!=0) && !strat->honey)
390    {
391      if ((strat->syzComp>0) &&
392          (h->Comp() > strat->syzComp))
393      {
394        assume(h->MinComp() > strat->syzComp);
395#ifdef KDEBUG
396        if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
397#endif
398        if (strat->homog) 
399          h->SetDegStuffReturnLDeg(strat->LDegLast);
400        return -2;
401      }
402    }
403    if (!strat->homog)
404    {
405      if (!K_TEST_OPT_OLDSTD && strat->honey)
406      {
407        h->SetpFDeg();
408        if (strat->T[j].ecart <= h->ecart)
409          h->ecart = d - h->GetpFDeg();
410        else
411          h->ecart = d - h->GetpFDeg() + strat->T[j].ecart - h->ecart;
412     
413        d = h->GetpFDeg() + h->ecart;
414      }
415      else
416        d = h->SetDegStuffReturnLDeg(strat->LDegLast);
417      /*- try to reduce the s-polynomial -*/
418      pass++;
419      /*
420       *test whether the polynomial should go to the lazyset L
421       *-if the degree jumps
422       *-if the number of pre-defined reductions jumps
423       */
424      if (!K_TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
425          && ((d >= reddeg) || (pass > strat->LazyPass)))
426      {
427        h->SetLmCurrRing();
428        if (strat->posInLDependsOnLength)
429          h->SetLength(strat->length_pLength);
430        at = strat->posInL(strat->L,strat->Ll,h,strat);
431        if (at <= strat->Ll)
432        {
433          if (kFindDivisibleByInS(strat->S, strat->sevS, strat->sl, h) < 0)
434            return 1;
435          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
436#ifdef KDEBUG
437          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
438#endif
439          h->Clear();
440          return -1;
441        }
442      }
443      if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
444      {
445        reddeg = d+1;
446        Print(".%d",d);mflush();
447      }
448    }
449  }
450}
451
452/*2
453* reduces h with elements from T choosing first possible
454* element in T with respect to the given ecart
455* used for computing normal forms outside kStd
456*/
457static poly redMoraNF (poly h,kStrategy strat, int flag)
458{
459  LObject H;
460  H.p = h;
461  int j = 0;
462  int z = 10;
463  int o = H.SetpFDeg();
464  H.ecart = pLDeg(H.p,&H.length)-o;
465  if (flag==0) cancelunit(&H);
466  H.sev = pGetShortExpVector(H.p);
467  unsigned long not_sev = ~ H.sev;
468  loop
469  {
470    if (j > strat->tl)
471    {
472      return H.p;
473    }
474    if (TEST_V_DEG_STOP)
475    {
476      if (kModDeg(H.p)>Kstd1_deg) pDeleteLm(&H.p);
477      if (H.p==NULL) return NULL;
478    }
479    if (p_LmShortDivisibleBy(strat->T[j].GetLmTailRing(), strat->sevT[j], H.GetLmTailRing(), not_sev, strat->tailRing))
480    {
481      //if (strat->interpt) test_int_std(strat->kIdeal);
482      /*- remember the found T-poly -*/
483      poly pi = strat->T[j].p;
484      int ei = strat->T[j].ecart;
485      int li = strat->T[j].length;
486      int ii = j;
487      /*
488      * the polynomial to reduce with (up to the moment) is;
489      * pi with ecart ei and length li
490      */
491      loop
492      {
493        /*- look for a better one with respect to ecart -*/
494        /*- stop, if the ecart is small enough (<=ecart(H)) -*/
495        j++;
496        if (j > strat->tl) break;
497        if (ei <= H.ecart) break;
498        if (((strat->T[j].ecart < ei)
499          || ((strat->T[j].ecart == ei)
500        && (strat->T[j].length < li)))
501        && pLmShortDivisibleBy(strat->T[j].p,strat->sevT[j], H.p, not_sev))
502        {
503          /*
504          * the polynomial to reduce with is now;
505          */
506          pi = strat->T[j].p;
507          ei = strat->T[j].ecart;
508          li = strat->T[j].length;
509          ii = j;
510        }
511      }
512      /*
513      * end of search: have to reduce with pi
514      */
515      z++;
516      if (z>10)
517      {
518        pNormalize(H.p);
519        z=0;
520      }
521      if ((ei > H.ecart) && (!strat->kHEdgeFound))
522      {
523        /*
524        * It is not possible to reduce h with smaller ecart;
525        * we have to reduce with bad ecart: H has to enter in T
526        */
527        doRed(&H,&(strat->T[ii]),TRUE,strat);
528        if (H.p == NULL)
529          return NULL;
530      }
531      else
532      {
533        /*
534        * we reduce with good ecart, h need not to be put to T
535        */
536        doRed(&H,&(strat->T[ii]),FALSE,strat);
537        if (H.p == NULL)
538          return NULL;
539      }
540      /*- try to reduce the s-polynomial -*/
541      o = H.SetpFDeg();
542      cancelunit(&H);
543      H.ecart = pLDeg(H.p,&(H.length))-o;
544      j = 0;
545      H.sev = pGetShortExpVector(H.p);
546      not_sev = ~ H.sev;
547    }
548    else
549    {
550      j++;
551    }
552  }
553}
554
555/*2
556*reorders  L with respect to posInL
557*/
558void reorderL(kStrategy strat)
559{
560  int i,j,at;
561  LObject p;
562
563  for (i=1; i<=strat->Ll; i++)
564  {
565    at = strat->posInL(strat->L,i-1,&(strat->L[i]),strat);
566    if (at != i)
567    {
568      p = strat->L[i];
569      for (j=i-1; j>=at; j--) strat->L[j+1] = strat->L[j];
570      strat->L[at] = p;
571    }
572  }
573}
574
575/*2
576*reorders  T with respect to length
577*/
578void reorderT(kStrategy strat)
579{
580  int i,j,at;
581  TObject p;
582  unsigned long sev;
583
584
585  for (i=1; i<=strat->tl; i++)
586  {
587    if (strat->T[i-1].length > strat->T[i].length)
588    {
589      p = strat->T[i];
590      sev = strat->sevT[i];
591      at = i-1;
592      loop
593      {
594        at--;
595        if (at < 0) break;
596        if (strat->T[i].length > strat->T[at].length) break;
597      }
598      for (j = i-1; j>at; j--)
599      {
600        strat->T[j+1]=strat->T[j];
601        strat->sevT[j+1]=strat->sevT[j];
602        strat->R[strat->T[j+1].i_r] = &(strat->T[j+1]);
603      }
604      strat->T[at+1]=p;
605      strat->sevT[at+1] = sev;
606      strat->R[p.i_r] = &(strat->T[at+1]);
607    }
608  }
609}
610
611/*2
612*looks whether exactly pVariables-1 axis are used
613*returns last != 0 in this case
614*last is the (first) unused axis
615*/
616void missingAxis (int* last,kStrategy strat)
617{
618  int   i = 0;
619  int   k = 0;
620
621  *last = 0;
622  loop
623  {
624    i++;
625    if (i > pVariables) break;
626    if (strat->NotUsedAxis[i])
627    {
628      *last = i;
629      k++;
630    }
631    if (k>1)
632    {
633      *last = 0;
634      break;
635    }
636  }
637}
638
639/*2
640*last is the only non used axis, it looks
641*for a monomial in p being a pure power of this
642*variable and returns TRUE in this case
643*(*length) gives the length between the pure power and the leading term
644*(should be minimal)
645*/
646BOOLEAN hasPurePower (const poly p,int last, int *length,kStrategy strat)
647{
648  poly h;
649  int i;
650
651  if (pNext(p) == strat->tail)
652    return FALSE;
653  pp_Test(p, currRing, strat->tailRing);
654  if (strat->ak <= 0 || p_MinComp(p, currRing, strat->tailRing) == strat->ak)
655  {
656    i = p_IsPurePower(p, currRing);
657    if (i == last) 
658    {
659      *length = 0;
660      return TRUE;
661    }
662    *length = 1;
663    h = pNext(p);
664    while (h != NULL)
665    {
666      i = p_IsPurePower(h, strat->tailRing);
667      if (i==last) return TRUE;
668      (*length)++;
669      pIter(h);
670    }
671  }
672  return FALSE;
673}
674
675BOOLEAN hasPurePower (LObject *L,int last, int *length,kStrategy strat)
676{
677  if (L->bucket != NULL)
678  {
679    poly p = L->CanonicalizeP();
680    BOOLEAN ret = hasPurePower(p, last, length, strat);
681    pNext(p) = NULL;
682    return ret;
683  }
684  else 
685  {
686    return hasPurePower(L->p, last, length, strat);
687  }
688}
689
690/*2
691* looks up the position of polynomial p in L
692* in the case of looking for the pure powers
693*/
694int posInL10 (LSet const set, int length, LObject* p,kStrategy const strat)
695{
696  int j,dp,dL;
697
698  if (length<0) return 0;
699  if (hasPurePower(p,strat->lastAxis,&dp,strat))
700  {
701    int op= p->GetpFDeg() +p->ecart;
702    for (j=length; j>=0; j--)
703    {
704      if (!hasPurePower(&(set[j]),strat->lastAxis,&dL,strat))
705        return j+1;
706      if (dp < dL)
707        return j+1;
708      if ((dp == dL)
709          && (set[j].GetpFDeg()+set[j].ecart >= op))
710        return j+1;
711    }
712  }
713  j=length;
714  loop
715  {
716    if (j<0) break;
717    if (!hasPurePower(&(set[j]),strat->lastAxis,&dL,strat)) break;
718    j--;
719  }
720  return strat->posInLOld(set,j,p,strat);
721}
722
723
724/*2
725* computes the s-polynomials L[ ].p in L
726*/
727void updateL(kStrategy strat)
728{
729  LObject p;
730  int dL;
731  int j=strat->Ll;
732  loop
733  {
734    if (j<0) break;
735    if (hasPurePower(&(strat->L[j]),strat->lastAxis,&dL,strat))
736    {
737      p=strat->L[strat->Ll];
738      strat->L[strat->Ll]=strat->L[j];
739      strat->L[j]=p;
740      break;
741    }
742    j--;
743  }
744  if (j<0)
745  {
746    j=strat->Ll;
747    loop
748    {
749      if (j<0) break;
750      if (pNext(strat->L[j].p) == strat->tail)
751      {
752        pLmFree(strat->L[j].p);    /*deletes the short spoly and computes*/
753        poly m1 = NULL, m2 = NULL;
754        // check that spoly creation is ok
755        while (strat->tailRing != currRing && 
756               !kCheckSpolyCreation(&(strat->L[j]), strat, m1, m2))
757        {
758          assume(m1 == NULL && m2 == NULL);
759          // if not, change to a ring where exponents are at least
760          // large enough
761          kStratChangeTailRing(strat);
762        }
763        /* create the real one */
764        ksCreateSpoly(&(strat->L[j]), strat->kNoether, FALSE, 
765                      strat->tailRing, m1, m2, strat->R);
766
767        if (!strat->honey)
768          strat->initEcart(&strat->L[j]);
769        else
770          strat->L[j].SetLength(strat->length_pLength);
771       
772        BOOLEAN pp = hasPurePower(&(strat->L[j]),strat->lastAxis,&dL,strat);
773       
774        if (strat->use_buckets) strat->L[j].PrepareRed(TRUE);
775       
776        if (pp)
777        {
778          p=strat->L[strat->Ll];
779          strat->L[strat->Ll]=strat->L[j];
780          strat->L[j]=p;
781          break;
782        }
783      }
784      j--;
785    }
786  }
787}
788
789/*2
790* computes the s-polynomials L[ ].p in L and
791* cuts elements in L above noether
792*/
793void updateLHC(kStrategy strat)
794{
795  int i = 0;
796  kTest_TS(strat);
797  while (i <= strat->Ll)
798  {
799    if (pNext(strat->L[i].p) == strat->tail)
800    {
801       /*- deletes the int spoly and computes -*/
802      if (pLmCmp(strat->L[i].p,strat->kNoether) == -1)
803      {
804        pLmFree(strat->L[i].p);
805        strat->L[i].p = NULL;
806      }
807      else
808      {
809        pLmFree(strat->L[i].p);
810        poly m1 = NULL, m2 = NULL;
811        // check that spoly creation is ok
812        while (strat->tailRing != currRing && 
813               !kCheckSpolyCreation(&(strat->L[i]), strat, m1, m2))
814        {
815          assume(m1 == NULL && m2 == NULL);
816          // if not, change to a ring where exponents are at least
817          // large enough
818          kStratChangeTailRing(strat);
819        }
820        /* create the real one */
821        ksCreateSpoly(&(strat->L[i]), strat->kNoether, FALSE, 
822                      strat->tailRing, m1, m2, strat->R);
823        if (! strat->L[i].IsNull())
824        {
825          strat->L[i].SetpFDeg();
826          strat->L[i].ecart
827            = strat->L[i].pLDeg(strat->LDegLast) - strat->L[i].GetpFDeg();
828          if (strat->use_buckets) strat->L[i].PrepareRed(TRUE);
829        }
830      }
831    }
832    else
833      deleteHC(&(strat->L[i]), strat);
834   if (strat->L[i].IsNull())
835      deleteInL(strat->L,&strat->Ll,i,strat);
836    else
837    {
838#ifdef KDEBUG
839      kTest_L(&(strat->L[i]), strat->tailRing, TRUE, i, strat->T, strat->tl);
840#endif
841      i++;
842    }
843  }
844  kTest_TS(strat);
845}
846
847/*2
848* cuts in T above strat->kNoether and tries to cancel a unit
849*/
850void updateT(kStrategy strat)
851{
852  int i = 0;
853  LObject p;
854
855  while (i <= strat->tl)
856  {
857    p = strat->T[i];
858    deleteHC(&p,strat, TRUE);
859    /*- tries to cancel a unit: -*/
860    cancelunit(&p);
861    if (p.p != strat->T[i].p)
862    {
863      strat->sevT[i] = pGetShortExpVector(p.p);
864      p.SetpFDeg();
865    }
866    strat->T[i] = p;
867    i++;
868  }
869}
870
871/*2
872* arranges red, pos and T if strat->kHEdgeFound (first time)
873*/
874void firstUpdate(kStrategy strat)
875{
876  if (strat->update)
877  {
878    kTest_TS(strat);
879    strat->update = (strat->tl == -1);
880    if (TEST_OPT_WEIGHTM)
881    {
882      if (pFDegOld != pFDeg)
883      {
884        pFDeg=pFDegOld;
885        int i;
886        for (i =0; i<=strat->Ll; i++)
887        {
888          strat->L[i].SetpFDeg();
889        }
890        for (i=0; i<=strat->tl; i++)
891        {
892          strat->T[i].SetpFDeg();
893        }
894      }
895      pLDeg=pLDegOld;
896      kOptimizeLDeg(pFDeg, pLDeg, strat);
897      if (ecartWeights)
898      {
899        omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
900        ecartWeights=NULL;
901      }
902    }
903    if (TEST_OPT_FASTHC)
904    {
905      strat->posInL = strat->posInLOld;
906      strat->lastAxis = 0;
907    }
908    if (BTEST1(27))
909      return;
910    strat->red = redFirst;
911    strat->use_buckets = kMoraUseBucket(strat);
912    updateT(strat);
913    strat->posInT = posInT2;
914    reorderT(strat);
915  }
916  kTest_TS(strat);
917}
918
919/*2
920*-puts p to the standardbasis s at position at
921*-reduces the tail of p if TEST_OPT_REDTAIL
922*-tries to cancel a unit
923*-HEckeTest
924*  if TRUE
925*  - decides about reduction-strategies
926*  - computes noether
927*  - stops computation if BTEST1(27)
928*  - cuts the tails of the polynomials
929*    in s,t and the elements in L above noether
930*    and cancels units if possible
931*  - reorders s,L
932*/
933void enterSMora (LObject p,int atS,kStrategy strat, int atR = -1)
934{
935  int i;
936  enterSBba(p, atS, strat, atR);
937  if (TEST_OPT_DEBUG)
938  {
939    Print("new s%d:",atS);
940    wrp(p.p);
941    PrintLn();
942  }
943  if ((!strat->kHEdgeFound) || (strat->kNoether!=NULL)) HEckeTest(p.p,strat);
944  if (strat->kHEdgeFound)
945  {
946    if (newHEdge(strat->S,strat->ak,strat))
947    {
948      firstUpdate(strat);
949      if (BTEST1(27))
950        return;
951      /*- cuts elements in L above noether and reorders L -*/
952      updateLHC(strat);
953      /*- reorders L with respect to posInL -*/
954      reorderL(strat);
955    }
956  }
957  else if (strat->kNoether!=NULL)
958    strat->kHEdgeFound = TRUE;
959  else if (TEST_OPT_FASTHC)
960  {
961    if (strat->posInLOldFlag)
962    {
963      missingAxis(&strat->lastAxis,strat);
964      if (strat->lastAxis)
965      {
966        strat->posInLOld = strat->posInL;
967        strat->posInLOldFlag = FALSE;
968        strat->posInL = posInL10;
969        strat->posInLDependsOnLength = TRUE;
970        updateL(strat);
971        reorderL(strat);
972      }
973    }
974    else if (strat->lastAxis)
975      updateL(strat);
976  }
977}
978
979/*2
980*-puts p to the standardbasis s at position at
981*-HEckeTest
982*  if TRUE
983*  - computes noether
984*/
985void enterSMoraNF (LObject p, int atS,kStrategy strat, int atR = -1)
986{
987  int i;
988
989  enterSBba(p, atS, strat, atR);
990  if ((!strat->kHEdgeFound) || (strat->kNoether!=NULL)) HEckeTest(p.p,strat);
991  if (strat->kHEdgeFound)
992    newHEdge(strat->S,strat->ak,strat);
993  else if (strat->kNoether!=NULL)
994    strat->kHEdgeFound = TRUE;
995}
996
997
998void initMora(ideal F,kStrategy strat)
999{
1000  int i,j;
1001  idhdl h;
1002
1003  strat->NotUsedAxis = (BOOLEAN *)omAlloc((pVariables+1)*sizeof(BOOLEAN));
1004  for (j=pVariables; j>0; j--) strat->NotUsedAxis[j] = TRUE;
1005  strat->enterS = enterSMora;
1006  strat->initEcartPair = initEcartPairMora; /*- ecart approximation -*/
1007  strat->posInLOld = strat->posInL;
1008  strat->posInLOldFlag = TRUE;
1009  strat->initEcart = initEcartNormal;
1010  strat->kHEdgeFound = ppNoether != NULL;
1011  if ( strat->kHEdgeFound )
1012     strat->kNoether = pCopy(ppNoether);
1013  else if (strat->kHEdgeFound || strat->homog)
1014    strat->red = redFirst;  /*take the first possible in T*/
1015  else
1016    strat->red = redEcart;/*take the first possible in under ecart-restriction*/
1017  if (strat->kHEdgeFound)
1018  {
1019    strat->HCord = pFDeg(ppNoether)+1;
1020    strat->posInT = posInT2;
1021  }
1022  else
1023  {
1024    strat->HCord = 32000;/*- very large -*/
1025  }
1026  /*reads the ecartWeights used for Graebes method from the
1027   *intvec ecart and set ecartWeights
1028   */
1029  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1030  {
1031    //interred  machen   Aenderung
1032    pFDegOld=pFDeg;
1033    pLDegOld=pLDeg;
1034    h=ggetid("ecart");
1035    if ((h!=NULL) && (IDTYP(h)==INTVEC_CMD))
1036    {
1037      ecartWeights=iv2array(IDINTVEC(h));
1038    }
1039    else
1040    {
1041      ecartWeights=(short *)omAlloc((pVariables+1)*sizeof(short));
1042      /*uses automatic computation of the ecartWeights to set them*/
1043      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
1044    }
1045    pFDeg=totaldegreeWecart;
1046    pLDeg=maxdegreeWecart;
1047    for(i=1; i<=pVariables; i++)
1048      Print(" %d",ecartWeights[i]);
1049    PrintLn();
1050    mflush();
1051  }
1052  kOptimizeLDeg(pFDeg, pLDeg, strat);
1053}
1054
1055#ifdef HAVE_ASSUME
1056static int mora_count = 0;
1057static int mora_loop_count;
1058#endif
1059
1060ideal mora (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
1061{
1062#ifdef HAVE_ASSUME
1063  mora_count++;
1064  mora_loop_count = 0;
1065#endif
1066#ifdef KDEBUG
1067  om_Opts.MinTrack = 5;
1068#endif
1069  int srmax;
1070  int lrmax = 0;
1071  int olddeg = 0;
1072  int reduc = 0;
1073  int red_result = 1;
1074  int hilbeledeg=1,hilbcount=0;
1075
1076  strat->update = TRUE;
1077  /*- setting global variables ------------------- -*/
1078  initBuchMoraCrit(strat);
1079  initHilbCrit(F,Q,&hilb,strat);
1080  initMora(F,strat);
1081  initBuchMoraPos(strat);
1082  /*Shdl=*/initBuchMora(F,Q,strat);
1083  if (TEST_OPT_FASTHC) missingAxis(&strat->lastAxis,strat);
1084  /*updateS in initBuchMora has Hecketest
1085  * and could have put strat->kHEdgdeFound FALSE*/
1086  if (ppNoether!=NULL)
1087  {
1088    strat->kHEdgeFound = TRUE;
1089  }
1090  if (strat->kHEdgeFound && strat->update)
1091  {
1092    firstUpdate(strat);
1093    updateLHC(strat);
1094    reorderL(strat);
1095  }
1096  if (TEST_OPT_FASTHC && (strat->lastAxis) && strat->posInLOldFlag)
1097  {
1098    strat->posInLOld = strat->posInL;
1099    strat->posInLOldFlag = FALSE;
1100    strat->posInL = posInL10;
1101    updateL(strat);
1102    reorderL(strat);
1103  }
1104  srmax = strat->sl;
1105  kTest_TS(strat);
1106  strat->use_buckets = kMoraUseBucket(strat);
1107  /*- compute-------------------------------------------*/
1108
1109#ifdef HAVE_TAIL_RING
1110  kStratInitChangeTailRing(strat);
1111#endif 
1112 
1113  while (strat->Ll >= 0)
1114  {
1115#ifdef HAVE_ASSUME
1116    mora_loop_count++;
1117#endif
1118    if (lrmax< strat->Ll) lrmax=strat->Ll; /*stat*/
1119    //test_int_std(strat->kIdeal);
1120    if (TEST_OPT_DEBUG) messageSets(strat);
1121    if (TEST_OPT_DEGBOUND
1122    && (strat->L[strat->Ll].ecart+strat->L[strat->Ll].GetpFDeg()> Kstd1_deg))
1123    {
1124      /*
1125      * stops computation if
1126      * - 24 (degBound)
1127      *   && upper degree is bigger than Kstd1_deg
1128      */
1129      while ((strat->Ll >= 0)
1130        && (strat->L[strat->Ll].ecart+strat->L[strat->Ll].GetpFDeg()> Kstd1_deg)
1131        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL))
1132      {
1133        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1134        //if (TEST_OPT_PROT)
1135        //{
1136        //   PrintS("D"); mflush();
1137        //}
1138      }
1139      if (strat->Ll<0) break;
1140    }
1141    strat->P = strat->L[strat->Ll];/*- picks the last element from the lazyset L -*/
1142    if (strat->Ll==0) strat->interpt=TRUE;
1143    strat->Ll--;
1144
1145    // create the real Spoly
1146    if (pNext(strat->P.p) == strat->tail)
1147    {
1148      /*- deletes the short spoly and computes -*/
1149      pLmFree(strat->P.p);
1150      strat->P.p = NULL;
1151      poly m1 = NULL, m2 = NULL;
1152      // check that spoly creation is ok
1153      while (strat->tailRing != currRing && 
1154             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1155      {
1156        assume(m1 == NULL && m2 == NULL);
1157        // if not, change to a ring where exponents are large enough
1158        kStratChangeTailRing(strat);
1159      }
1160      /* create the real one */
1161      ksCreateSpoly(&(strat->P), strat->kNoether, strat->use_buckets, 
1162                    strat->tailRing, m1, m2, strat->R);
1163      if (!strat->use_buckets)
1164        strat->P.SetLength(strat->length_pLength);
1165    }
1166    else if (strat->P.p1 == NULL)
1167    {
1168      // for input polys, prepare reduction (buckets !)
1169      strat->P.SetLength(strat->length_pLength);
1170      strat->P.PrepareRed(strat->use_buckets);
1171    }
1172   
1173    if (!strat->P.IsNull())
1174    {
1175      // might be NULL from noether !!!
1176      if (TEST_OPT_PROT) 
1177        message(strat->P.ecart+strat->P.GetpFDeg(),&olddeg,&reduc,strat, red_result);
1178      // reduce
1179      red_result = strat->red(&strat->P,strat);
1180    }
1181
1182    if (! strat->P.IsNull())
1183    {
1184      strat->P.GetP();
1185      // statistics
1186      if (TEST_OPT_PROT) PrintS("s");
1187      // normalization
1188      if (!TEST_OPT_INTSTRATEGY)
1189        strat->P.pNorm();
1190      // tailreduction
1191      strat->P.p = redtail(&(strat->P),strat->sl,strat);
1192      // set ecart -- might have changed because of tail reductions
1193      if ((!strat->noTailReduction) && (!strat->honey))
1194        strat->initEcart(&strat->P);
1195      // for char 0, clear denominators
1196      if (TEST_OPT_INTSTRATEGY)
1197        strat->P.pCleardenom();
1198      // cancel unit
1199      cancelunit(&strat->P);
1200
1201      // put in T
1202      enterT(strat->P,strat);
1203      // build new pairs
1204      enterpairs(strat->P.p,strat->sl,strat->P.ecart,0,strat, strat->tl);
1205      // put in S
1206      strat->enterS(strat->P, posInS(strat->S,strat->sl,strat->P.p),
1207                    strat, strat->tl);
1208
1209      // apply hilbert criterion
1210      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1211
1212      // clear strat->P
1213      if (strat->P.lcm!=NULL) pLmFree(strat->P.lcm);
1214      strat->P.lcm=NULL;
1215#ifdef KDEBUG
1216      // make sure kTest_TS does not complain about strat->P
1217      memset(&strat->P,0,sizeof(strat->P));
1218#endif
1219      if (strat->sl>srmax) srmax = strat->sl; /*stat.*/
1220      if (strat->Ll>lrmax) lrmax = strat->Ll;
1221    }
1222    if (strat->kHEdgeFound)
1223    {
1224      if ((BTEST1(27))
1225      || ((TEST_OPT_MULTBOUND) && (scMult0Int((strat->Shdl)) < mu)))
1226      {
1227        // obachman: is this still used ???
1228        /*
1229        * stops computation if strat->kHEdgeFound and
1230        * - 27 (finiteDeterminacyTest)
1231        * or
1232        * - 23
1233        *   (multBound)
1234        *   && multiplicity of the ideal is smaller then a predefined number mu
1235        */
1236        while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1237      }
1238    }
1239    kTest_TS(strat);
1240  }
1241  /*- complete reduction of the standard basis------------------------ -*/
1242  if (TEST_OPT_REDSB) completeReduce(strat);
1243  /*- release temp data------------------------------- -*/
1244  exitBuchMora(strat);
1245  /*- polynomials used for HECKE: HC, noether -*/
1246  if (BTEST1(27))
1247  {
1248    if (strat->kHEdge!=NULL)
1249      Kstd1_mu=pFDeg(strat->kHEdge);
1250    else
1251      Kstd1_mu=-1;
1252  }
1253  pDelete(&strat->kHEdge);
1254  strat->update = TRUE; //???
1255  strat->lastAxis = 0; //???
1256  pDelete(&strat->kNoether);
1257  omFreeSize((ADDRESS)strat->NotUsedAxis,(pVariables+1)*sizeof(BOOLEAN));
1258  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1259  if (TEST_OPT_WEIGHTM)
1260  {
1261    pFDeg=pFDegOld;
1262    pLDeg=pLDegOld;
1263    if (ecartWeights)
1264    {
1265      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1266      ecartWeights=NULL;
1267    }
1268  }
1269  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1270  idTest(strat->Shdl);
1271  return (strat->Shdl);
1272}
1273
1274poly kNF1 (ideal F,ideal Q,poly q, kStrategy strat, int lazyReduce)
1275{
1276  poly   p;
1277  int   i;
1278  int   j;
1279  int   o;
1280  LObject   h;
1281  BITSET save_test=test;
1282
1283  if ((idIs0(F))&&(Q==NULL))
1284    return pCopy(q); /*F=0*/
1285  strat->ak = max(idRankFreeModule(F),pMaxComp(q));
1286  /*- creating temp data structures------------------- -*/
1287  strat->kHEdgeFound = ppNoether != NULL;
1288  strat->kNoether    = pCopy(ppNoether);
1289  test|=Sy_bit(OPT_REDTAIL);
1290  test&=~Sy_bit(OPT_INTSTRATEGY);
1291  if (TEST_OPT_STAIRCASEBOUND
1292  && (! TEST_V_DEG_STOP)
1293  && (0<Kstd1_deg)
1294  && ((!strat->kHEdgeFound)
1295    ||(TEST_OPT_DEGBOUND && (pWTotaldegree(strat->kNoether)<Kstd1_deg))))
1296  {
1297    pDelete(&strat->kNoether);
1298    strat->kNoether=pOne();
1299    pSetExp(strat->kNoether,1, Kstd1_deg+1);
1300    pSetm(strat->kNoether);
1301    strat->kHEdgeFound=TRUE;
1302  }
1303  initBuchMoraCrit(strat);
1304  initBuchMoraPos(strat);
1305  initMora(F,strat);
1306  strat->enterS = enterSMoraNF;
1307  /*- set T -*/
1308  strat->tl = -1;
1309  strat->tmax = setmax;
1310  strat->T = initT();
1311  strat->R = initR();
1312  strat->sevT = initsevT();
1313  /*- set S -*/
1314  strat->sl = -1;
1315  /*- init local data struct.-------------------------- -*/
1316  /*Shdl=*/initS(F,Q,strat);
1317  if ((strat->ak!=0)
1318  && (strat->kHEdgeFound))
1319  {
1320    if (strat->ak!=1)
1321    {
1322      pSetComp(strat->kNoether,1);
1323      pSetmComp(strat->kNoether);
1324      poly p=pHead(strat->kNoether);
1325      pSetComp(p,strat->ak);
1326      pSetmComp(p);
1327      p=pAdd(strat->kNoether,p);
1328      strat->kNoether=pNext(p);
1329      p_LmFree(p,currRing);
1330    }
1331  }
1332  if ((lazyReduce & 1)==0)
1333  {
1334    for (i=strat->sl; i>=0; i--)
1335      pNorm(strat->S[i]);
1336  }
1337  /*- puts the elements of S also to T -*/
1338  for (i=0; i<=strat->sl; i++)
1339  {
1340    h.p = strat->S[i];
1341    h.ecart = strat->ecartS[i];
1342    if (strat->sevS[i] == 0) strat->sevS[i] = pGetShortExpVector(h.p);
1343    else assume(strat->sevS[i] == pGetShortExpVector(h.p));
1344    h.length = pLength(h.p);
1345    h.sev = strat->sevS[i];
1346    h.SetpFDeg();
1347    enterT(h,strat);
1348  }
1349  /*- compute------------------------------------------- -*/
1350  p = pCopy(q);
1351  deleteHC(&p,&o,&j,strat);
1352  if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
1353  if (p!=NULL) p = redMoraNF(p,strat, lazyReduce & 2);
1354  if ((p!=NULL)&&((lazyReduce & 1)==0))
1355  {
1356    if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
1357    p = redtail(p,strat->sl,strat);
1358  }
1359  /*- release temp data------------------------------- -*/
1360  cleanT(strat);
1361  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
1362  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
1363  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
1364  omFreeSize((ADDRESS)strat->NotUsedAxis,(pVariables+1)*sizeof(BOOLEAN));
1365  omfree(strat->sevT);
1366  omfree(strat->S_2_R);
1367  omfree(strat->R);
1368
1369  if ((Q!=NULL)&&(strat->fromQ!=NULL))
1370  {
1371    i=((IDELEMS(Q)+IDELEMS(F)+15)/16)*16;
1372    omFreeSize((ADDRESS)strat->fromQ,i*sizeof(int));
1373    strat->fromQ=NULL;
1374  }
1375  pDelete(&strat->kHEdge);
1376  pDelete(&strat->kNoether);
1377  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1378  {
1379    pFDeg=pFDegOld;
1380    pLDeg=pLDegOld;
1381    if (ecartWeights)
1382    {
1383      omFreeSize((ADDRESS *)&ecartWeights,(pVariables+1)*sizeof(short));
1384      ecartWeights=NULL;
1385    }
1386  }
1387  idDelete(&strat->Shdl);
1388  test=save_test;
1389  if (TEST_OPT_PROT) PrintLn();
1390  return p;
1391}
1392
1393ideal kNF1 (ideal F,ideal Q,ideal q, kStrategy strat, int lazyReduce)
1394{
1395  poly   p;
1396  int   i;
1397  int   j;
1398  int   o;
1399  LObject   h;
1400  ideal res;
1401  BITSET save_test=test;
1402
1403  if (idIs0(q)) return idInit(1,q->rank);
1404  if ((idIs0(F))&&(Q==NULL))
1405    return idCopy(q); /*F=0*/
1406  strat->ak = max(idRankFreeModule(F),idRankFreeModule(q));
1407  /*- creating temp data structures------------------- -*/
1408  strat->kHEdgeFound = ppNoether != NULL;
1409  strat->kNoether=pCopy(ppNoether);
1410  test|=Sy_bit(OPT_REDTAIL);
1411  if (TEST_OPT_STAIRCASEBOUND
1412  && (0<Kstd1_deg)
1413  && ((!strat->kHEdgeFound)
1414    ||(TEST_OPT_DEGBOUND && (pWTotaldegree(strat->kNoether)<Kstd1_deg))))
1415  {
1416    pDelete(&strat->kNoether);
1417    strat->kNoether=pOne();
1418    pSetExp(strat->kNoether,1, Kstd1_deg+1);
1419    pSetm(strat->kNoether);
1420    strat->kHEdgeFound=TRUE;
1421  }
1422  initBuchMoraCrit(strat);
1423  initBuchMoraPos(strat);
1424  initMora(F,strat);
1425  strat->enterS = enterSMoraNF;
1426  /*- set T -*/
1427  strat->tl = -1;
1428  strat->tmax = setmax;
1429  strat->T = initT();
1430  strat->R = initR();
1431  strat->sevT = initsevT();
1432  /*- set S -*/
1433  strat->sl = -1;
1434  /*- init local data struct.-------------------------- -*/
1435  /*Shdl=*/initS(F,Q,strat);
1436  if ((strat->ak!=0)
1437  && (strat->kHEdgeFound))
1438  {
1439    if (strat->ak!=1)
1440    {
1441      pSetComp(strat->kNoether,1);
1442      pSetmComp(strat->kNoether);
1443      poly p=pHead(strat->kNoether);
1444      pSetComp(p,strat->ak);
1445      pSetmComp(p);
1446      p=pAdd(strat->kNoether,p);
1447      strat->kNoether=pNext(p);
1448      p_LmFree(p,currRing);
1449    }
1450  }
1451  if (TEST_OPT_INTSTRATEGY && ((lazyReduce & 1)==0))
1452  {
1453    for (i=strat->sl; i>=0; i--)
1454      pNorm(strat->S[i]);
1455  }
1456  /*- compute------------------------------------------- -*/
1457  res=idInit(IDELEMS(q),q->rank);
1458  for (i=0; i<IDELEMS(q); i++)
1459  {
1460    if (q->m[i]!=NULL)
1461    {
1462      p = pCopy(q->m[i]);
1463      deleteHC(&p,&o,&j,strat);
1464      if (p!=NULL)
1465      {
1466        /*- puts the elements of S also to T -*/
1467        for (j=0; j<=strat->sl; j++)
1468        {
1469          h.p = strat->S[j];
1470          h.ecart = strat->ecartS[j];
1471          h.pLength = h.length = pLength(h.p);
1472          if (strat->sevS[j] == 0) strat->sevS[j] = pGetShortExpVector(h.p);
1473          else assume(strat->sevS[j] == pGetShortExpVector(h.p));
1474          h.sev = strat->sevS[j];
1475          h.SetpFDeg();
1476          enterT(h,strat);
1477        }
1478        if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
1479        p = redMoraNF(p,strat, lazyReduce & 2);
1480        if ((p!=NULL)&&((lazyReduce & 1)==0))
1481        {
1482          if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
1483          p = redtail(p,strat->sl,strat);
1484        }
1485        cleanT(strat);
1486      }
1487      res->m[i]=p;
1488    }
1489    //else
1490    //  res->m[i]=NULL;
1491  }
1492  /*- release temp data------------------------------- -*/
1493  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
1494  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
1495  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
1496  omFreeSize((ADDRESS)strat->NotUsedAxis,(pVariables+1)*sizeof(BOOLEAN));
1497  omfree(strat->sevT);
1498  omfree(strat->S_2_R);
1499  omfree(strat->R);
1500  if ((Q!=NULL)&&(strat->fromQ!=NULL))
1501  {
1502    i=((IDELEMS(Q)+IDELEMS(F)+15)/16)*16;
1503    omFreeSize((ADDRESS)strat->fromQ,i*sizeof(int));
1504    strat->fromQ=NULL;
1505  }
1506  pDelete(&strat->kHEdge);
1507  pDelete(&strat->kNoether);
1508  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1509  {
1510    pFDeg=pFDegOld;
1511    pLDeg=pLDegOld;
1512    if (ecartWeights)
1513    {
1514      omFreeSize((ADDRESS *)&ecartWeights,(pVariables+1)*sizeof(short));
1515      ecartWeights=NULL;
1516    }
1517  }
1518  idDelete(&strat->Shdl);
1519  test=save_test;
1520  if (TEST_OPT_PROT) PrintLn();
1521  return res;
1522}
1523
1524pFDegProc pOldFDeg;
1525intvec * kModW, * kHomW;
1526
1527long kModDeg(poly p, ring r)
1528{
1529  long o=pWDegree(p, r);
1530  long i=p_GetComp(p, r);
1531  if (i==0) return o;
1532  return o+(*kModW)[i-1];
1533}
1534long kHomModDeg(poly p, ring r)
1535{
1536  int i;
1537  long j=0;
1538
1539  for (i=r->N;i>0;i--)
1540    j+=p_GetExp(p,i,r)*(*kHomW)[i-1];
1541  if (kModW == NULL) return j;
1542  i = p_GetComp(p,r);
1543  if (i==0) return j;
1544  return j+(*kModW)[i-1];
1545}
1546
1547ideal kStd(ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
1548          int newIdeal, intvec *vw)
1549{
1550  ideal r;
1551  BOOLEAN b=pLexOrder,toReset=FALSE;
1552  BOOLEAN delete_w=(w==NULL);
1553  kStrategy strat=new skStrategy;
1554
1555  if(!TEST_OPT_RETURN_SB)
1556    strat->syzComp = syzComp;
1557  if (TEST_OPT_SB_1)
1558    strat->newIdeal = newIdeal;
1559  if (rField_has_simple_inverse())
1560    strat->LazyPass=20;
1561  else
1562    strat->LazyPass=2;
1563  strat->LazyDegree = 1;
1564  strat->ak = idRankFreeModule(F);
1565  strat->kModW=kModW=NULL;
1566  strat->kHomW=kHomW=NULL;
1567  if (vw != NULL)
1568  {
1569    pLexOrder=FALSE;
1570    strat->kHomW=kHomW=vw;
1571    pOldFDeg = pFDeg;
1572    pFDeg = kHomModDeg;
1573    toReset = TRUE;
1574  }
1575  if ((h==testHomog)
1576  )
1577  {
1578    if (strat->ak == 0)
1579    {
1580      h = (tHomog)idHomIdeal(F,Q);
1581      w=NULL;
1582    }
1583    else
1584    {
1585      h = (tHomog)idHomModule(F,Q,w);
1586    }
1587  }
1588  pLexOrder=b;
1589  if (h==isHomog)
1590  {
1591    if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
1592    {
1593      strat->kModW = kModW = *w;
1594      if (vw == NULL)
1595      {
1596        pOldFDeg = pFDeg;
1597        pFDeg = kModDeg;
1598        toReset = TRUE;
1599      }
1600    }
1601    pLexOrder = TRUE;
1602    if (hilb==NULL) strat->LazyPass*=2;
1603  }
1604  strat->homog=h;
1605#ifdef KDEBUG
1606  idTest(F);
1607#endif
1608  if (pOrdSgn==-1)
1609  {
1610    if (w!=NULL)
1611      r=mora(F,Q,*w,hilb,strat);
1612    else
1613      r=mora(F,Q,NULL,hilb,strat);
1614  }
1615  else
1616  {
1617    if (w!=NULL)
1618      r=bba(F,Q,*w,hilb,strat);
1619    else
1620      r=bba(F,Q,NULL,hilb,strat);
1621  }
1622#ifdef KDEBUG
1623  idTest(r);
1624#endif
1625  if (toReset)
1626  {
1627    kModW = NULL;
1628    pFDeg = pOldFDeg;
1629  }
1630  pLexOrder = b;
1631//Print("%d reductions canceled \n",strat->cel);
1632  HCord=strat->HCord;
1633  delete(strat);
1634  if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
1635  return r;
1636}
1637
1638//##############################################################
1639//##############################################################
1640//##############################################################
1641//##############################################################
1642//##############################################################
1643
1644lists min_std(ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
1645              int reduced)
1646{
1647  ideal r=NULL;
1648  int Kstd1_OldDeg = Kstd1_deg,i;
1649  intvec* temp_w=NULL;
1650  BOOLEAN b=pLexOrder,toReset=FALSE;
1651  BOOLEAN delete_w=(w==NULL);
1652  BOOLEAN oldDegBound=TEST_OPT_DEGBOUND;
1653  kStrategy strat=new skStrategy;
1654
1655  if(!TEST_OPT_RETURN_SB)
1656     strat->syzComp = syzComp;
1657  if (rField_has_simple_inverse())
1658    strat->LazyPass=20;
1659  else
1660    strat->LazyPass=2;
1661  strat->LazyDegree = 1;
1662  strat->minim=(reduced % 2)+1;
1663  strat->ak = idRankFreeModule(F);
1664  if (delete_w)
1665  {
1666    temp_w=new intvec((strat->ak)+1);
1667    w = &temp_w;
1668  }
1669  if ((h==testHomog)
1670  )
1671  {
1672    if (strat->ak == 0)
1673    {
1674      h = (tHomog)idHomIdeal(F,Q);
1675      w=NULL;
1676    }
1677    else
1678    {
1679      h = (tHomog)idHomModule(F,Q,w);
1680    }
1681  }
1682  if (h==isHomog)
1683  {
1684    if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
1685    {
1686      kModW = *w;
1687      strat->kModW = *w;
1688      pOldFDeg = pFDeg;
1689      pFDeg = kModDeg;
1690      toReset = TRUE;
1691      if (reduced>1)
1692      {
1693        Kstd1_OldDeg=Kstd1_deg;
1694        Kstd1_deg = -1;
1695        for (i=IDELEMS(F)-1;i>=0;i--)
1696        {
1697          if ((F->m[i]!=NULL) && (pFDeg(F->m[i])>=Kstd1_deg))
1698            Kstd1_deg = pFDeg(F->m[i])+1;
1699        }
1700      }
1701    }
1702    pLexOrder = TRUE;
1703    strat->LazyPass*=2;
1704  }
1705  strat->homog=h;
1706  if (pOrdSgn==-1)
1707  {
1708    if (w!=NULL)
1709      r=mora(F,Q,*w,hilb,strat);
1710    else
1711      r=mora(F,Q,NULL,hilb,strat);
1712  }
1713  else
1714  {
1715    if (w!=NULL)
1716      r=bba(F,Q,*w,hilb,strat);
1717    else
1718      r=bba(F,Q,NULL,hilb,strat);
1719  }
1720#ifdef KDEBUG
1721  {
1722    int i;
1723    for (i=0; i<IDELEMS(r); i++) pTest(r->m[i]);
1724  }
1725#endif
1726  idSkipZeroes(r);
1727  if (toReset)
1728  {
1729    kModW = NULL;
1730    pFDeg = pOldFDeg;
1731  }
1732  pLexOrder = b;
1733  HCord=strat->HCord;
1734  if ((delete_w)&&(temp_w!=NULL)) delete temp_w;
1735  lists l=(lists)omAllocBin(slists_bin);
1736  l->Init(2);
1737  if (strat->ak==0)
1738  {
1739    l->m[0].rtyp=IDEAL_CMD;
1740    l->m[1].rtyp=IDEAL_CMD;
1741  }
1742  else
1743  {
1744    l->m[0].rtyp=MODUL_CMD;
1745    l->m[1].rtyp=MODUL_CMD;
1746  }
1747  l->m[0].data=(void *)r;
1748  setFlag(&(l->m[0]),FLAG_STD);
1749  if (strat->M==NULL)
1750  {
1751    l->m[1].data=(void *)idInit(1,F->rank);
1752    Warn("no minimal generating set computed");
1753  }
1754  else
1755  {
1756    idSkipZeroes(strat->M);
1757    l->m[1].data=(void *)strat->M;
1758  }
1759  delete(strat);
1760  if (reduced>2)
1761  {
1762    Kstd1_deg=Kstd1_OldDeg;
1763    if (!oldDegBound)
1764      test &= ~Sy_bit(OPT_DEGBOUND);
1765  }
1766  return l;
1767}
1768
1769poly kNF(ideal F, ideal Q, poly p,int syzComp, int lazyReduce)
1770{
1771  if (p==NULL)
1772     return NULL;
1773  kStrategy strat=new skStrategy;
1774  strat->syzComp = syzComp;
1775  if (pOrdSgn==-1)
1776    p=kNF1(F,Q,p,strat,lazyReduce);
1777  else
1778    p=kNF2(F,Q,p,strat,lazyReduce);
1779  delete(strat);
1780  return p;
1781}
1782
1783ideal kNF(ideal F, ideal Q, ideal p,int syzComp,int lazyReduce)
1784{
1785  ideal res;
1786  if (TEST_OPT_PROT)
1787  {
1788    Print("(S:%d)",IDELEMS(p));mflush();
1789  }
1790  kStrategy strat=new skStrategy;
1791  strat->syzComp = syzComp;
1792  if (pOrdSgn==-1)
1793    res=kNF1(F,Q,p,strat,lazyReduce);
1794  else
1795    res=kNF2(F,Q,p,strat,lazyReduce);
1796  delete(strat);
1797  return res;
1798}
1799
1800/*2
1801*interreduces F
1802*/
1803ideal kInterRed (ideal F, ideal Q)
1804{
1805  int j;
1806  kStrategy strat = new skStrategy;
1807
1808//  if (TEST_OPT_PROT)
1809//  {
1810//    writeTime("start InterRed:");
1811//    mflush();
1812//  }
1813  //strat->syzComp     = 0;
1814  strat->kHEdgeFound = ppNoether != NULL;
1815  strat->kNoether=pCopy(ppNoether);
1816  strat->ak = idRankFreeModule(F);
1817  initBuchMoraCrit(strat);
1818  strat->NotUsedAxis = (BOOLEAN *)omAlloc((pVariables+1)*sizeof(BOOLEAN));
1819  for (j=pVariables; j>0; j--) strat->NotUsedAxis[j] = TRUE;
1820  strat->enterS      = enterSBba;
1821  strat->posInT      = posInT0;
1822  strat->initEcart   = initEcartNormal;
1823  strat->sl   = -1;
1824  strat->tl          = -1;
1825  strat->tmax        = setmax;
1826  strat->T           = initT();
1827  strat->R           = initR();
1828  strat->sevT        = initsevT();
1829  if (pOrdSgn == -1)   strat->honey = TRUE;
1830  initS(F,Q,strat);
1831  if (TEST_OPT_REDSB)
1832    strat->noTailReduction=FALSE;
1833  updateS(TRUE,strat);
1834  if (TEST_OPT_REDSB && TEST_OPT_INTSTRATEGY)
1835    completeReduce(strat);
1836  pDelete(&strat->kHEdge);
1837  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
1838  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
1839  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
1840  omFreeSize((ADDRESS)strat->NotUsedAxis,(pVariables+1)*sizeof(BOOLEAN));
1841  omfree(strat->sevT);
1842  omfree(strat->S_2_R);
1843  omfree(strat->R);
1844
1845  if (strat->fromQ)
1846  {
1847    for (j=0;j<IDELEMS(strat->Shdl);j++)
1848    {
1849      if(strat->fromQ[j]) pDelete(&strat->Shdl->m[j]);
1850    }
1851    omFreeSize((ADDRESS)strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
1852    strat->fromQ=NULL;
1853    idSkipZeroes(strat->Shdl);
1854  }
1855//  if (TEST_OPT_PROT)
1856//  {
1857//    writeTime("end Interred:");
1858//    mflush();
1859//  }
1860  ideal shdl=strat->Shdl;
1861  delete(strat);
1862  return shdl;
1863}
1864
1865// returns TRUE if mora should use buckets, false otherwise
1866static BOOLEAN kMoraUseBucket(kStrategy strat)
1867{
1868#ifdef MORA_USE_BUCKETS
1869  if (TEST_OPT_NOT_BUCKETS) 
1870    return FALSE;
1871  if (strat->red == redFirst)
1872  {
1873#ifdef NO_LDEG
1874    if (!strat->syzComp)
1875      return TRUE;
1876#else   
1877    if ((strat->homog || strat->honey) && !strat->syzComp) 
1878      return TRUE;
1879#endif
1880  }
1881  else
1882  {
1883    assume(strat->red == redEcart);
1884    if (strat->honey && !strat->syzComp)
1885      return TRUE;
1886  }
1887#endif
1888  return FALSE;
1889}
Note: See TracBrowser for help on using the repository browser.