source: git/Singular/kstd1.cc @ 5ca9807

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