source: git/kernel/GBEngine/kstd1.cc @ fd1b1be

spielwiese
Last change on this file since fd1b1be was fd1b1be, checked in by Oleksandr Motsak <motsak@…>, 10 years ago
Minor header correction
  • Property mode set to 100644
File size: 79.1 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT:
6*/
7
8// TODO: why the following is here instead of mod2.h???
9
10
11// define if buckets should be used
12#define MORA_USE_BUCKETS
13
14#define MYTEST 0
15
16#define ADIDEBUG 0
17#define ADIDEBUG_NF 0
18
19#include <kernel/mod2.h>
20
21#include <omalloc/omalloc.h>
22
23#include <misc/options.h>
24#include <misc/intvec.h>
25
26#if MYTEST
27#ifdef HAVE_TAIL_RING
28#undef HAVE_TAIL_RING
29#endif /* ifdef HAVE_TAIL_RING */
30#endif /* if MYTEST */
31
32#include <polys/weight.h>
33#include <kernel/polys.h>
34
35#include <kernel/GBEngine/kutil.h>
36#include <kernel/febase.h>
37#include <kernel/GBEngine/kstd1.h>
38#include <kernel/GBEngine/khstd.h>
39#include <kernel/GBEngine/stairc.h>
40//#include "cntrlc.h"
41#include <kernel/ideals.h>
42//#include "../Singular/ipid.h"
43#include <kernel/timer.h>
44
45//#include "ipprint.h"
46
47#ifdef HAVE_PLURAL
48#include <polys/nc/nc.h>
49#include <polys/nc/sca.h>
50#include <kernel/GBEngine/nc.h>
51#endif
52
53#include <kernel/GBEngine/kInline.h>
54
55
56/* the list of all options which give a warning by test */
57BITSET kOptions=Sy_bit(OPT_PROT)           /*  0 */
58                |Sy_bit(OPT_REDSB)         /*  1 */
59                |Sy_bit(OPT_NOT_SUGAR)     /*  3 */
60                |Sy_bit(OPT_INTERRUPT)     /*  4 */
61                |Sy_bit(OPT_SUGARCRIT)     /*  5 */
62                |Sy_bit(OPT_REDTHROUGH)
63                |Sy_bit(OPT_OLDSTD)
64                |Sy_bit(OPT_FASTHC)        /* 10 */
65                |Sy_bit(OPT_INTSTRATEGY)   /* 26 */
66                |Sy_bit(OPT_INFREDTAIL)    /* 28 */
67                |Sy_bit(OPT_NOTREGULARITY) /* 30 */
68                |Sy_bit(OPT_WEIGHTM);      /* 31 */
69
70/* the list of all options which may be used by option and test */
71BITSET validOpts=Sy_bit(0)
72                |Sy_bit(1)
73                |Sy_bit(2) // obachman 10/00: replaced by notBucket
74                |Sy_bit(3)
75                |Sy_bit(4)
76                |Sy_bit(5)
77                |Sy_bit(6)
78//                |Sy_bit(7) obachman 11/00 tossed: 12/00 used for redThrough
79                |Sy_bit(7) // OPT_REDTHROUGH
80                |Sy_bit(8) // obachman 11/00 tossed -> motsak 2011 experimental: OPT_NO_SYZ_MINIM
81                |Sy_bit(9)
82                |Sy_bit(10)
83                |Sy_bit(11)
84                |Sy_bit(12)
85                |Sy_bit(13)
86                |Sy_bit(14)
87                |Sy_bit(15)
88                |Sy_bit(16)
89                |Sy_bit(17)
90                |Sy_bit(18)
91                |Sy_bit(19)
92//                |Sy_bit(20) obachman 11/00 tossed: 12/00 used for redOldStd
93                |Sy_bit(OPT_OLDSTD)
94                |Sy_bit(21)
95                |Sy_bit(22)
96                /*|Sy_bit(23)*/
97                /*|Sy_bit(24)*/
98                |Sy_bit(OPT_REDTAIL)
99                |Sy_bit(OPT_INTSTRATEGY)
100                |Sy_bit(27)
101                |Sy_bit(28)
102                |Sy_bit(29)
103                |Sy_bit(30)
104                |Sy_bit(31);
105
106//static BOOLEAN posInLOldFlag;
107           /*FALSE, if posInL == posInL10*/
108// returns TRUE if mora should use buckets, false otherwise
109static BOOLEAN kMoraUseBucket(kStrategy strat);
110
111static void kOptimizeLDeg(pLDegProc ldeg, kStrategy strat)
112{
113//  if (strat->ak == 0 && !rIsSyzIndexRing(currRing))
114    strat->length_pLength = TRUE;
115//  else
116//    strat->length_pLength = FALSE;
117
118  if ((ldeg == pLDeg0c /*&& !rIsSyzIndexRing(currRing)*/) ||
119      (ldeg == pLDeg0 && strat->ak == 0))
120  {
121    strat->LDegLast = TRUE;
122  }
123  else
124  {
125    strat->LDegLast = FALSE;
126  }
127}
128
129
130static int doRed (LObject* h, TObject* with,BOOLEAN intoT,kStrategy strat)
131{
132  int ret;
133#if KDEBUG > 0
134  assume(kTest_L(h));
135  assume(kTest_T(with));
136#endif
137  // Hmmm ... why do we do this -- polys from T should already be normalized
138  if (!TEST_OPT_INTSTRATEGY)
139    with->pNorm();
140#ifdef KDEBUG
141  if (TEST_OPT_DEBUG)
142  {
143    PrintS("reduce ");h->wrp();PrintS(" with ");with->wrp();PrintLn();
144  }
145#endif
146  if (intoT)
147  {
148    // need to do it exacly like this: otherwise
149    // we might get errors
150    LObject L= *h;
151    L.Copy();
152    h->GetP();
153    h->SetLength(strat->length_pLength);
154    ret = ksReducePoly(&L, with, strat->kNoetherTail(), NULL, strat);
155    if (ret)
156    {
157      if (ret < 0) return ret;
158      if (h->tailRing != strat->tailRing)
159        h->ShallowCopyDelete(strat->tailRing,
160                             pGetShallowCopyDeleteProc(h->tailRing,
161                                                       strat->tailRing));
162    }
163    enterT(*h,strat);
164    *h = L;
165  }
166  else
167    ret = ksReducePoly(h, with, strat->kNoetherTail(), NULL, strat);
168#ifdef KDEBUG
169  if (TEST_OPT_DEBUG)
170  {
171    PrintS("to ");h->wrp();PrintLn();
172  }
173#endif
174  return ret;
175}
176
177int redEcart (LObject* h,kStrategy strat)
178{
179  int i,at,ei,li,ii;
180  int j = 0;
181  int pass = 0;
182  long d,reddeg;
183
184  d = h->GetpFDeg()+ h->ecart;
185  reddeg = strat->LazyDegree+d;
186  h->SetShortExpVector();
187  loop
188  {
189    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
190    if (j < 0)
191    {
192      if (strat->honey) h->SetLength(strat->length_pLength);
193      return 1;
194    }
195
196    ei = strat->T[j].ecart;
197    ii = j;
198
199    if (ei > h->ecart && ii < strat->tl)
200    {
201      li = strat->T[j].length;
202      // the polynomial to reduce with (up to the moment) is;
203      // pi with ecart ei and length li
204      // look for one with smaller ecart
205      i = j;
206      loop
207      {
208        /*- takes the first possible with respect to ecart -*/
209        i++;
210#if 1
211        if (i > strat->tl) break;
212        if ((strat->T[i].ecart < ei || (strat->T[i].ecart == ei &&
213                                        strat->T[i].length < li))
214            &&
215            p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i], h->GetLmTailRing(), ~h->sev, strat->tailRing))
216#else
217          j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h, i);
218        if (j < 0) break;
219        i = j;
220        if (strat->T[i].ecart < ei || (strat->T[i].ecart == ei &&
221                                        strat->T[i].length < li))
222#endif
223        {
224          // the polynomial to reduce with is now
225          ii = i;
226          ei = strat->T[i].ecart;
227          if (ei <= h->ecart) break;
228          li = strat->T[i].length;
229        }
230      }
231    }
232
233    // end of search: have to reduce with pi
234    if (ei > h->ecart)
235    {
236      // It is not possible to reduce h with smaller ecart;
237      // if possible h goes to the lazy-set L,i.e
238      // if its position in L would be not the last one
239      strat->fromT = TRUE;
240      if (!TEST_OPT_REDTHROUGH && strat->Ll >= 0) /*- L is not empty -*/
241      {
242        h->SetLmCurrRing();
243        if (strat->honey && strat->posInLDependsOnLength)
244          h->SetLength(strat->length_pLength);
245        assume(h->FDeg == h->pFDeg());
246        at = strat->posInL(strat->L,strat->Ll,h,strat);
247        if (at <= strat->Ll)
248        {
249          /*- h will not become the next element to reduce -*/
250          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
251#ifdef KDEBUG
252          if (TEST_OPT_DEBUG) Print(" ecart too big; -> L%d\n",at);
253#endif
254          h->Clear();
255          strat->fromT = FALSE;
256          return -1;
257        }
258      }
259    }
260
261    // now we finally can reduce
262    doRed(h,&(strat->T[ii]),strat->fromT,strat);
263    strat->fromT=FALSE;
264
265    // are we done ???
266    if (h->IsNull())
267    {
268      if (h->lcm!=NULL) pLmFree(h->lcm);
269      h->Clear();
270      return 0;
271    }
272
273    // NO!
274    h->SetShortExpVector();
275    h->SetpFDeg();
276    if (strat->honey)
277    {
278      if (ei <= h->ecart)
279        h->ecart = d-h->GetpFDeg();
280      else
281        h->ecart = d-h->GetpFDeg()+ei-h->ecart;
282    }
283    else
284      // this has the side effect of setting h->length
285      h->ecart = h->pLDeg(strat->LDegLast) - h->GetpFDeg();
286#if 0
287    if (strat->syzComp!=0)
288    {
289      if ((strat->syzComp>0) && (h->Comp() > strat->syzComp))
290      {
291        assume(h->MinComp() > strat->syzComp);
292        if (strat->honey) h->SetLength();
293#ifdef KDEBUG
294        if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
295#endif
296        return -2;
297      }
298    }
299#endif
300    /*- try to reduce the s-polynomial -*/
301    pass++;
302    d = h->GetpFDeg()+h->ecart;
303    /*
304     *test whether the polynomial should go to the lazyset L
305     *-if the degree jumps
306     *-if the number of pre-defined reductions jumps
307     */
308    if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
309        && ((d >= reddeg) || (pass > strat->LazyPass)))
310    {
311      h->SetLmCurrRing();
312      if (strat->honey && strat->posInLDependsOnLength)
313        h->SetLength(strat->length_pLength);
314      assume(h->FDeg == h->pFDeg());
315      at = strat->posInL(strat->L,strat->Ll,h,strat);
316      if (at <= strat->Ll)
317      {
318        int dummy=strat->sl;
319        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
320        {
321          if (strat->honey && !strat->posInLDependsOnLength)
322            h->SetLength(strat->length_pLength);
323          return 1;
324        }
325        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
326#ifdef KDEBUG
327        if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
328#endif
329        h->Clear();
330        return -1;
331      }
332    }
333    else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
334    {
335      Print(".%ld",d);mflush();
336      reddeg = d+1;
337      if (h->pTotalDeg()+h->ecart >= strat->tailRing->bitmask)
338      {
339        strat->overflow=TRUE;
340        //Print("OVERFLOW in redEcart d=%ld, max=%ld",d,strat->tailRing->bitmask);
341        h->GetP();
342        at = strat->posInL(strat->L,strat->Ll,h,strat);
343        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
344        h->Clear();
345        return -1;
346      }
347    }
348  }
349}
350
351int redRiloc (LObject* h,kStrategy strat)
352{
353  int i,at,ei,li,ii;
354  int j = 0;
355  int pass = 0;
356  long d,reddeg;
357
358
359  #if ADIDEBUG_NF
360  int iii;
361  PrintLn();
362  PrintS("---------------------------- NEW REDRILOC COMPUTATION ----------------------------");
363  PrintLn();
364  PrintS("    The pair h : "); PrintLn(); PrintLn();
365  PrintS("      p1 = "); p_Write(h->p1,strat->tailRing); PrintLn();
366  PrintS("      p2 = "); p_Write(h->p2,strat->tailRing); PrintLn();
367  PrintS("      p  = "); p_Write(h->p,strat->tailRing); PrintLn();
368  PrintLn();
369  PrintS("    The actual reducer T is: ");
370  if(strat->tl<0)
371    {PrintS(" Empty.");PrintLn();}
372  else
373  for (iii=0;iii<=strat->tl;iii++)
374    {
375    PrintLn();
376    PrintS("      T[");printf("%i",iii);PrintS("] = ");p_Write(strat->T[iii].p,strat->tailRing);
377    PrintLn();
378    }
379  #endif /* ADIDEBUG_NF */
380
381  d = h->GetpFDeg()+ h->ecart;
382  reddeg = strat->LazyDegree+d;
383  h->SetShortExpVector();
384  #if ADIDEBUG_NF
385   PrintLn();
386  PrintS("  Searching for a poly in T that divides h (of ecart ");
387  printf("%i",h->ecart);PrintS(") ...");
388  PrintLn();
389  #endif
390  loop
391  {
392    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
393    #if ADIDEBUG_NF
394      if(j != -1)
395        {
396        ei = strat->T[j].ecart;
397        PrintLn();
398        PrintS("    Found one: T[");printf("%i",j);
399        PrintS("] of ecart ");printf("%i",ei);
400        PrintS(": ");p_Write(strat->T[j].p,strat->tailRing);
401        PrintLn();
402        PrintS("    Try to find another with smaller ecart:");
403        PrintLn();
404        }
405      else
406        {
407        PrintLn();
408        PrintS("    No poly in T divides h.");
409        PrintLn();
410        }
411     #endif
412    if (j < 0)
413    {
414      if (strat->honey) h->SetLength(strat->length_pLength);
415      return 1;
416    }
417
418    ei = strat->T[j].ecart;
419    ii = j;
420    #if ADIDEBUG_NF
421    iii=ii;
422    #endif
423    if (ei > h->ecart && ii < strat->tl)
424    {
425      li = strat->T[j].length;
426      // the polynomial to reduce with (up to the moment) is;
427      // pi with ecart ei and length li
428      // look for one with smaller ecart
429      i = j;
430      loop
431      {
432        /*- takes the first possible with respect to ecart -*/
433        i++;
434#if 1
435        if (i > strat->tl) break;
436        if ((strat->T[i].ecart < ei || (strat->T[i].ecart == ei &&
437                                        strat->T[i].length < li))
438            &&
439            p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i], h->GetLmTailRing(), ~h->sev, strat->tailRing))
440#else
441          j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h, i);
442        if (j < 0) break;
443        i = j;
444        if (strat->T[i].ecart < ei || (strat->T[i].ecart == ei &&
445                                        strat->T[i].length < li))
446#endif
447        {
448          // the polynomial to reduce with is now
449          ii = i;
450          ei = strat->T[i].ecart;
451          if (ei <= h->ecart) break;
452          li = strat->T[i].length;
453        }
454      }
455
456
457    #if ADIDEBUG_NF
458    if(iii == ii)
459      {
460      PrintLn();
461      PrintS("    None was found.");
462      PrintLn();
463      }
464    else
465      {
466      PrintLn();
467      PrintS("    A better one (ecart = ");printf("%i",ei);PrintS("): T[");
468      printf("%i] = ",ii);p_Write(strat->T[ii].p,strat->tailRing);
469      PrintLn();
470      }
471    #endif
472
473    }
474
475    // end of search: have to reduce with pi
476    if (ei > h->ecart)
477    {
478      // It is not possible to reduce h with smaller ecart;
479      // if possible h goes to the lazy-set L,i.e
480      // if its position in L would be not the last one
481      strat->fromT = TRUE;
482      if (!TEST_OPT_REDTHROUGH && strat->Ll >= 0) /*- L is not empty -*/
483      {
484        h->SetLmCurrRing();
485        if (strat->honey && strat->posInLDependsOnLength)
486          h->SetLength(strat->length_pLength);
487        assume(h->FDeg == h->pFDeg());
488        at = strat->posInL(strat->L,strat->Ll,h,strat);
489        if (at <= strat->Ll)
490        {
491          /*- h will not become the next element to reduce -*/
492          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
493#ifdef KDEBUG
494          if (TEST_OPT_DEBUG) Print(" ecart too big; -> L%d\n",at);
495#endif
496          h->Clear();
497          strat->fromT = FALSE;
498          return -1;
499        }
500      }
501    }
502
503    // now we finally can reduce
504    doRed(h,&(strat->T[ii]),strat->fromT,strat);
505    #if ADIDEBUG_NF
506    PrintLn();
507    PrintS("  Partial Reduced h = ");p_Write(h->p,strat->tailRing);
508    PrintLn();
509    #endif
510    strat->fromT=FALSE;
511
512    // are we done ???
513    if (h->IsNull())
514    {
515      if (h->lcm!=NULL) pLmFree(h->lcm);
516      h->Clear();
517      return 0;
518    }
519
520    // NO!
521    h->SetShortExpVector();
522    h->SetpFDeg();
523    if (strat->honey)
524    {
525      if (ei <= h->ecart)
526        h->ecart = d-h->GetpFDeg();
527      else
528        h->ecart = d-h->GetpFDeg()+ei-h->ecart;
529    }
530    else
531      // this has the side effect of setting h->length
532      h->ecart = h->pLDeg(strat->LDegLast) - h->GetpFDeg();
533
534    /*- try to reduce the s-polynomial -*/
535    pass++;
536    d = h->GetpFDeg()+h->ecart;
537    /*
538     *test whether the polynomial should go to the lazyset L
539     *-if the degree jumps
540     *-if the number of pre-defined reductions jumps
541     */
542    if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
543        && ((d >= reddeg) || (pass > strat->LazyPass)))
544    {
545      h->SetLmCurrRing();
546      if (strat->honey && strat->posInLDependsOnLength)
547        h->SetLength(strat->length_pLength);
548      assume(h->FDeg == h->pFDeg());
549      at = strat->posInL(strat->L,strat->Ll,h,strat);
550      if (at <= strat->Ll)
551      {
552        int dummy=strat->sl;
553        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
554        {
555          if (strat->honey && !strat->posInLDependsOnLength)
556            h->SetLength(strat->length_pLength);
557          return 1;
558        }
559        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
560#ifdef KDEBUG
561        if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
562#endif
563        h->Clear();
564        return -1;
565      }
566    }
567    else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
568    {
569      Print(".%ld",d);mflush();
570      reddeg = d+1;
571      if (h->pTotalDeg()+h->ecart >= strat->tailRing->bitmask)
572      {
573        strat->overflow=TRUE;
574        //Print("OVERFLOW in redEcart d=%ld, max=%ld",d,strat->tailRing->bitmask);
575        h->GetP();
576        at = strat->posInL(strat->L,strat->Ll,h,strat);
577        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
578        h->Clear();
579        return -1;
580      }
581    }
582  }
583}
584
585/*2
586*reduces h with elements from T choosing  the first possible
587* element in t with respect to the given pDivisibleBy
588*/
589int redFirst (LObject* h,kStrategy strat)
590{
591  if (h->IsNull()) return 0;
592
593  int at;
594  long reddeg,d;
595  int pass = 0;
596  int j = 0;
597
598  if (! strat->homog)
599  {
600    d = h->GetpFDeg() + h->ecart;
601    reddeg = strat->LazyDegree+d;
602  }
603  h->SetShortExpVector();
604  loop
605  {
606    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
607    if (j < 0)
608    {
609      h->SetDegStuffReturnLDeg(strat->LDegLast);
610      return 1;
611    }
612
613    if (!TEST_OPT_INTSTRATEGY)
614      strat->T[j].pNorm();
615#ifdef KDEBUG
616    if (TEST_OPT_DEBUG)
617    {
618      PrintS("reduce ");
619      h->wrp();
620      PrintS(" with ");
621      strat->T[j].wrp();
622    }
623#endif
624    ksReducePoly(h, &(strat->T[j]), strat->kNoetherTail(), NULL, strat);
625#ifdef KDEBUG
626    if (TEST_OPT_DEBUG)
627    {
628      PrintS(" to ");
629      wrp(h->p);
630      PrintLn();
631    }
632#endif
633    if (h->IsNull())
634    {
635      if (h->lcm!=NULL) pLmFree(h->lcm);
636      h->Clear();
637      return 0;
638    }
639    h->SetShortExpVector();
640
641#if 0
642    if ((strat->syzComp!=0) && !strat->honey)
643    {
644      if ((strat->syzComp>0) &&
645          (h->Comp() > strat->syzComp))
646      {
647        assume(h->MinComp() > strat->syzComp);
648#ifdef KDEBUG
649        if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
650#endif
651        if (strat->homog)
652          h->SetDegStuffReturnLDeg(strat->LDegLast);
653        return -2;
654      }
655    }
656#endif
657    if (!strat->homog)
658    {
659      if (!TEST_OPT_OLDSTD && strat->honey)
660      {
661        h->SetpFDeg();
662        if (strat->T[j].ecart <= h->ecart)
663          h->ecart = d - h->GetpFDeg();
664        else
665          h->ecart = d - h->GetpFDeg() + strat->T[j].ecart - h->ecart;
666
667        d = h->GetpFDeg() + h->ecart;
668      }
669      else
670        d = h->SetDegStuffReturnLDeg(strat->LDegLast);
671      /*- try to reduce the s-polynomial -*/
672      pass++;
673      /*
674       *test whether the polynomial should go to the lazyset L
675       *-if the degree jumps
676       *-if the number of pre-defined reductions jumps
677       */
678      if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
679          && ((d >= reddeg) || (pass > strat->LazyPass)))
680      {
681        h->SetLmCurrRing();
682        if (strat->posInLDependsOnLength)
683          h->SetLength(strat->length_pLength);
684        at = strat->posInL(strat->L,strat->Ll,h,strat);
685        if (at <= strat->Ll)
686        {
687          int dummy=strat->sl;
688          if (kFindDivisibleByInS(strat,&dummy, h) < 0)
689            return 1;
690          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
691#ifdef KDEBUG
692          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
693#endif
694          h->Clear();
695          return -1;
696        }
697      }
698      if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
699      {
700        reddeg = d+1;
701        Print(".%ld",d);mflush();
702        if (h->pTotalDeg()+h->ecart >= strat->tailRing->bitmask)
703        {
704          strat->overflow=TRUE;
705          //Print("OVERFLOW in redFirst d=%ld, max=%ld",d,strat->tailRing->bitmask);
706          h->GetP();
707          at = strat->posInL(strat->L,strat->Ll,h,strat);
708          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
709          h->Clear();
710          return -1;
711        }
712      }
713    }
714  }
715}
716
717/*2
718* reduces h with elements from T choosing first possible
719* element in T with respect to the given ecart
720* used for computing normal forms outside kStd
721*/
722static poly redMoraNF (poly h,kStrategy strat, int flag)
723{
724  LObject H;
725  H.p = h;
726  int j = 0;
727  int z = 10;
728  int o = H.SetpFDeg();
729  H.ecart = currRing->pLDeg(H.p,&H.length,currRing)-o;
730  if ((flag & 2) == 0) cancelunit(&H,TRUE);
731  H.sev = pGetShortExpVector(H.p);
732  unsigned long not_sev = ~ H.sev;
733  loop
734  {
735    if (j > strat->tl)
736    {
737      return H.p;
738    }
739    if (TEST_V_DEG_STOP)
740    {
741      if (kModDeg(H.p)>Kstd1_deg) pLmDelete(&H.p);
742      if (H.p==NULL) return NULL;
743    }
744    if (p_LmShortDivisibleBy(strat->T[j].GetLmTailRing(), strat->sevT[j], H.GetLmTailRing(), not_sev, strat->tailRing))
745    {
746      /*- remember the found T-poly -*/
747      // poly pi = strat->T[j].p;
748      int ei = strat->T[j].ecart;
749      int li = strat->T[j].length;
750      int ii = j;
751      /*
752      * the polynomial to reduce with (up to the moment) is;
753      * pi with ecart ei and length li
754      */
755      loop
756      {
757        /*- look for a better one with respect to ecart -*/
758        /*- stop, if the ecart is small enough (<=ecart(H)) -*/
759        j++;
760        if (j > strat->tl) break;
761        if (ei <= H.ecart) break;
762        if (((strat->T[j].ecart < ei)
763          || ((strat->T[j].ecart == ei)
764        && (strat->T[j].length < li)))
765        && pLmShortDivisibleBy(strat->T[j].p,strat->sevT[j], H.p, not_sev))
766        {
767          /*
768          * the polynomial to reduce with is now;
769          */
770          // pi = strat->T[j].p;
771          ei = strat->T[j].ecart;
772          li = strat->T[j].length;
773          ii = j;
774        }
775      }
776      /*
777      * end of search: have to reduce with pi
778      */
779      z++;
780      if (z>10)
781      {
782        pNormalize(H.p);
783        z=0;
784      }
785      if ((ei > H.ecart) && (!strat->kHEdgeFound))
786      {
787        /*
788        * It is not possible to reduce h with smaller ecart;
789        * we have to reduce with bad ecart: H has to enter in T
790        */
791        doRed(&H,&(strat->T[ii]),TRUE,strat);
792        if (H.p == NULL)
793          return NULL;
794      }
795      else
796      {
797        /*
798        * we reduce with good ecart, h need not to be put to T
799        */
800        doRed(&H,&(strat->T[ii]),FALSE,strat);
801        if (H.p == NULL)
802          return NULL;
803      }
804      /*- try to reduce the s-polynomial -*/
805      o = H.SetpFDeg();
806      if ((flag &2 ) == 0) cancelunit(&H,TRUE);
807      H.ecart = currRing->pLDeg(H.p,&(H.length),currRing)-o;
808      j = 0;
809      H.sev = pGetShortExpVector(H.p);
810      not_sev = ~ H.sev;
811    }
812    else
813    {
814      j++;
815    }
816  }
817}
818
819/*2
820*reorders  L with respect to posInL
821*/
822void reorderL(kStrategy strat)
823{
824  int i,j,at;
825  LObject p;
826
827  for (i=1; i<=strat->Ll; i++)
828  {
829    at = strat->posInL(strat->L,i-1,&(strat->L[i]),strat);
830    if (at != i)
831    {
832      p = strat->L[i];
833      for (j=i-1; j>=at; j--) strat->L[j+1] = strat->L[j];
834      strat->L[at] = p;
835    }
836  }
837}
838
839/*2
840*reorders  T with respect to length
841*/
842void reorderT(kStrategy strat)
843{
844  int i,j,at;
845  TObject p;
846  unsigned long sev;
847
848
849  for (i=1; i<=strat->tl; i++)
850  {
851    if (strat->T[i-1].length > strat->T[i].length)
852    {
853      p = strat->T[i];
854      sev = strat->sevT[i];
855      at = i-1;
856      loop
857      {
858        at--;
859        if (at < 0) break;
860        if (strat->T[i].length > strat->T[at].length) break;
861      }
862      for (j = i-1; j>at; j--)
863      {
864        strat->T[j+1]=strat->T[j];
865        strat->sevT[j+1]=strat->sevT[j];
866        strat->R[strat->T[j+1].i_r] = &(strat->T[j+1]);
867      }
868      strat->T[at+1]=p;
869      strat->sevT[at+1] = sev;
870      strat->R[p.i_r] = &(strat->T[at+1]);
871    }
872  }
873}
874
875/*2
876*looks whether exactly (currRing->N)-1 axis are used
877*returns last != 0 in this case
878*last is the (first) unused axis
879*/
880void missingAxis (int* last,kStrategy strat)
881{
882  int   i = 0;
883  int   k = 0;
884
885  *last = 0;
886  if (!currRing->MixedOrder)
887  {
888    loop
889    {
890      i++;
891      if (i > (currRing->N)) break;
892      if (strat->NotUsedAxis[i])
893      {
894        *last = i;
895        k++;
896      }
897      if (k>1)
898      {
899        *last = 0;
900        break;
901      }
902    }
903  }
904}
905
906/*2
907*last is the only non used axis, it looks
908*for a monomial in p being a pure power of this
909*variable and returns TRUE in this case
910*(*length) gives the length between the pure power and the leading term
911*(should be minimal)
912*/
913BOOLEAN hasPurePower (const poly p,int last, int *length,kStrategy strat)
914{
915  poly h;
916  int i;
917
918  if (pNext(p) == strat->tail)
919    return FALSE;
920  pp_Test(p, currRing, strat->tailRing);
921  if (strat->ak <= 0 || p_MinComp(p, currRing, strat->tailRing) == strat->ak)
922  {
923    i = p_IsPurePower(p, currRing);
924    if (i == last)
925    {
926      *length = 0;
927      return TRUE;
928    }
929    *length = 1;
930    h = pNext(p);
931    while (h != NULL)
932    {
933      i = p_IsPurePower(h, strat->tailRing);
934      if (i==last) return TRUE;
935      (*length)++;
936      pIter(h);
937    }
938  }
939  return FALSE;
940}
941
942BOOLEAN hasPurePower (LObject *L,int last, int *length,kStrategy strat)
943{
944  if (L->bucket != NULL)
945  {
946    poly p = L->CanonicalizeP();
947    BOOLEAN ret = hasPurePower(p, last, length, strat);
948    pNext(p) = NULL;
949    return ret;
950  }
951  else
952  {
953    return hasPurePower(L->p, last, length, strat);
954  }
955}
956
957/*2
958* looks up the position of polynomial p in L
959* in the case of looking for the pure powers
960*/
961int posInL10 (const LSet set,const int length, LObject* p,const kStrategy strat)
962{
963  int j,dp,dL;
964
965  if (length<0) return 0;
966  if (hasPurePower(p,strat->lastAxis,&dp,strat))
967  {
968    int op= p->GetpFDeg() +p->ecart;
969    for (j=length; j>=0; j--)
970    {
971      if (!hasPurePower(&(set[j]),strat->lastAxis,&dL,strat))
972        return j+1;
973      if (dp < dL)
974        return j+1;
975      if ((dp == dL)
976          && (set[j].GetpFDeg()+set[j].ecart >= op))
977        return j+1;
978    }
979  }
980  j=length;
981  loop
982  {
983    if (j<0) break;
984    if (!hasPurePower(&(set[j]),strat->lastAxis,&dL,strat)) break;
985    j--;
986  }
987  return strat->posInLOld(set,j,p,strat);
988}
989
990
991/*2
992* computes the s-polynomials L[ ].p in L
993*/
994void updateL(kStrategy strat)
995{
996  LObject p;
997  int dL;
998  int j=strat->Ll;
999  loop
1000  {
1001    if (j<0) break;
1002    if (hasPurePower(&(strat->L[j]),strat->lastAxis,&dL,strat))
1003    {
1004      p=strat->L[strat->Ll];
1005      strat->L[strat->Ll]=strat->L[j];
1006      strat->L[j]=p;
1007      break;
1008    }
1009    j--;
1010  }
1011  if (j<0)
1012  {
1013    j=strat->Ll;
1014    loop
1015    {
1016      if (j<0) break;
1017      if (pNext(strat->L[j].p) == strat->tail)
1018      {
1019#ifdef HAVE_RINGS
1020        if (rField_is_Ring(currRing))
1021          pLmDelete(strat->L[j].p);    /*deletes the short spoly and computes*/
1022        else
1023#else
1024          pLmFree(strat->L[j].p);    /*deletes the short spoly and computes*/
1025#endif
1026        strat->L[j].p = NULL;
1027        poly m1 = NULL, m2 = NULL;
1028        // check that spoly creation is ok
1029        while (strat->tailRing != currRing &&
1030               !kCheckSpolyCreation(&(strat->L[j]), strat, m1, m2))
1031        {
1032          assume(m1 == NULL && m2 == NULL);
1033          // if not, change to a ring where exponents are at least
1034          // large enough
1035          kStratChangeTailRing(strat);
1036        }
1037        /* create the real one */
1038        ksCreateSpoly(&(strat->L[j]), strat->kNoetherTail(), FALSE,
1039                      strat->tailRing, m1, m2, strat->R);
1040
1041        strat->L[j].SetLmCurrRing();
1042        if (!strat->honey)
1043          strat->initEcart(&strat->L[j]);
1044        else
1045          strat->L[j].SetLength(strat->length_pLength);
1046
1047        BOOLEAN pp = hasPurePower(&(strat->L[j]),strat->lastAxis,&dL,strat);
1048
1049        if (strat->use_buckets) strat->L[j].PrepareRed(TRUE);
1050
1051        if (pp)
1052        {
1053          p=strat->L[strat->Ll];
1054          strat->L[strat->Ll]=strat->L[j];
1055          strat->L[j]=p;
1056          break;
1057        }
1058      }
1059      j--;
1060    }
1061  }
1062}
1063
1064/*2
1065* computes the s-polynomials L[ ].p in L and
1066* cuts elements in L above noether
1067*/
1068void updateLHC(kStrategy strat)
1069{
1070
1071  int i = 0;
1072  assume(kTest_TS(strat));
1073  while (i <= strat->Ll)
1074  {
1075    if (pNext(strat->L[i].p) == strat->tail)
1076    {
1077       /*- deletes the int spoly and computes -*/
1078      if (pLmCmp(strat->L[i].p,strat->kNoether) == -1)
1079      {
1080        pLmFree(strat->L[i].p);
1081        strat->L[i].p = NULL;
1082      }
1083      else
1084      {
1085        pLmFree(strat->L[i].p);
1086        strat->L[i].p = NULL;
1087        poly m1 = NULL, m2 = NULL;
1088        // check that spoly creation is ok
1089        while (strat->tailRing != currRing &&
1090               !kCheckSpolyCreation(&(strat->L[i]), strat, m1, m2))
1091        {
1092          assume(m1 == NULL && m2 == NULL);
1093          // if not, change to a ring where exponents are at least
1094          // large enough
1095          kStratChangeTailRing(strat);
1096        }
1097        /* create the real one */
1098        ksCreateSpoly(&(strat->L[i]), strat->kNoetherTail(), FALSE,
1099                      strat->tailRing, m1, m2, strat->R);
1100        if (! strat->L[i].IsNull())
1101        {
1102          strat->L[i].SetLmCurrRing();
1103          strat->L[i].SetpFDeg();
1104          strat->L[i].ecart
1105            = strat->L[i].pLDeg(strat->LDegLast) - strat->L[i].GetpFDeg();
1106          if (strat->use_buckets) strat->L[i].PrepareRed(TRUE);
1107        }
1108      }
1109    }
1110    else
1111      deleteHC(&(strat->L[i]), strat);
1112   if (strat->L[i].IsNull())
1113      deleteInL(strat->L,&strat->Ll,i,strat);
1114    else
1115    {
1116#ifdef KDEBUG
1117      assume(kTest_L(&(strat->L[i]), strat->tailRing, TRUE, i, strat->T, strat->tl));
1118#endif
1119      i++;
1120    }
1121  }
1122  assume(kTest_TS(strat));
1123}
1124
1125/*2
1126* cuts in T above strat->kNoether and tries to cancel a unit
1127*/
1128void updateT(kStrategy strat)
1129{
1130  int i = 0;
1131  LObject p;
1132
1133  while (i <= strat->tl)
1134  {
1135    p = strat->T[i];
1136    deleteHC(&p,strat, TRUE);
1137    /*- tries to cancel a unit: -*/
1138    cancelunit(&p);
1139    if (p.p != strat->T[i].p)
1140    {
1141      strat->sevT[i] = pGetShortExpVector(p.p);
1142      p.SetpFDeg();
1143    }
1144    strat->T[i] = p;
1145    i++;
1146  }
1147}
1148
1149/*2
1150* arranges red, pos and T if strat->kHEdgeFound (first time)
1151*/
1152void firstUpdate(kStrategy strat)
1153{
1154  if (strat->update)
1155  {
1156    assume(kTest_TS(strat));
1157    strat->update = (strat->tl == -1);
1158    if (TEST_OPT_WEIGHTM)
1159    {
1160      pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
1161      if (strat->tailRing != currRing)
1162      {
1163        strat->tailRing->pFDeg = strat->pOrigFDeg_TailRing;
1164        strat->tailRing->pLDeg = strat->pOrigLDeg_TailRing;
1165      }
1166      int i;
1167      for (i=strat->Ll; i>=0; i--)
1168      {
1169        strat->L[i].SetpFDeg();
1170      }
1171      for (i=strat->tl; i>=0; i--)
1172      {
1173        strat->T[i].SetpFDeg();
1174      }
1175      if (ecartWeights)
1176      {
1177        omFreeSize((ADDRESS)ecartWeights,(rVar(currRing)+1)*sizeof(short));
1178        ecartWeights=NULL;
1179      }
1180    }
1181    if (TEST_OPT_FASTHC)
1182    {
1183      strat->posInL = strat->posInLOld;
1184      strat->lastAxis = 0;
1185    }
1186    if (TEST_OPT_FINDET)
1187      return;
1188
1189#ifndef HAVE_RINGS
1190    strat->red = redFirst;
1191    strat->use_buckets = kMoraUseBucket(strat);
1192#else
1193  if ( (!rField_is_Ring(currRing)) || (currRing->OrdSgn != -1))
1194    {
1195    strat->red = redFirst;
1196      strat->use_buckets = kMoraUseBucket(strat);
1197      }
1198#endif
1199
1200    updateT(strat);
1201
1202#ifndef HAVE_RINGS
1203    strat->posInT = posInT2;
1204    reorderT(strat);
1205#else
1206  if ( (!rField_is_Ring(currRing)) || (currRing->OrdSgn != -1))
1207    {
1208    strat->posInT = posInT2;
1209      reorderT(strat);
1210      }
1211#endif
1212  }
1213  assume(kTest_TS(strat));
1214}
1215
1216/*2
1217*-puts p to the standardbasis s at position at
1218*-reduces the tail of p if TEST_OPT_REDTAIL
1219*-tries to cancel a unit
1220*-HEckeTest
1221*  if TRUE
1222*  - decides about reduction-strategies
1223*  - computes noether
1224*  - stops computation if TEST_OPT_FINDET
1225*  - cuts the tails of the polynomials
1226*    in s,t and the elements in L above noether
1227*    and cancels units if possible
1228*  - reorders s,L
1229*/
1230void enterSMora (LObject p,int atS,kStrategy strat, int atR = -1)
1231{
1232  enterSBba(p, atS, strat, atR);
1233  #ifdef KDEBUG
1234  if (TEST_OPT_DEBUG)
1235  {
1236    Print("new s%d:",atS);
1237    p_wrp(p.p,currRing,strat->tailRing);
1238    PrintLn();
1239  }
1240  #endif
1241  if ((!strat->kHEdgeFound) || (strat->kNoether!=NULL)) HEckeTest(p.p,strat);
1242  if (strat->kHEdgeFound)
1243  {
1244    if (newHEdge(strat))
1245    {
1246      firstUpdate(strat);
1247      if (TEST_OPT_FINDET)
1248        return;
1249
1250      /*- cuts elements in L above noether and reorders L -*/
1251      updateLHC(strat);
1252      /*- reorders L with respect to posInL -*/
1253      reorderL(strat);
1254    }
1255  }
1256  else if (strat->kNoether!=NULL)
1257    strat->kHEdgeFound = TRUE;
1258  else if (TEST_OPT_FASTHC)
1259  {
1260    if (strat->posInLOldFlag)
1261    {
1262      missingAxis(&strat->lastAxis,strat);
1263      if (strat->lastAxis)
1264      {
1265        strat->posInLOld = strat->posInL;
1266        strat->posInLOldFlag = FALSE;
1267        strat->posInL = posInL10;
1268        strat->posInLDependsOnLength = TRUE;
1269        updateL(strat);
1270        reorderL(strat);
1271      }
1272    }
1273    else if (strat->lastAxis)
1274      updateL(strat);
1275  }
1276}
1277
1278/*2
1279*-puts p to the standardbasis s at position at
1280*-HEckeTest
1281*  if TRUE
1282*  - computes noether
1283*/
1284void enterSMoraNF (LObject p, int atS,kStrategy strat, int atR = -1)
1285{
1286  enterSBba(p, atS, strat, atR);
1287  if ((!strat->kHEdgeFound) || (strat->kNoether!=NULL)) HEckeTest(p.p,strat);
1288  if (strat->kHEdgeFound)
1289    newHEdge(strat);
1290  else if (strat->kNoether!=NULL)
1291    strat->kHEdgeFound = TRUE;
1292}
1293
1294void initBba(ideal /*F*/,kStrategy strat)
1295{
1296 /* setting global variables ------------------- */
1297  strat->enterS = enterSBba;
1298    strat->red = redHoney;
1299  if (strat->honey)
1300    strat->red = redHoney;
1301  else if (currRing->pLexOrder && !strat->homog)
1302    strat->red = redLazy;
1303  else
1304  {
1305    strat->LazyPass *=4;
1306    strat->red = redHomog;
1307  }
1308#ifdef HAVE_RINGS  //TODO Oliver
1309  if (rField_is_Ring(currRing))
1310  {
1311    strat->red = redRing;
1312  }
1313#endif
1314  if (currRing->pLexOrder && strat->honey)
1315    strat->initEcart = initEcartNormal;
1316  else
1317    strat->initEcart = initEcartBBA;
1318  if (strat->honey)
1319    strat->initEcartPair = initEcartPairMora;
1320  else
1321    strat->initEcartPair = initEcartPairBba;
1322//  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1323//  {
1324//    //interred  machen   Aenderung
1325//    strat->pOrigFDeg=pFDeg;
1326//    strat->pOrigLDeg=pLDeg;
1327//    //h=ggetid("ecart");
1328//    //if ((h!=NULL) /*&& (IDTYP(h)==INTVEC_CMD)*/)
1329//    //{
1330//    //  ecartWeights=iv2array(IDINTVEC(h));
1331//    //}
1332//    //else
1333//    {
1334//      ecartWeights=(short *)omAlloc(((currRing->N)+1)*sizeof(short));
1335//      /*uses automatic computation of the ecartWeights to set them*/
1336//      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
1337//    }
1338//    pRestoreDegProcs(currRing,totaldegreeWecart, maxdegreeWecart);
1339//    if (TEST_OPT_PROT)
1340//    {
1341//      for(i=1; i<=(currRing->N); i++)
1342//        Print(" %d",ecartWeights[i]);
1343//      PrintLn();
1344//      mflush();
1345//    }
1346//  }
1347}
1348
1349
1350void initSba(ideal F,kStrategy strat)
1351{
1352  int i;
1353  //idhdl h;
1354 /* setting global variables ------------------- */
1355  strat->enterS = enterSSba;
1356    strat->red2 = redHoney;
1357  if (strat->honey)
1358    strat->red2 = redHoney;
1359  else if (currRing->pLexOrder && !strat->homog)
1360    strat->red2 = redLazy;
1361  else
1362  {
1363    strat->LazyPass *=4;
1364    strat->red2 = redHomog;
1365  }
1366#if defined(HAVE_RINGS) || defined(HAVE_RINGS_LOC)  //TODO Oliver
1367  if (rField_is_Ring(currRing))
1368  {
1369    if(currRing->OrdSgn == -1)
1370      {strat->red = redRiloc;}
1371    else
1372      {strat->red2 = redRing;}
1373  }
1374#endif
1375  if (currRing->pLexOrder && strat->honey)
1376    strat->initEcart = initEcartNormal;
1377  else
1378    strat->initEcart = initEcartBBA;
1379  if (strat->honey)
1380    strat->initEcartPair = initEcartPairMora;
1381  else
1382    strat->initEcartPair = initEcartPairBba;
1383  //strat->kIdeal = NULL;
1384  //if (strat->ak==0) strat->kIdeal->rtyp=IDEAL_CMD;
1385  //else              strat->kIdeal->rtyp=MODUL_CMD;
1386  //strat->kIdeal->data=(void *)strat->Shdl;
1387  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1388  {
1389    //interred  machen   Aenderung
1390    strat->pOrigFDeg  = currRing->pFDeg;
1391    strat->pOrigLDeg  = currRing->pLDeg;
1392    //h=ggetid("ecart");
1393    //if ((h!=NULL) /*&& (IDTYP(h)==INTVEC_CMD)*/)
1394    //{
1395    //  ecartWeights=iv2array(IDINTVEC(h));
1396    //}
1397    //else
1398    {
1399      ecartWeights=(short *)omAlloc(((currRing->N)+1)*sizeof(short));
1400      /*uses automatic computation of the ecartWeights to set them*/
1401      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights, currRing);
1402    }
1403    pRestoreDegProcs(currRing, totaldegreeWecart, maxdegreeWecart);
1404    if (TEST_OPT_PROT)
1405    {
1406      for(i=1; i<=(currRing->N); i++)
1407        Print(" %d",ecartWeights[i]);
1408      PrintLn();
1409      mflush();
1410    }
1411  }
1412  // for sig-safe reductions in signature-based
1413  // standard basis computations
1414  strat->red          = redSig;
1415  //strat->sbaOrder  = 1;
1416  strat->currIdx      = 1;
1417}
1418
1419void initMora(ideal F,kStrategy strat)
1420{
1421  int i,j;
1422
1423  strat->NotUsedAxis = (BOOLEAN *)omAlloc(((currRing->N)+1)*sizeof(BOOLEAN));
1424  for (j=(currRing->N); j>0; j--) strat->NotUsedAxis[j] = TRUE;
1425  strat->enterS = enterSMora;
1426  strat->initEcartPair = initEcartPairMora; /*- ecart approximation -*/
1427  strat->posInLOld = strat->posInL;
1428  strat->posInLOldFlag = TRUE;
1429  strat->initEcart = initEcartNormal;
1430  strat->kHEdgeFound = (currRing->ppNoether) != NULL;
1431  if ( strat->kHEdgeFound )
1432     strat->kNoether = pCopy((currRing->ppNoether));
1433  else if (strat->kHEdgeFound || strat->homog)
1434    strat->red = redFirst;  /*take the first possible in T*/
1435  else
1436    strat->red = redEcart;/*take the first possible in under ecart-restriction*/
1437  if (strat->kHEdgeFound)
1438  {
1439    strat->HCord = currRing->pFDeg((currRing->ppNoether),currRing)+1;
1440    strat->posInT = posInT2;
1441  }
1442  else
1443  {
1444    strat->HCord = 32000;/*- very large -*/
1445  }
1446
1447    #ifdef HAVE_RINGS
1448    if (rField_is_Ring(currRing))
1449      strat->red = redRiloc;
1450  #endif
1451
1452  /*reads the ecartWeights used for Graebes method from the
1453   *intvec ecart and set ecartWeights
1454   */
1455  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1456  {
1457    //interred  machen   Aenderung
1458    strat->pOrigFDeg=currRing->pFDeg;
1459    strat->pOrigLDeg=currRing->pLDeg;
1460    ecartWeights=(short *)omAlloc(((currRing->N)+1)*sizeof(short));
1461    /*uses automatic computation of the ecartWeights to set them*/
1462    kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights,currRing);
1463
1464    pSetDegProcs(currRing,totaldegreeWecart, maxdegreeWecart);
1465    if (TEST_OPT_PROT)
1466    {
1467      for(i=1; i<=(currRing->N); i++)
1468        Print(" %d",ecartWeights[i]);
1469      PrintLn();
1470      mflush();
1471    }
1472  }
1473  kOptimizeLDeg(currRing->pLDeg, strat);
1474}
1475
1476#ifdef HAVE_ASSUME
1477static int mora_count = 0;
1478static int mora_loop_count;
1479#endif
1480
1481void kDebugPrint(kStrategy strat);
1482
1483ideal mora (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
1484{
1485#ifdef HAVE_RINGS
1486#if ADIDEBUG
1487int loop_count;
1488loop_count = 1;
1489#endif
1490#endif
1491#ifdef HAVE_ASSUME
1492  mora_count++;
1493  mora_loop_count = 0;
1494#endif
1495  int olddeg = 0;
1496  int reduc = 0;
1497  int red_result = 1;
1498  int hilbeledeg=1,hilbcount=0;
1499  BITSET save1;
1500  SI_SAVE_OPT1(save1);
1501  if (currRing->MixedOrder)
1502  {
1503    si_opt_1 &= ~Sy_bit(OPT_REDSB);
1504    si_opt_1 &= ~Sy_bit(OPT_REDTAIL);
1505  }
1506
1507  strat->update = TRUE;
1508  /*- setting global variables ------------------- -*/
1509  initBuchMoraCrit(strat);
1510  initHilbCrit(F,Q,&hilb,strat);
1511  initMora(F,strat);
1512  initBuchMoraPos(strat);
1513  /*Shdl=*/initBuchMora(F,Q,strat);
1514  if (TEST_OPT_FASTHC) missingAxis(&strat->lastAxis,strat);
1515  /*updateS in initBuchMora has Hecketest
1516  * and could have put strat->kHEdgdeFound FALSE*/
1517  if ((currRing->ppNoether)!=NULL)
1518  {
1519    strat->kHEdgeFound = TRUE;
1520  }
1521  if (strat->kHEdgeFound && strat->update)
1522  {
1523    firstUpdate(strat);
1524    updateLHC(strat);
1525    reorderL(strat);
1526  }
1527  if (TEST_OPT_FASTHC && (strat->lastAxis) && strat->posInLOldFlag)
1528  {
1529    strat->posInLOld = strat->posInL;
1530    strat->posInLOldFlag = FALSE;
1531    strat->posInL = posInL10;
1532    updateL(strat);
1533    reorderL(strat);
1534  }
1535  assume(kTest_TS(strat));
1536  strat->use_buckets = kMoraUseBucket(strat);
1537  /*- compute-------------------------------------------*/
1538
1539#ifdef HAVE_TAIL_RING
1540//  if (strat->homog && strat->red == redFirst)
1541  kStratInitChangeTailRing(strat);
1542#endif
1543
1544  if (BVERBOSE(23))
1545  {
1546    kDebugPrint(strat);
1547  }
1548
1549  while (strat->Ll >= 0)
1550  {
1551#ifdef HAVE_ASSUME
1552    mora_loop_count++;
1553#endif
1554    #ifdef KDEBUG
1555    if (TEST_OPT_DEBUG) messageSets(strat);
1556    #endif
1557    if (TEST_OPT_DEGBOUND
1558    && (strat->L[strat->Ll].ecart+strat->L[strat->Ll].GetpFDeg()> Kstd1_deg))
1559    {
1560      /*
1561      * stops computation if
1562      * - 24 (degBound)
1563      *   && upper degree is bigger than Kstd1_deg
1564      */
1565      while ((strat->Ll >= 0)
1566        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1567        && (strat->L[strat->Ll].ecart+strat->L[strat->Ll].GetpFDeg()> Kstd1_deg)
1568      )
1569      {
1570        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1571        //if (TEST_OPT_PROT)
1572        //{
1573        //   PrintS("D"); mflush();
1574        //}
1575      }
1576      if (strat->Ll<0) break;
1577      else strat->noClearS=TRUE;
1578    }
1579
1580        #if ADIDEBUG
1581    #ifdef KDEBUG
1582
1583    PrintLn();
1584    PrintS("-------------------------------- LOOP ");printf("%d",loop_count);
1585    PrintS(" ---------------------------------------");
1586    PrintLn();
1587    //print the list L: (p1,p2,p)
1588    PrintLn();
1589    PrintS("    The pair list L -- in loop ");
1590    printf("%d",loop_count);PrintS(" -- is: "); PrintLn();
1591    for(int iii=0;iii<=strat->Ll;iii++)
1592      {
1593      PrintLn();
1594      PrintS("    L[");printf("%d",iii);Print("]: ");
1595      PrintLn();
1596      PrintS("        ");p_Write(strat->L[iii].p1,strat->tailRing);
1597      PrintS("        ");p_Write(strat->L[iii].p2,strat->tailRing);
1598      PrintS("        ");p_Write(strat->L[iii].p,strat->tailRing);
1599      }
1600    PrintLn();
1601    #endif
1602    #endif
1603
1604
1605    strat->P = strat->L[strat->Ll];/*- picks the last element from the lazyset L -*/
1606    if (strat->Ll==0) strat->interpt=TRUE;
1607    strat->Ll--;
1608
1609    #if ADIDEBUG
1610    #ifdef KDEBUG
1611    PrintS("    My new pair P = (p1,p2,p) is: "); PrintLn();
1612    PrintS("      p1 = "); p_Write(strat->P.p1,strat->tailRing);PrintLn();
1613    PrintS("      p2 = "); p_Write(strat->P.p2,strat->tailRing);PrintLn();
1614    PrintS("      p = "); p_Write(strat->P.p,strat->tailRing); PrintLn();
1615    PrintLn();
1616    PrintS("    The old reducer list T -- at the beg of loop ");
1617    printf("%d",loop_count);PrintS(" -- is :");
1618    if(strat->tl<0)
1619      {PrintS(" Empty.");PrintLn();}
1620    else
1621    for(int iii=0;iii<=strat->tl;iii++)
1622      {
1623        PrintLn();
1624        PrintS("    T[");printf("%d",iii);PrintS("]:");
1625        p_Write(strat->T[iii].p,strat->T->tailRing);
1626      }
1627    PrintLn();
1628
1629    #endif /* ADIDEBUG */
1630    #endif
1631
1632    // create the real Spoly
1633    if (pNext(strat->P.p) == strat->tail)
1634    {
1635      /*- deletes the short spoly and computes -*/
1636#ifdef HAVE_RINGS_LOC
1637      if (rField_is_Ring(currRing))
1638        pLmDelete(strat->P.p);
1639      else
1640#endif
1641      pLmFree(strat->P.p);
1642      strat->P.p = NULL;
1643      poly m1 = NULL, m2 = NULL;
1644      // check that spoly creation is ok
1645      while (strat->tailRing != currRing &&
1646             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1647      {
1648        assume(m1 == NULL && m2 == NULL);
1649        // if not, change to a ring where exponents are large enough
1650        kStratChangeTailRing(strat);
1651      }
1652      /* create the real one */
1653      ksCreateSpoly(&(strat->P), strat->kNoetherTail(), strat->use_buckets,
1654                    strat->tailRing, m1, m2, strat->R);
1655      if (!strat->use_buckets)
1656        strat->P.SetLength(strat->length_pLength);
1657    }
1658    else if (strat->P.p1 == NULL)
1659    {
1660      // for input polys, prepare reduction (buckets !)
1661      strat->P.SetLength(strat->length_pLength);
1662      strat->P.PrepareRed(strat->use_buckets);
1663    }
1664
1665    if (!strat->P.IsNull())
1666    {
1667      // might be NULL from noether !!!
1668      if (TEST_OPT_PROT)
1669        message(strat->P.ecart+strat->P.GetpFDeg(),&olddeg,&reduc,strat, red_result);
1670      // reduce
1671      red_result = strat->red(&strat->P,strat);
1672    }
1673
1674    if (! strat->P.IsNull())
1675    {
1676      strat->P.GetP();
1677      // statistics
1678      if (TEST_OPT_PROT) PrintS("s");
1679      // normalization
1680      if (!TEST_OPT_INTSTRATEGY)
1681        strat->P.pNorm();
1682      // tailreduction
1683      strat->P.p = redtail(&(strat->P),strat->sl,strat);
1684      // set ecart -- might have changed because of tail reductions
1685      if ((!strat->noTailReduction) && (!strat->honey))
1686        strat->initEcart(&strat->P);
1687      // cancel unit
1688      cancelunit(&strat->P);
1689      // for char 0, clear denominators
1690      if (TEST_OPT_INTSTRATEGY)
1691        strat->P.pCleardenom();
1692
1693      // put in T
1694      enterT(strat->P,strat);
1695      // build new pairs
1696#ifdef HAVE_RINGS
1697      if (rField_is_Ring(currRing))
1698      {
1699        superenterpairs(strat->P.p,strat->sl,strat->P.ecart,0,strat, strat->tl);
1700
1701        #if ADIDEBUG
1702        PrintLn();
1703    PrintS("    The new pair list L -- after superenterpairs in loop ");
1704    printf("%d",loop_count);PrintS(" -- is: "); PrintLn();
1705    for(int iii=0;iii<=strat->Ll;iii++)
1706    {
1707    PrintLn();
1708    PrintS("    L[");printf("%d",iii);PrintS("]:");PrintLn();
1709    PrintS("         ");p_Write(strat->L[iii].p1,strat->tailRing);
1710    PrintS("         ");p_Write(strat->L[iii].p2,strat->tailRing);
1711    PrintS("         ");p_Write(strat->L[iii].p,strat->tailRing);
1712    }
1713    #endif
1714      }
1715      else
1716#endif
1717      enterpairs(strat->P.p,strat->sl,strat->P.ecart,0,strat, strat->tl);
1718      // put in S
1719      strat->enterS(strat->P,
1720                    posInS(strat,strat->sl,strat->P.p, strat->P.ecart),
1721                    strat, strat->tl);
1722
1723      // apply hilbert criterion
1724      if (hilb!=NULL)
1725        {
1726        if (strat->homog==isHomog)
1727          khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1728        else
1729          khCheckLocInhom(Q,w,hilb,hilbcount,strat);
1730        }
1731
1732      // clear strat->P
1733      if (strat->P.lcm!=NULL)
1734#if defined(HAVE_RINGS) || defined(HAVE_RINGS_LOC)
1735   pLmDelete(strat->P.lcm);
1736#else
1737        pLmFree(strat->P.lcm);
1738#endif
1739      strat->P.lcm=NULL;
1740#ifdef KDEBUG
1741      // make sure kTest_TS does not complain about strat->P
1742      memset(&strat->P,0,sizeof(strat->P));
1743#endif
1744    }
1745    if (strat->kHEdgeFound)
1746    {
1747      if ((TEST_OPT_FINDET)
1748      || ((TEST_OPT_MULTBOUND) && (scMult0Int((strat->Shdl)) < Kstd1_mu)))
1749      {
1750        // obachman: is this still used ???
1751        /*
1752        * stops computation if strat->kHEdgeFound and
1753        * - 27 (finiteDeterminacyTest)
1754        * or
1755        * - 23
1756        *   (multBound)
1757        *   && multiplicity of the ideal is smaller then a predefined number mu
1758        */
1759        while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1760      }
1761    }
1762    assume(kTest_TS(strat));
1763
1764      #if ADIDEBUG
1765  PrintLn();
1766  PrintS("    The new reducer list T -- at the end of loop ");
1767  printf("%d",loop_count);PrintS(" -- is "); PrintLn();
1768  for(int iii=0;iii<=strat->tl;iii++)
1769    {
1770    PrintLn();
1771    PrintS("    T[");printf("%d",iii);PrintS("]:");
1772    p_Write(strat->T[iii].p,strat->tailRing);
1773    }
1774  PrintLn();
1775
1776  loop_count++;
1777  #endif /* ADIDEBUG */
1778  }
1779  /*- complete reduction of the standard basis------------------------ -*/
1780  if (TEST_OPT_REDSB) completeReduce(strat);
1781  else if (TEST_OPT_PROT) PrintLn();
1782  /*- release temp data------------------------------- -*/
1783  exitBuchMora(strat);
1784  /*- polynomials used for HECKE: HC, noether -*/
1785  if (TEST_OPT_FINDET)
1786  {
1787    if (strat->kHEdge!=NULL)
1788      Kstd1_mu=currRing->pFDeg(strat->kHEdge,currRing);
1789    else
1790      Kstd1_mu=-1;
1791  }
1792  pDelete(&strat->kHEdge);
1793  strat->update = TRUE; //???
1794  strat->lastAxis = 0; //???
1795  pDelete(&strat->kNoether);
1796  omFreeSize((ADDRESS)strat->NotUsedAxis,((currRing->N)+1)*sizeof(BOOLEAN));
1797  if (TEST_OPT_PROT) messageStat(hilbcount,strat);
1798//  if (TEST_OPT_WEIGHTM)
1799//  {
1800//    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
1801//    if (ecartWeights)
1802//    {
1803//      omFreeSize((ADDRESS)ecartWeights,((currRing->N)+1)*sizeof(short));
1804//      ecartWeights=NULL;
1805//    }
1806//  }
1807  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1808  SI_RESTORE_OPT1(save1);
1809  idTest(strat->Shdl);
1810  return (strat->Shdl);
1811}
1812
1813poly kNF1 (ideal F,ideal Q,poly q, kStrategy strat, int lazyReduce)
1814{
1815  assume(q!=NULL);
1816  assume(!(idIs0(F)&&(Q==NULL)));
1817
1818// lazy_reduce flags: can be combined by |
1819//#define KSTD_NF_LAZY   1
1820  // do only a reduction of the leading term
1821//#define KSTD_NF_ECART  2
1822  // only local: recude even with bad ecart
1823  poly   p;
1824  int   i;
1825  int   j;
1826  int   o;
1827  LObject   h;
1828  BITSET save1;
1829  SI_SAVE_OPT1(save1);
1830
1831  //if ((idIs0(F))&&(Q==NULL))
1832  //  return pCopy(q); /*F=0*/
1833  //strat->ak = si_max(idRankFreeModule(F),pMaxComp(q));
1834  /*- creating temp data structures------------------- -*/
1835  strat->kHEdgeFound = (currRing->ppNoether) != NULL;
1836  strat->kNoether    = pCopy((currRing->ppNoether));
1837  si_opt_1|=Sy_bit(OPT_REDTAIL);
1838  si_opt_1&=~Sy_bit(OPT_INTSTRATEGY);
1839  if (TEST_OPT_STAIRCASEBOUND
1840  && (! TEST_V_DEG_STOP)
1841  && (0<Kstd1_deg)
1842  && ((!strat->kHEdgeFound)
1843    ||(TEST_OPT_DEGBOUND && (pWTotaldegree(strat->kNoether)<Kstd1_deg))))
1844  {
1845    pDelete(&strat->kNoether);
1846    strat->kNoether=pOne();
1847    pSetExp(strat->kNoether,1, Kstd1_deg+1);
1848    pSetm(strat->kNoether);
1849    strat->kHEdgeFound=TRUE;
1850  }
1851  initBuchMoraCrit(strat);
1852  initBuchMoraPos(strat);
1853  initMora(F,strat);
1854  strat->enterS = enterSMoraNF;
1855  /*- set T -*/
1856  strat->tl = -1;
1857  strat->tmax = setmaxT;
1858  strat->T = initT();
1859  strat->R = initR();
1860  strat->sevT = initsevT();
1861  /*- set S -*/
1862  strat->sl = -1;
1863  /*- init local data struct.-------------------------- -*/
1864  /*Shdl=*/initS(F,Q,strat);
1865  if ((strat->ak!=0)
1866  && (strat->kHEdgeFound))
1867  {
1868    if (strat->ak!=1)
1869    {
1870      pSetComp(strat->kNoether,1);
1871      pSetmComp(strat->kNoether);
1872      poly p=pHead(strat->kNoether);
1873      pSetComp(p,strat->ak);
1874      pSetmComp(p);
1875      p=pAdd(strat->kNoether,p);
1876      strat->kNoether=pNext(p);
1877      p_LmFree(p,currRing);
1878    }
1879  }
1880  if ((lazyReduce & KSTD_NF_LAZY)==0)
1881  {
1882    for (i=strat->sl; i>=0; i--)
1883      pNorm(strat->S[i]);
1884  }
1885  /*- puts the elements of S also to T -*/
1886  for (i=0; i<=strat->sl; i++)
1887  {
1888    h.p = strat->S[i];
1889    h.ecart = strat->ecartS[i];
1890    if (strat->sevS[i] == 0) strat->sevS[i] = pGetShortExpVector(h.p);
1891    else assume(strat->sevS[i] == pGetShortExpVector(h.p));
1892    h.length = pLength(h.p);
1893    h.sev = strat->sevS[i];
1894    h.SetpFDeg();
1895    enterT(h,strat);
1896  }
1897#ifdef KDEBUG
1898//  kDebugPrint(strat);
1899#endif
1900  /*- compute------------------------------------------- -*/
1901  p = pCopy(q);
1902  deleteHC(&p,&o,&j,strat);
1903  assume(kTest(strat));
1904  if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
1905  if (BVERBOSE(23)) kDebugPrint(strat);
1906  if (p!=NULL) p = redMoraNF(p,strat, lazyReduce & KSTD_NF_ECART);
1907  if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
1908  {
1909    if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
1910    p = redtail(p,strat->sl,strat);
1911  }
1912  /*- release temp data------------------------------- -*/
1913  cleanT(strat);
1914  assume(strat->L==NULL); /*strat->L unsed */
1915  assume(strat->B==NULL); /*strat->B unused */
1916  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
1917  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
1918  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
1919  omFreeSize((ADDRESS)strat->NotUsedAxis,((currRing->N)+1)*sizeof(BOOLEAN));
1920  omFree(strat->sevT);
1921  omFree(strat->S_2_R);
1922  omFree(strat->R);
1923
1924  if ((Q!=NULL)&&(strat->fromQ!=NULL))
1925  {
1926    i=((IDELEMS(Q)+IDELEMS(F)+15)/16)*16;
1927    omFreeSize((ADDRESS)strat->fromQ,i*sizeof(int));
1928    strat->fromQ=NULL;
1929  }
1930  pDelete(&strat->kHEdge);
1931  pDelete(&strat->kNoether);
1932//  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1933//  {
1934//    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
1935//    if (ecartWeights)
1936//    {
1937//      omFreeSize((ADDRESS *)&ecartWeights,((currRing->N)+1)*sizeof(short));
1938//      ecartWeights=NULL;
1939//    }
1940//  }
1941  idDelete(&strat->Shdl);
1942  SI_RESTORE_OPT1(save1);
1943  if (TEST_OPT_PROT) PrintLn();
1944  return p;
1945}
1946
1947ideal kNF1 (ideal F,ideal Q,ideal q, kStrategy strat, int lazyReduce)
1948{
1949  assume(!idIs0(q));
1950  assume(!(idIs0(F)&&(Q==NULL)));
1951
1952// lazy_reduce flags: can be combined by |
1953//#define KSTD_NF_LAZY   1
1954  // do only a reduction of the leading term
1955//#define KSTD_NF_ECART  2
1956  // only local: recude even with bad ecart
1957  poly   p;
1958  int   i;
1959  int   j;
1960  int   o;
1961  LObject   h;
1962  ideal res;
1963  BITSET save1;
1964  SI_SAVE_OPT1(save1);
1965
1966  //if (idIs0(q)) return idInit(IDELEMS(q),si_max(q->rank,F->rank));
1967  //if ((idIs0(F))&&(Q==NULL))
1968  //  return idCopy(q); /*F=0*/
1969  //strat->ak = si_max(idRankFreeModule(F),idRankFreeModule(q));
1970  /*- creating temp data structures------------------- -*/
1971  strat->kHEdgeFound = (currRing->ppNoether) != NULL;
1972  strat->kNoether=pCopy((currRing->ppNoether));
1973  si_opt_1|=Sy_bit(OPT_REDTAIL);
1974  if (TEST_OPT_STAIRCASEBOUND
1975  && (0<Kstd1_deg)
1976  && ((!strat->kHEdgeFound)
1977    ||(TEST_OPT_DEGBOUND && (pWTotaldegree(strat->kNoether)<Kstd1_deg))))
1978  {
1979    pDelete(&strat->kNoether);
1980    strat->kNoether=pOne();
1981    pSetExp(strat->kNoether,1, Kstd1_deg+1);
1982    pSetm(strat->kNoether);
1983    strat->kHEdgeFound=TRUE;
1984  }
1985  initBuchMoraCrit(strat);
1986  initBuchMoraPos(strat);
1987  initMora(F,strat);
1988  strat->enterS = enterSMoraNF;
1989  /*- set T -*/
1990  strat->tl = -1;
1991  strat->tmax = setmaxT;
1992  strat->T = initT();
1993  strat->R = initR();
1994  strat->sevT = initsevT();
1995  /*- set S -*/
1996  strat->sl = -1;
1997  /*- init local data struct.-------------------------- -*/
1998  /*Shdl=*/initS(F,Q,strat);
1999  if ((strat->ak!=0)
2000  && (strat->kHEdgeFound))
2001  {
2002    if (strat->ak!=1)
2003    {
2004      pSetComp(strat->kNoether,1);
2005      pSetmComp(strat->kNoether);
2006      poly p=pHead(strat->kNoether);
2007      pSetComp(p,strat->ak);
2008      pSetmComp(p);
2009      p=pAdd(strat->kNoether,p);
2010      strat->kNoether=pNext(p);
2011      p_LmFree(p,currRing);
2012    }
2013  }
2014  if (TEST_OPT_INTSTRATEGY && ((lazyReduce & KSTD_NF_LAZY)==0))
2015  {
2016    for (i=strat->sl; i>=0; i--)
2017      pNorm(strat->S[i]);
2018  }
2019  /*- compute------------------------------------------- -*/
2020  res=idInit(IDELEMS(q),strat->ak);
2021  for (i=0; i<IDELEMS(q); i++)
2022  {
2023    if (q->m[i]!=NULL)
2024    {
2025      p = pCopy(q->m[i]);
2026      deleteHC(&p,&o,&j,strat);
2027      if (p!=NULL)
2028      {
2029        /*- puts the elements of S also to T -*/
2030        for (j=0; j<=strat->sl; j++)
2031        {
2032          h.p = strat->S[j];
2033          h.ecart = strat->ecartS[j];
2034          h.pLength = h.length = pLength(h.p);
2035          if (strat->sevS[j] == 0) strat->sevS[j] = pGetShortExpVector(h.p);
2036          else assume(strat->sevS[j] == pGetShortExpVector(h.p));
2037          h.sev = strat->sevS[j];
2038          h.SetpFDeg();
2039          enterT(h,strat);
2040        }
2041        if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
2042        p = redMoraNF(p,strat, lazyReduce & KSTD_NF_ECART);
2043        if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
2044        {
2045          if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
2046          p = redtail(p,strat->sl,strat);
2047        }
2048        cleanT(strat);
2049      }
2050      res->m[i]=p;
2051    }
2052    //else
2053    //  res->m[i]=NULL;
2054  }
2055  /*- release temp data------------------------------- -*/
2056  assume(strat->L==NULL); /*strat->L unsed */
2057  assume(strat->B==NULL); /*strat->B unused */
2058  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
2059  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
2060  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
2061  omFreeSize((ADDRESS)strat->NotUsedAxis,((currRing->N)+1)*sizeof(BOOLEAN));
2062  omFree(strat->sevT);
2063  omFree(strat->S_2_R);
2064  omFree(strat->R);
2065  if ((Q!=NULL)&&(strat->fromQ!=NULL))
2066  {
2067    i=((IDELEMS(Q)+IDELEMS(F)+15)/16)*16;
2068    omFreeSize((ADDRESS)strat->fromQ,i*sizeof(int));
2069    strat->fromQ=NULL;
2070  }
2071  pDelete(&strat->kHEdge);
2072  pDelete(&strat->kNoether);
2073//  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
2074//  {
2075//    pFDeg=strat->pOrigFDeg;
2076//    pLDeg=strat->pOrigLDeg;
2077//    if (ecartWeights)
2078//    {
2079//      omFreeSize((ADDRESS *)&ecartWeights,((currRing->N)+1)*sizeof(short));
2080//      ecartWeights=NULL;
2081//    }
2082//  }
2083  idDelete(&strat->Shdl);
2084  SI_RESTORE_OPT1(save1);
2085  if (TEST_OPT_PROT) PrintLn();
2086  return res;
2087}
2088
2089intvec * kModW, * kHomW;
2090
2091long kModDeg(poly p, ring r)
2092{
2093  long o=p_WDegree(p, r);
2094  long i=p_GetComp(p, r);
2095  if (i==0) return o;
2096  //assume((i>0) && (i<=kModW->length()));
2097  if (i<=kModW->length())
2098    return o+(*kModW)[i-1];
2099  return o;
2100}
2101long kHomModDeg(poly p, ring r)
2102{
2103  int i;
2104  long j=0;
2105
2106  for (i=r->N;i>0;i--)
2107    j+=p_GetExp(p,i,r)*(*kHomW)[i-1];
2108  if (kModW == NULL) return j;
2109  i = p_GetComp(p,r);
2110  if (i==0) return j;
2111  return j+(*kModW)[i-1];
2112}
2113
2114ideal kStd(ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
2115          int newIdeal, intvec *vw)
2116{
2117  if(idIs0(F))
2118    return idInit(1,F->rank);
2119
2120  ideal r;
2121  BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2122  BOOLEAN delete_w=(w==NULL);
2123  kStrategy strat=new skStrategy;
2124
2125  if(!TEST_OPT_RETURN_SB)
2126    strat->syzComp = syzComp;
2127  if (TEST_OPT_SB_1)
2128    #ifdef HAVE_RINGS
2129    if(!rField_is_Ring(currRing))
2130    #endif
2131    strat->newIdeal = newIdeal;
2132  if (rField_has_simple_inverse(currRing))
2133    strat->LazyPass=20;
2134  else
2135    strat->LazyPass=2;
2136  strat->LazyDegree = 1;
2137  strat->enterOnePair=enterOnePairNormal;
2138  strat->chainCrit=chainCritNormal;
2139  strat->ak = id_RankFreeModule(F,currRing);
2140  strat->kModW=kModW=NULL;
2141  strat->kHomW=kHomW=NULL;
2142  if (vw != NULL)
2143  {
2144    currRing->pLexOrder=FALSE;
2145    strat->kHomW=kHomW=vw;
2146    strat->pOrigFDeg = currRing->pFDeg;
2147    strat->pOrigLDeg = currRing->pLDeg;
2148    pSetDegProcs(currRing,kHomModDeg);
2149    toReset = TRUE;
2150  }
2151  if (h==testHomog)
2152  {
2153    if (strat->ak == 0)
2154    {
2155      h = (tHomog)idHomIdeal(F,Q);
2156      w=NULL;
2157    }
2158    else if (!TEST_OPT_DEGBOUND)
2159    {
2160      h = (tHomog)idHomModule(F,Q,w);
2161    }
2162  }
2163  currRing->pLexOrder=b;
2164  if (h==isHomog)
2165  {
2166    if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2167    {
2168      strat->kModW = kModW = *w;
2169      if (vw == NULL)
2170      {
2171        strat->pOrigFDeg = currRing->pFDeg;
2172        strat->pOrigLDeg = currRing->pLDeg;
2173        pSetDegProcs(currRing,kModDeg);
2174        toReset = TRUE;
2175      }
2176    }
2177    currRing->pLexOrder = TRUE;
2178    if (hilb==NULL) strat->LazyPass*=2;
2179  }
2180  strat->homog=h;
2181#ifdef KDEBUG
2182  idTest(F);
2183  idTest(Q);
2184
2185#if MYTEST
2186  if (TEST_OPT_DEBUG)
2187  {
2188    PrintS("// kSTD: currRing: ");
2189    rWrite(currRing);
2190  }
2191#endif
2192
2193#endif
2194#ifdef HAVE_PLURAL
2195  if (rIsPluralRing(currRing))
2196  {
2197    const BOOLEAN bIsSCA  = rIsSCA(currRing) && strat->z2homog; // for Z_2 prod-crit
2198    strat->no_prod_crit   = ! bIsSCA;
2199    if (w!=NULL)
2200      r = nc_GB(F, Q, *w, hilb, strat, currRing);
2201    else
2202      r = nc_GB(F, Q, NULL, hilb, strat, currRing);
2203  }
2204  else
2205#endif
2206#ifdef HAVE_RINGS
2207  if (rField_is_Ring(currRing))
2208    {
2209    if(currRing->OrdSgn == -1)
2210      r=mora(F,Q,NULL,hilb,strat);
2211    else
2212      r=bba(F,Q,NULL,hilb,strat);
2213    }
2214  else
2215#endif
2216  {
2217    if (currRing->OrdSgn==-1)
2218    {
2219      if (w!=NULL)
2220        r=mora(F,Q,*w,hilb,strat);
2221      else
2222        r=mora(F,Q,NULL,hilb,strat);
2223    }
2224    else
2225    {
2226      if (w!=NULL)
2227        r=bba(F,Q,*w,hilb,strat);
2228      else
2229        r=bba(F,Q,NULL,hilb,strat);
2230    }
2231  }
2232#ifdef KDEBUG
2233  idTest(r);
2234#endif
2235  if (toReset)
2236  {
2237    kModW = NULL;
2238    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2239  }
2240  currRing->pLexOrder = b;
2241//Print("%d reductions canceled \n",strat->cel);
2242  HCord=strat->HCord;
2243  delete(strat);
2244  if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
2245  return r;
2246}
2247
2248ideal kSba(ideal F, ideal Q, tHomog h,intvec ** w, int sbaOrder, int arri, intvec *hilb,int syzComp,
2249          int newIdeal, intvec *vw)
2250{
2251  if(idIs0(F))
2252    return idInit(1,F->rank);
2253
2254  ideal r;
2255  BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2256  BOOLEAN delete_w=(w==NULL);
2257  kStrategy strat=new skStrategy;
2258  strat->sbaOrder = sbaOrder;
2259  if (arri!=0)
2260  {
2261    strat->rewCrit1 = arriRewDummy;
2262    strat->rewCrit2 = arriRewCriterion;
2263    strat->rewCrit3 = arriRewCriterionPre;
2264  }
2265  else
2266  {
2267    strat->rewCrit1 = faugereRewCriterion;
2268    strat->rewCrit2 = faugereRewCriterion;
2269    strat->rewCrit3 = faugereRewCriterion;
2270  }
2271
2272  if(!TEST_OPT_RETURN_SB)
2273    strat->syzComp = syzComp;
2274  if (TEST_OPT_SB_1)
2275    #ifdef HAVE_RINGS
2276    if(!rField_is_Ring(currRing))
2277    #endif
2278    strat->newIdeal = newIdeal;
2279  if (rField_has_simple_inverse(currRing))
2280    strat->LazyPass=20;
2281  else
2282    strat->LazyPass=2;
2283  strat->LazyDegree = 1;
2284  strat->enterOnePair=enterOnePairNormal;
2285  strat->chainCrit=chainCritNormal;
2286  strat->ak = id_RankFreeModule(F,currRing);
2287  strat->kModW=kModW=NULL;
2288  strat->kHomW=kHomW=NULL;
2289  if (vw != NULL)
2290  {
2291    currRing->pLexOrder=FALSE;
2292    strat->kHomW=kHomW=vw;
2293    strat->pOrigFDeg = currRing->pFDeg;
2294    strat->pOrigLDeg = currRing->pLDeg;
2295    pSetDegProcs(currRing,kHomModDeg);
2296    toReset = TRUE;
2297  }
2298  if (h==testHomog)
2299  {
2300    if (strat->ak == 0)
2301    {
2302      h = (tHomog)idHomIdeal(F,Q);
2303      w=NULL;
2304    }
2305    else if (!TEST_OPT_DEGBOUND)
2306    {
2307      h = (tHomog)idHomModule(F,Q,w);
2308    }
2309  }
2310  currRing->pLexOrder=b;
2311  if (h==isHomog)
2312  {
2313    if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2314    {
2315      strat->kModW = kModW = *w;
2316      if (vw == NULL)
2317      {
2318        strat->pOrigFDeg = currRing->pFDeg;
2319        strat->pOrigLDeg = currRing->pLDeg;
2320        pSetDegProcs(currRing,kModDeg);
2321        toReset = TRUE;
2322      }
2323    }
2324    currRing->pLexOrder = TRUE;
2325    if (hilb==NULL) strat->LazyPass*=2;
2326  }
2327  strat->homog=h;
2328#ifdef KDEBUG
2329  idTest(F);
2330  idTest(Q);
2331
2332#if MYTEST
2333  if (TEST_OPT_DEBUG)
2334  {
2335    PrintS("// kSTD: currRing: ");
2336    rWrite(currRing);
2337  }
2338#endif
2339
2340#endif
2341#ifdef HAVE_PLURAL
2342  if (rIsPluralRing(currRing))
2343  {
2344    const BOOLEAN bIsSCA  = rIsSCA(currRing) && strat->z2homog; // for Z_2 prod-crit
2345    strat->no_prod_crit   = ! bIsSCA;
2346    if (w!=NULL)
2347      r = nc_GB(F, Q, *w, hilb, strat, currRing);
2348    else
2349      r = nc_GB(F, Q, NULL, hilb, strat, currRing);
2350  }
2351  else
2352#endif
2353#ifdef HAVE_RINGS
2354  if (rField_is_Ring(currRing))
2355    r=bba(F,Q,NULL,hilb,strat);
2356  else
2357#endif
2358  {
2359    if (currRing->OrdSgn==-1)
2360    {
2361      if (w!=NULL)
2362        r=mora(F,Q,*w,hilb,strat);
2363      else
2364        r=mora(F,Q,NULL,hilb,strat);
2365    }
2366    else
2367    {
2368      if (w!=NULL)
2369        r=sba(F,Q,*w,hilb,strat);
2370      else
2371        r=sba(F,Q,NULL,hilb,strat);
2372    }
2373  }
2374#ifdef KDEBUG
2375  idTest(r);
2376#endif
2377  if (toReset)
2378  {
2379    kModW = NULL;
2380    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2381  }
2382  currRing->pLexOrder = b;
2383//Print("%d reductions canceled \n",strat->cel);
2384  HCord=strat->HCord;
2385  delete(strat);
2386  if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
2387  return r;
2388}
2389
2390#ifdef HAVE_SHIFTBBA
2391ideal kStdShift(ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
2392                int newIdeal, intvec *vw, int uptodeg, int lV)
2393{
2394  ideal r;
2395  BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2396  BOOLEAN delete_w=(w==NULL);
2397  kStrategy strat=new skStrategy;
2398
2399  if(!TEST_OPT_RETURN_SB)
2400    strat->syzComp = syzComp;
2401  if (TEST_OPT_SB_1)
2402    #ifdef HAVE_RINGS
2403    if(!rField_is_Ring(currRing))
2404    #endif
2405    strat->newIdeal = newIdeal;
2406  if (rField_has_simple_inverse(currRing))
2407    strat->LazyPass=20;
2408  else
2409    strat->LazyPass=2;
2410  strat->LazyDegree = 1;
2411  strat->ak = id_RankFreeModule(F,currRing);
2412  strat->kModW=kModW=NULL;
2413  strat->kHomW=kHomW=NULL;
2414  if (vw != NULL)
2415  {
2416    currRing->pLexOrder=FALSE;
2417    strat->kHomW=kHomW=vw;
2418    strat->pOrigFDeg = currRing->pFDeg;
2419    strat->pOrigLDeg = currRing->pLDeg;
2420    pSetDegProcs(currRing,kHomModDeg);
2421    toReset = TRUE;
2422  }
2423  if (h==testHomog)
2424  {
2425    if (strat->ak == 0)
2426    {
2427      h = (tHomog)idHomIdeal(F,Q);
2428      w=NULL;
2429    }
2430    else if (!TEST_OPT_DEGBOUND)
2431    {
2432      h = (tHomog)idHomModule(F,Q,w);
2433    }
2434  }
2435  currRing->pLexOrder=b;
2436  if (h==isHomog)
2437  {
2438    if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2439    {
2440      strat->kModW = kModW = *w;
2441      if (vw == NULL)
2442      {
2443        strat->pOrigFDeg = currRing->pFDeg;
2444        strat->pOrigLDeg = currRing->pLDeg;
2445        pSetDegProcs(currRing,kModDeg);
2446        toReset = TRUE;
2447      }
2448    }
2449    currRing->pLexOrder = TRUE;
2450    if (hilb==NULL) strat->LazyPass*=2;
2451  }
2452  strat->homog=h;
2453#ifdef KDEBUG
2454  idTest(F);
2455#endif
2456  if (currRing->OrdSgn==-1)
2457  {
2458    /* error: no local ord yet with shifts */
2459    Print("No local ordering possible for shifts");
2460    return(NULL);
2461  }
2462  else
2463  {
2464    /* global ordering */
2465    if (w!=NULL)
2466      r=bbaShift(F,Q,*w,hilb,strat,uptodeg,lV);
2467    else
2468      r=bbaShift(F,Q,NULL,hilb,strat,uptodeg,lV);
2469  }
2470#ifdef KDEBUG
2471  idTest(r);
2472#endif
2473  if (toReset)
2474  {
2475    kModW = NULL;
2476    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2477  }
2478  currRing->pLexOrder = b;
2479//Print("%d reductions canceled \n",strat->cel);
2480  HCord=strat->HCord;
2481  delete(strat);
2482  if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
2483  return r;
2484}
2485#endif
2486
2487//##############################################################
2488//##############################################################
2489//##############################################################
2490//##############################################################
2491//##############################################################
2492
2493ideal kMin_std(ideal F, ideal Q, tHomog h,intvec ** w, ideal &M, intvec *hilb,
2494              int syzComp, int reduced)
2495{
2496  if(idIs0(F))
2497  {
2498    M=idInit(1,F->rank);
2499    return idInit(1,F->rank);
2500  }
2501
2502  ideal r=NULL;
2503  int Kstd1_OldDeg = Kstd1_deg,i;
2504  intvec* temp_w=NULL;
2505  BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2506  BOOLEAN delete_w=(w==NULL);
2507  BOOLEAN oldDegBound=TEST_OPT_DEGBOUND;
2508  kStrategy strat=new skStrategy;
2509
2510  if(!TEST_OPT_RETURN_SB)
2511     strat->syzComp = syzComp;
2512  if (rField_has_simple_inverse(currRing))
2513    strat->LazyPass=20;
2514  else
2515    strat->LazyPass=2;
2516  strat->LazyDegree = 1;
2517  strat->minim=(reduced % 2)+1;
2518  strat->ak = id_RankFreeModule(F,currRing);
2519  if (delete_w)
2520  {
2521    temp_w=new intvec((strat->ak)+1);
2522    w = &temp_w;
2523  }
2524  if (h==testHomog)
2525  {
2526    if (strat->ak == 0)
2527    {
2528      h = (tHomog)idHomIdeal(F,Q);
2529      w=NULL;
2530    }
2531    else
2532    {
2533      h = (tHomog)idHomModule(F,Q,w);
2534    }
2535  }
2536  if (h==isHomog)
2537  {
2538    if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2539    {
2540      kModW = *w;
2541      strat->kModW = *w;
2542      assume(currRing->pFDeg != NULL && currRing->pLDeg != NULL);
2543      strat->pOrigFDeg = currRing->pFDeg;
2544      strat->pOrigLDeg = currRing->pLDeg;
2545      pSetDegProcs(currRing,kModDeg);
2546
2547      toReset = TRUE;
2548      if (reduced>1)
2549      {
2550        Kstd1_OldDeg=Kstd1_deg;
2551        Kstd1_deg = -1;
2552        for (i=IDELEMS(F)-1;i>=0;i--)
2553        {
2554          if ((F->m[i]!=NULL) && (currRing->pFDeg(F->m[i],currRing)>=Kstd1_deg))
2555            Kstd1_deg = currRing->pFDeg(F->m[i],currRing)+1;
2556        }
2557      }
2558    }
2559    currRing->pLexOrder = TRUE;
2560    strat->LazyPass*=2;
2561  }
2562  strat->homog=h;
2563  if (currRing->OrdSgn==-1)
2564  {
2565    if (w!=NULL)
2566      r=mora(F,Q,*w,hilb,strat);
2567    else
2568      r=mora(F,Q,NULL,hilb,strat);
2569  }
2570  else
2571  {
2572    if (w!=NULL)
2573      r=bba(F,Q,*w,hilb,strat);
2574    else
2575      r=bba(F,Q,NULL,hilb,strat);
2576  }
2577#ifdef KDEBUG
2578  {
2579    int i;
2580    for (i=IDELEMS(r)-1; i>=0; i--) pTest(r->m[i]);
2581  }
2582#endif
2583  idSkipZeroes(r);
2584  if (toReset)
2585  {
2586    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2587    kModW = NULL;
2588  }
2589  currRing->pLexOrder = b;
2590  HCord=strat->HCord;
2591  if ((delete_w)&&(temp_w!=NULL)) delete temp_w;
2592  if ((IDELEMS(r)==1) && (r->m[0]!=NULL) && pIsConstant(r->m[0]) && (strat->ak==0))
2593  {
2594    M=idInit(1,F->rank);
2595    M->m[0]=pOne();
2596    //if (strat->ak!=0) { pSetComp(M->m[0],strat->ak); pSetmComp(M->m[0]); }
2597    if (strat->M!=NULL) idDelete(&strat->M);
2598  }
2599  else if (strat->M==NULL)
2600  {
2601    M=idInit(1,F->rank);
2602    Warn("no minimal generating set computed");
2603  }
2604  else
2605  {
2606    idSkipZeroes(strat->M);
2607    M=strat->M;
2608  }
2609  delete(strat);
2610  if (reduced>2)
2611  {
2612    Kstd1_deg=Kstd1_OldDeg;
2613    if (!oldDegBound)
2614      si_opt_1 &= ~Sy_bit(OPT_DEGBOUND);
2615  }
2616  else
2617  {
2618    if (IDELEMS(M)>IDELEMS(r)) { idDelete(&M); M=idCopy(r); }
2619  }
2620  return r;
2621}
2622
2623poly kNF(ideal F, ideal Q, poly p,int syzComp, int lazyReduce)
2624{
2625  if (p==NULL)
2626     return NULL;
2627
2628  poly pp = p;
2629
2630#ifdef HAVE_PLURAL
2631  if(rIsSCA(currRing))
2632  {
2633    const unsigned int m_iFirstAltVar = scaFirstAltVar(currRing);
2634    const unsigned int m_iLastAltVar  = scaLastAltVar(currRing);
2635    pp = p_KillSquares(pp, m_iFirstAltVar, m_iLastAltVar, currRing);
2636
2637    if(Q == currQuotient)
2638      Q = SCAQuotient(currRing);
2639  }
2640#endif
2641
2642  if ((idIs0(F))&&(Q==NULL))
2643  {
2644#ifdef HAVE_PLURAL
2645    if(p != pp)
2646      return pp;
2647#endif
2648    return pCopy(p); /*F+Q=0*/
2649  }
2650
2651  kStrategy strat=new skStrategy;
2652  strat->syzComp = syzComp;
2653  strat->ak = si_max(id_RankFreeModule(F,currRing),pMaxComp(p));
2654  poly res;
2655
2656  if (currRing->OrdSgn==-1)
2657    res=kNF1(F,Q,pp,strat,lazyReduce);
2658  else
2659    res=kNF2(F,Q,pp,strat,lazyReduce);
2660  delete(strat);
2661
2662#ifdef HAVE_PLURAL
2663  if(pp != p)
2664    p_Delete(&pp, currRing);
2665#endif
2666  return res;
2667}
2668
2669ideal kNF(ideal F, ideal Q, ideal p,int syzComp,int lazyReduce)
2670{
2671  ideal res;
2672  if (TEST_OPT_PROT)
2673  {
2674    Print("(S:%d)",IDELEMS(p));mflush();
2675  }
2676  if (idIs0(p))
2677    return idInit(IDELEMS(p),si_max(p->rank,F->rank));
2678
2679  ideal pp = p;
2680#ifdef HAVE_PLURAL
2681  if(rIsSCA(currRing))
2682  {
2683    const unsigned int m_iFirstAltVar = scaFirstAltVar(currRing);
2684    const unsigned int m_iLastAltVar  = scaLastAltVar(currRing);
2685    pp = id_KillSquares(pp, m_iFirstAltVar, m_iLastAltVar, currRing, false);
2686
2687    if(Q == currQuotient)
2688      Q = SCAQuotient(currRing);
2689  }
2690#endif
2691
2692  if ((idIs0(F))&&(Q==NULL))
2693  {
2694#ifdef HAVE_PLURAL
2695    if(p != pp)
2696      return pp;
2697#endif
2698    return idCopy(p); /*F+Q=0*/
2699  }
2700
2701  kStrategy strat=new skStrategy;
2702  strat->syzComp = syzComp;
2703  strat->ak = si_max(id_RankFreeModule(F,currRing),id_RankFreeModule(p,currRing));
2704  if (strat->ak>0) // only for module case, see Tst/Short/bug_reduce.tst
2705  {
2706    strat->ak = si_max(strat->ak,(int)F->rank);
2707  }
2708
2709  if (currRing->OrdSgn==-1)
2710    res=kNF1(F,Q,pp,strat,lazyReduce);
2711  else
2712    res=kNF2(F,Q,pp,strat,lazyReduce);
2713  delete(strat);
2714
2715#ifdef HAVE_PLURAL
2716  if(pp != p)
2717    id_Delete(&pp, currRing);
2718#endif
2719
2720  return res;
2721}
2722
2723poly kNF (ideal F, ideal Q, poly p,int syzComp, int lazyReduce, const ring _currRing)
2724{
2725  const ring save = currRing; if( currRing != _currRing ) rChangeCurrRing(_currRing);
2726  poly ret = kNF(F, Q, p, syzComp, lazyReduce);
2727  if( currRing != save )     rChangeCurrRing(save);
2728  return ret;
2729}
2730
2731/*2
2732*interreduces F
2733*/
2734// old version
2735ideal kInterRedOld (ideal F, ideal Q)
2736{
2737  int j;
2738  kStrategy strat = new skStrategy;
2739
2740  ideal tempF = F;
2741  ideal tempQ = Q;
2742
2743#ifdef HAVE_PLURAL
2744  if(rIsSCA(currRing))
2745  {
2746    const unsigned int m_iFirstAltVar = scaFirstAltVar(currRing);
2747    const unsigned int m_iLastAltVar  = scaLastAltVar(currRing);
2748    tempF = id_KillSquares(F, m_iFirstAltVar, m_iLastAltVar, currRing);
2749
2750    // this should be done on the upper level!!! :
2751    //    tempQ = SCAQuotient(currRing);
2752
2753    if(Q == currQuotient)
2754      tempQ = SCAQuotient(currRing);
2755  }
2756#endif
2757
2758//  if (TEST_OPT_PROT)
2759//  {
2760//    writeTime("start InterRed:");
2761//    mflush();
2762//  }
2763  //strat->syzComp     = 0;
2764  strat->kHEdgeFound = (currRing->ppNoether) != NULL;
2765  strat->kNoether=pCopy((currRing->ppNoether));
2766  strat->ak = id_RankFreeModule(tempF,currRing);
2767  initBuchMoraCrit(strat);
2768  strat->NotUsedAxis = (BOOLEAN *)omAlloc(((currRing->N)+1)*sizeof(BOOLEAN));
2769  for (j=(currRing->N); j>0; j--) strat->NotUsedAxis[j] = TRUE;
2770  strat->enterS      = enterSBba;
2771  strat->posInT      = posInT17;
2772  strat->initEcart   = initEcartNormal;
2773  strat->sl   = -1;
2774  strat->tl          = -1;
2775  strat->tmax        = setmaxT;
2776  strat->T           = initT();
2777  strat->R           = initR();
2778  strat->sevT        = initsevT();
2779  if (currRing->OrdSgn == -1)   strat->honey = TRUE;
2780  initS(tempF, tempQ, strat);
2781  if (TEST_OPT_REDSB)
2782    strat->noTailReduction=FALSE;
2783  updateS(TRUE,strat);
2784  if (TEST_OPT_REDSB && TEST_OPT_INTSTRATEGY)
2785    completeReduce(strat);
2786  //else if (TEST_OPT_PROT) PrintLn();
2787  pDelete(&strat->kHEdge);
2788  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
2789  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
2790  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
2791  omFreeSize((ADDRESS)strat->NotUsedAxis,((currRing->N)+1)*sizeof(BOOLEAN));
2792  omfree(strat->sevT);
2793  omfree(strat->S_2_R);
2794  omfree(strat->R);
2795
2796  if (strat->fromQ)
2797  {
2798    for (j=IDELEMS(strat->Shdl)-1;j>=0;j--)
2799    {
2800      if(strat->fromQ[j]) pDelete(&strat->Shdl->m[j]);
2801    }
2802    omFreeSize((ADDRESS)strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
2803  }
2804//  if (TEST_OPT_PROT)
2805//  {
2806//    writeTime("end Interred:");
2807//    mflush();
2808//  }
2809  ideal shdl=strat->Shdl;
2810  idSkipZeroes(shdl);
2811  if (strat->fromQ)
2812  {
2813    strat->fromQ=NULL;
2814    ideal res=kInterRed(shdl,NULL);
2815    idDelete(&shdl);
2816    shdl=res;
2817  }
2818  delete(strat);
2819#ifdef HAVE_PLURAL
2820  if( tempF != F )
2821    id_Delete( &tempF, currRing);
2822#endif
2823  return shdl;
2824}
2825// new version
2826ideal kInterRedBba (ideal F, ideal Q, int &need_retry)
2827{
2828  need_retry=0;
2829  int   red_result = 1;
2830  int   olddeg,reduc;
2831  BOOLEAN withT = FALSE;
2832  // BOOLEAN toReset=FALSE;
2833  kStrategy strat=new skStrategy;
2834  tHomog h;
2835  intvec * w=NULL;
2836
2837  if (rField_has_simple_inverse(currRing))
2838    strat->LazyPass=20;
2839  else
2840    strat->LazyPass=2;
2841  strat->LazyDegree = 1;
2842  strat->ak = id_RankFreeModule(F,currRing);
2843  strat->syzComp = strat->ak;
2844  strat->kModW=kModW=NULL;
2845  strat->kHomW=kHomW=NULL;
2846  if (strat->ak == 0)
2847  {
2848    h = (tHomog)idHomIdeal(F,Q);
2849    w=NULL;
2850  }
2851  else if (!TEST_OPT_DEGBOUND)
2852  {
2853    h = (tHomog)idHomModule(F,Q,&w);
2854  }
2855  if (h==isHomog)
2856  {
2857    if (strat->ak > 0 && (w!=NULL) && (w!=NULL))
2858    {
2859      strat->kModW = kModW = w;
2860      strat->pOrigFDeg = currRing->pFDeg;
2861      strat->pOrigLDeg = currRing->pLDeg;
2862      pSetDegProcs(currRing,kModDeg);
2863      // toReset = TRUE;
2864    }
2865    strat->LazyPass*=2;
2866  }
2867  strat->homog=h;
2868#ifdef KDEBUG
2869  idTest(F);
2870#endif
2871
2872  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
2873  initBuchMoraPos(strat);
2874  initBba(F,strat);
2875  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
2876  strat->posInL=posInL0; /* ord according pComp */
2877
2878  /*Shdl=*/initBuchMora(F, Q, strat);
2879  reduc = olddeg = 0;
2880
2881#ifndef NO_BUCKETS
2882  if (!TEST_OPT_NOT_BUCKETS)
2883    strat->use_buckets = 1;
2884#endif
2885
2886  // redtailBBa against T for inhomogenous input
2887  if (!TEST_OPT_OLDSTD)
2888    withT = ! strat->homog;
2889
2890  // strat->posInT = posInT_pLength;
2891  assume(kTest_TS(strat));
2892
2893#ifdef HAVE_TAIL_RING
2894  kStratInitChangeTailRing(strat);
2895#endif
2896
2897  /* compute------------------------------------------------------- */
2898  while (strat->Ll >= 0)
2899  {
2900    #ifdef KDEBUG
2901      if (TEST_OPT_DEBUG) messageSets(strat);
2902    #endif
2903    if (strat->Ll== 0) strat->interpt=TRUE;
2904    /* picks the last element from the lazyset L */
2905    strat->P = strat->L[strat->Ll];
2906    strat->Ll--;
2907
2908    if (strat->P.p1 == NULL)
2909    {
2910      // for input polys, prepare reduction
2911      strat->P.PrepareRed(strat->use_buckets);
2912    }
2913
2914    if (strat->P.p == NULL && strat->P.t_p == NULL)
2915    {
2916      red_result = 0;
2917    }
2918    else
2919    {
2920      if (TEST_OPT_PROT)
2921        message(strat->P.pFDeg(),
2922                &olddeg,&reduc,strat, red_result);
2923
2924      /* reduction of the element choosen from L */
2925      red_result = strat->red(&strat->P,strat);
2926    }
2927
2928    // reduction to non-zero new poly
2929    if (red_result == 1)
2930    {
2931      /* statistic */
2932      if (TEST_OPT_PROT) PrintS("s");
2933
2934      // get the polynomial (canonicalize bucket, make sure P.p is set)
2935      strat->P.GetP(strat->lmBin);
2936
2937      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
2938
2939      // reduce the tail and normalize poly
2940      // in the ring case we cannot expect LC(f) = 1,
2941      // therefore we call pContent instead of pNorm
2942      if ((TEST_OPT_INTSTRATEGY) || (rField_is_Ring(currRing)))
2943      {
2944        strat->P.pCleardenom();
2945        if (0)
2946        //if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
2947        {
2948          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
2949          strat->P.pCleardenom();
2950        }
2951      }
2952      else
2953      {
2954        strat->P.pNorm();
2955        if (0)
2956        //if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
2957          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
2958      }
2959
2960#ifdef KDEBUG
2961      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
2962#endif
2963
2964      // enter into S, L, and T
2965      if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
2966      {
2967        enterT(strat->P, strat);
2968        // posInS only depends on the leading term
2969        strat->enterS(strat->P, pos, strat, strat->tl);
2970
2971        if (pos<strat->sl)
2972        {
2973          need_retry++;
2974          // move all "larger" elements fromS to L
2975          // remove them from T
2976          int ii=pos+1;
2977          for(;ii<=strat->sl;ii++)
2978          {
2979            LObject h;
2980            memset(&h,0,sizeof(h));
2981            h.tailRing=strat->tailRing;
2982            h.p=strat->S[ii]; strat->S[ii]=NULL;
2983            strat->initEcart(&h);
2984            h.sev=strat->sevS[ii];
2985            int jj=strat->tl;
2986            while (jj>=0)
2987            {
2988              if (strat->T[jj].p==h.p)
2989              {
2990                strat->T[jj].p=NULL;
2991                if (jj<strat->tl)
2992                {
2993                  memmove(&(strat->T[jj]),&(strat->T[jj+1]),
2994                          (strat->tl-jj)*sizeof(strat->T[jj]));
2995                  memmove(&(strat->sevT[jj]),&(strat->sevT[jj+1]),
2996                          (strat->tl-jj)*sizeof(strat->sevT[jj]));
2997                }
2998                strat->tl--;
2999                break;
3000              }
3001              jj--;
3002            }
3003            int lpos=strat->posInL(strat->L,strat->Ll,&h,strat);
3004            enterL(&strat->L,&strat->Ll,&strat->Lmax,h,lpos);
3005            #ifdef KDEBUG
3006            if (TEST_OPT_DEBUG)
3007            {
3008              Print("move S[%d] -> L[%d]: ",ii,pos);
3009              p_wrp(h.p,currRing, strat->tailRing);
3010              PrintLn();
3011            }
3012            #endif
3013          }
3014          if (strat->fromQ!=NULL)
3015          {
3016            for(ii=pos+1;ii<=strat->sl;ii++) strat->fromQ[ii]=0;
3017          }
3018          strat->sl=pos;
3019        }
3020      }
3021      else
3022      {
3023        // clean P
3024      }
3025      if (strat->P.lcm!=NULL)
3026#ifdef HAVE_RINGS
3027        pLmDelete(strat->P.lcm);
3028#else
3029        pLmFree(strat->P.lcm);
3030#endif
3031    }
3032
3033#ifdef KDEBUG
3034    if (TEST_OPT_DEBUG)
3035    {
3036      messageSets(strat);
3037    }
3038    memset(&(strat->P), 0, sizeof(strat->P));
3039#endif
3040    //kTest_TS(strat);: i_r out of sync in kInterRedBba, but not used!
3041  }
3042#ifdef KDEBUG
3043  //if (TEST_OPT_DEBUG) messageSets(strat);
3044#endif
3045  /* complete reduction of the standard basis--------- */
3046
3047  if((need_retry<=0) && (TEST_OPT_REDSB))
3048  {
3049    completeReduce(strat);
3050#ifdef HAVE_TAIL_RING
3051    if (strat->completeReduce_retry)
3052    {
3053      // completeReduce needed larger exponents, retry
3054      // to reduce with S (instead of T)
3055      // and in currRing (instead of strat->tailRing)
3056      cleanT(strat);strat->tailRing=currRing;
3057      int i;
3058      for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
3059      completeReduce(strat);
3060    }
3061#endif
3062  }
3063  else if (TEST_OPT_PROT) PrintLn();
3064
3065  /* release temp data-------------------------------- */
3066  exitBuchMora(strat);
3067//  if (TEST_OPT_WEIGHTM)
3068//  {
3069//    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
3070//    if (ecartWeights)
3071//    {
3072//      omFreeSize((ADDRESS)ecartWeights,((currRing->N)+1)*sizeof(short));
3073//      ecartWeights=NULL;
3074//    }
3075//  }
3076  //if (TEST_OPT_PROT) messageStat(0/*hilbcount*/,strat);
3077  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
3078  ideal res=strat->Shdl;
3079  strat->Shdl=NULL;
3080  delete strat;
3081  if (w!=NULL) delete w;
3082  return res;
3083}
3084ideal kInterRed (ideal F, ideal Q)
3085{
3086#ifdef HAVE_PLURAL
3087  if(rIsPluralRing(currRing)) return kInterRedOld(F,Q);
3088#endif
3089  if ((currRing->OrdSgn==-1)
3090  || (rField_is_numeric(currRing)))
3091    return kInterRedOld(F,Q);
3092
3093    //return kInterRedOld(F,Q);
3094
3095  BITSET save1;
3096  SI_SAVE_OPT1(save1);
3097  //si_opt_1|=Sy_bit(OPT_NOT_SUGAR);
3098  si_opt_1|=Sy_bit(OPT_REDTHROUGH);
3099  //si_opt_1&= ~Sy_bit(OPT_REDTAIL);
3100  //si_opt_1&= ~Sy_bit(OPT_REDSB);
3101  //extern char * showOption() ;
3102  //Print("%s\n",showOption());
3103
3104  int need_retry;
3105  int counter=3;
3106  ideal res, res1;
3107  int elems;
3108  ideal null=NULL;
3109  if ((Q==NULL) || (!TEST_OPT_REDSB))
3110  {
3111    elems=idElem(F);
3112    res=kInterRedBba(F,Q,need_retry);
3113  }
3114  else
3115  {
3116    ideal FF=idSimpleAdd(F,Q);
3117    res=kInterRedBba(FF,NULL,need_retry);
3118    idDelete(&FF);
3119    null=idInit(1,1);
3120    if (need_retry)
3121      res1=kNF(null,Q,res,0,KSTD_NF_LAZY);
3122    else
3123      res1=kNF(null,Q,res);
3124    idDelete(&res);
3125    res=res1;
3126    need_retry=1;
3127  }
3128  if (idElem(res)<=1) need_retry=0;
3129  while (need_retry && (counter>0))
3130  {
3131    #ifdef KDEBUG
3132    if (TEST_OPT_DEBUG) { Print("retry counter %d\n",counter); }
3133    #endif
3134    res1=kInterRedBba(res,Q,need_retry);
3135    int new_elems=idElem(res1);
3136    counter -= (new_elems >= elems);
3137    elems = new_elems;
3138    idDelete(&res);
3139    if (idElem(res1)<=1) need_retry=0;
3140    if ((Q!=NULL) && (TEST_OPT_REDSB))
3141    {
3142      if (need_retry)
3143        res=kNF(null,Q,res1,0,KSTD_NF_LAZY);
3144      else
3145        res=kNF(null,Q,res1);
3146      idDelete(&res1);
3147    }
3148    else
3149      res = res1;
3150    if (idElem(res)<=1) need_retry=0;
3151  }
3152  if (null!=NULL) idDelete(&null);
3153  SI_RESTORE_OPT1(save1);
3154  idSkipZeroes(res);
3155  return res;
3156}
3157
3158// returns TRUE if mora should use buckets, false otherwise
3159static BOOLEAN kMoraUseBucket(kStrategy strat)
3160{
3161#ifdef MORA_USE_BUCKETS
3162  if (TEST_OPT_NOT_BUCKETS)
3163    return FALSE;
3164  if (strat->red == redFirst)
3165  {
3166#ifdef NO_LDEG
3167    if (strat->syzComp==0)
3168      return TRUE;
3169#else
3170    if ((strat->homog || strat->honey) && (strat->syzComp==0))
3171      return TRUE;
3172#endif
3173  }
3174  else
3175  {
3176    assume(strat->red == redEcart || strat->red == redRiloc);
3177    if (strat->honey && (strat->syzComp==0))
3178      return TRUE;
3179  }
3180#endif
3181  return FALSE;
3182}
Note: See TracBrowser for help on using the repository browser.