source: git/kernel/kstd1.cc @ 9d864a

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