source: git/kernel/kstd1.cc @ 939847

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