source: git/Singular/kstd1.cc @ a5189b

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