source: git/kernel/GBEngine/kstd1.cc @ 88615db

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