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

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