source: git/kernel/kstd1.cc @ 351415

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