source: git/Singular/kstd1.cc @ 6b32990

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