source: git/Singular/kstd1.cc @ 3d124a7

spielwiese
Last change on this file since 3d124a7 was 32df82, checked in by Hans Schönemann <hannes@…>, 27 years ago
* hannes: removed rcsid and Log: entries, added assignment module=poly corected type conversion int->module git-svn-id: file:///usr/local/Singular/svn/trunk@128 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 48.1 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kstd1.cc,v 1.5 1997-04-02 15:07:15 Singular Exp $ */
5/*
6* ABSTRACT:
7*/
8
9#include "mod2.h"
10#include "mmemory.h"
11#include "polys.h"
12#include "febase.h"
13#include "kutil.h"
14#include "kstd1.h"
15#include "kstd2.h"
16#include "khstd.h"
17#include "spolys.h"
18#include "stairc.h"
19#include "weight.h"
20#include "cntrlc.h"
21#include "intvec.h"
22#include "ideals.h"
23#include "ipshell.h"
24#include "ipid.h"
25#include "timer.h"
26#include "tok.h"
27#include "lists.h"
28
29//#include "ipprint.h"
30
31/* the list of all options which give a warning by test */
32BITSET kOptions=Sy_bit(0)|Sy_bit(1)|Sy_bit(3)|Sy_bit(4)|Sy_bit(5)
33                |Sy_bit(8)|Sy_bit(10)|Sy_bit(21)
34                |Sy_bit(OPT_INTSTRATEGY)
35                |Sy_bit(30)|Sy_bit(31);
36
37/* the list of all options which may be used by option and test */
38BITSET validOpts=Sy_bit(0)|Sy_bit(1)|Sy_bit(2)|Sy_bit(3)
39             |Sy_bit(4)|Sy_bit(5)|Sy_bit(6)|Sy_bit(7)
40             |Sy_bit(8)|Sy_bit(9)|Sy_bit(10)
41             |Sy_bit(11)|Sy_bit(12)|Sy_bit(13)|Sy_bit(14)|Sy_bit(15)
42             |Sy_bit(16)|Sy_bit(17)|Sy_bit(18)|Sy_bit(19)|Sy_bit(20)
43             |Sy_bit(21)
44             |Sy_bit(22)
45             /*|Sy_bit(23)*/
46             /*|Sy_bit(24)*/
47             |Sy_bit(OPT_REDTAIL)
48             |Sy_bit(OPT_INTSTRATEGY)|Sy_bit(27)|Sy_bit(28)
49             |Sy_bit(29)
50             |Sy_bit(30)|Sy_bit(31);
51
52//static int (*posInLOld)(LSet L,int Ll, LObject l,kStrategy strat);
53//static int  lastAxis=0;
54//static BOOLEAN update=TRUE;
55//static BOOLEAN posInLOldFlag;
56           /*FALSE, if posInL == posInL10*/
57
58/*0 implementation*/
59
60/*2
61*p is a polynomial in the set s;
62*recompute p and its ecart e with respect to the new noether
63*(cut every monomial of pNext(p) above noether)
64*/
65void deleteHCs (TObject* p,kStrategy strat)
66{
67  poly p1;
68  int o;
69
70  if (strat->kHEdgeFound)
71  {
72    p1 = (*p).p;
73    o = pFDeg(p1);
74    while (pNext(p1) != NULL)
75    {
76      if (pComp0(pNext(p1),strat->kNoether) == -1)
77      {
78        pDelete(&(pNext(p1)));
79        (*p).ecart = pLDeg((*p).p,&((*p).length))-o;
80      }
81      else
82      {
83        pIter(p1);
84      }
85    }
86  }
87}
88
89
90void doRed (LObject* h,poly* with,BOOLEAN intoT,kStrategy strat)
91{
92  poly hp;
93#ifdef KDEBUG
94  pTest((*h).p);
95  pTest(*with);
96#endif
97
98  if (!TEST_OPT_INTSTRATEGY)
99    pNorm(*with);
100  if (intoT)
101  {
102    hp = spSpolyRedNew(*with,(*h).p,strat->kNoether);
103    enterT(*h,strat);
104    (*h).p = hp;
105  }
106  else
107  {
108    (*h).p = spSpolyRed(*with,(*h).p,strat->kNoether);
109  }
110}
111
112/*2
113* reduces h with elements from T choosing first possible
114* element in T with respect to the given ecart
115* requires thar T is sorted by ecart
116*/
117void redEcart19 (LObject* h,kStrategy strat)
118{
119  int i,at,reddeg,d;
120  int j = 0;
121  int pass = 0;
122
123  if (TEST_OPT_CANCELUNIT) cancelunit(h);
124  d = pFDeg((*h).p)+(*h).ecart;
125  reddeg = strat->LazyDegree+d;
126  loop
127  {
128    if (j > strat->tl)
129    {
130      if (TEST_OPT_DEBUG) PrintLn();
131      return;
132    }
133    if (TEST_OPT_DEBUG) Print("%d",j);
134    if (pDivisibleBy(strat->T[j].p,(*h).p))
135    {
136      if (strat->interpt) test_int_std(strat->kIdeal);
137      if (TEST_OPT_DEBUG) PrintS("+");
138      /*- compute the s-polynomial -*/
139      if (strat->T[j].ecart > (*h).ecart)
140      {
141        /*
142        * It is not possible to reduce h with smaller ecart;
143        * if possible h goes to the lazy-set L,i.e
144        * if its position in L would be not the last one
145        */
146        strat->fromT = TRUE;
147        if (strat->Ll >= 0) /*- L is not empty -*/
148        {
149          at = strat->posInL(strat->L,strat->Ll,(*h),strat);
150          if (at <= strat->Ll)
151          {
152            /*- h will not become the next element to reduce -*/
153            enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
154            if (TEST_OPT_DEBUG) Print(" ecart too big; -> L%d\n",at);
155            (*h).p = NULL;
156            strat->fromT = FALSE;
157            return;
158          }
159        }
160        /*put the polynomial also in the pair set*/
161        if (TEST_OPT_MOREPAIRS)
162        {
163          if (!TEST_OPT_INTSTRATEGY)
164            pNorm((*h).p);
165          enterpairs((*h).p,strat->sl,(*h).ecart,0,strat);
166        }
167      }
168      doRed(h,&strat->T[j].p,strat->fromT,strat);
169      strat->fromT=FALSE;
170      if ((*h).p == NULL)
171      {
172        if (TEST_OPT_DEBUG) PrintS(" to 0\n");
173        if (h->lcm!=NULL) pFree1((*h).lcm);
174        return;
175      }
176      /*computes the ecart*/
177
178      if (strat->honey)
179      {
180        if (strat->T[j].ecart <= (*h).ecart)
181          (*h).ecart = d-pFDeg((*h).p);
182        else
183          (*h).ecart = d-pFDeg((*h).p)+strat->T[j].ecart-(*h).ecart;
184        (*h).length = pLength((*h).p);
185      }
186      else
187        (*h).ecart = pLDeg((*h).p,&((*h).length))-pFDeg((*h).p);
188      if (TEST_OPT_CANCELUNIT) cancelunit(h);
189      if ((strat->syzComp!=0) && !strat->honey)
190      {
191        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
192        {
193          if (TEST_OPT_DEBUG) PrintS(" > sysComp\n");
194          return;
195        }
196      }
197      /*- try to reduce the s-polynomial -*/
198      pass++;
199      d = pFDeg((*h).p)+(*h).ecart;
200      /*
201      *test whether the polynomial should go to the lazyset L
202      *-if the degree jumps
203      *-if the number of pre-defined reductions jumps
204      */
205      if ((strat->Ll >= 0) &&  ((d >= reddeg) || (pass > strat->LazyPass)))
206      {
207        at = strat->posInL(strat->L,strat->Ll,*h,strat);
208        if (at <= strat->Ll)
209        {
210          i=strat->sl+1;
211          do
212          {
213            i--;
214            if (i<0) return;
215          } while (!pDivisibleBy(strat->S[i],(*h).p));
216          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
217          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
218          (*h).p = NULL;
219          return;
220        }
221      }
222      else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
223      {
224        reddeg = d+1;
225        Print(".%d",d);mflush();
226      }
227      j = 0;
228      if TEST_OPT_DEBUG PrintLn();
229    }
230    else
231    {
232      if (TEST_OPT_DEBUG) PrintS("-");
233      j++;
234    }
235  }
236}
237
238/*2
239* reduces h with elements from T choosing first possible
240* element in T with respect to the given ecart
241*/
242void redEcart (LObject* h,kStrategy strat)
243{
244  poly pi;
245  int i,at,reddeg,d,ei,li;
246  int j = 0;
247  int pass = 0;
248
249  if (TEST_OPT_CANCELUNIT) cancelunit(h);
250  d = pFDeg((*h).p)+(*h).ecart;
251  reddeg = strat->LazyDegree+d;
252  loop
253  {
254    if (j > strat->tl)
255    {
256      if (TEST_OPT_DEBUG) PrintLn();
257      return;
258    }
259    if (TEST_OPT_DEBUG) Print("%d",j);
260    if (pDivisibleBy(strat->T[j].p,(*h).p))
261    {
262      if (strat->interpt) test_int_std(strat->kIdeal);
263      if (TEST_OPT_DEBUG) PrintS("+");
264      /*- compute the s-polynomial -*/
265      pi = strat->T[j].p;
266      ei = strat->T[j].ecart;
267      li = strat->T[j].length;
268      /*
269      * the polynomial to reduce with (up to the moment) is;
270      * pi with ecart ei and length li
271      */
272      i = j;
273      loop
274      {
275      /*- takes the first possible with respect to ecart -*/
276        if (ei <= (*h).ecart) break;
277        i++;
278        if (i > strat->tl) break;
279        if (TEST_OPT_DEBUG) Print("%d",i);
280        if ((((strat->T[i]).ecart < ei)
281          || (((strat->T[i]).ecart == ei)
282          && ((strat->T[i]).length < li)))
283          && pDivisibleBy((strat->T[i]).p,(*h).p))
284        {
285          if (TEST_OPT_DEBUG) PrintS("+");
286          /*
287           * the polynomial to reduce with is now;
288           */
289          pi = strat->T[i].p;
290          ei = strat->T[i].ecart;
291          li = strat->T[i].length;
292        }
293        else if (TEST_OPT_DEBUG) PrintS("-");
294      }
295      /*
296      * end of search: have to reduce with pi
297      */
298      if (ei > (*h).ecart)
299      {
300        /*
301        * It is not possible to reduce h with smaller ecart;
302        * if possible h goes to the lazy-set L,i.e
303        * if its position in L would be not the last one
304        */
305        strat->fromT = TRUE;
306        if (strat->Ll >= 0) /*- L is not empty -*/
307        {
308          at = strat->posInL(strat->L,strat->Ll,(*h),strat);
309          if (at <= strat->Ll)
310          {
311            /*- h will not become the next element to reduce -*/
312            enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
313            if (TEST_OPT_DEBUG) Print(" ecart too big; -> L%d\n",at);
314            (*h).p = NULL;
315            strat->fromT = FALSE;
316            return;
317          }
318        }
319        /*put the polynomial also in the pair set*/
320        if (TEST_OPT_MOREPAIRS)
321        {
322          if (!TEST_OPT_INTSTRATEGY)
323            pNorm((*h).p);
324          enterpairs((*h).p,strat->sl,(*h).ecart,0,strat);
325        }
326      }
327      if (TEST_OPT_DEBUG)
328      {
329        wrp(h->p);
330        PrintS(" with ");
331        wrp(pi);
332      }
333      doRed(h,&pi,strat->fromT,strat);
334      strat->fromT=FALSE;
335      if (TEST_OPT_DEBUG)
336      {
337        PrintS(" to ");
338        wrp(h->p);
339        PrintLn();
340      }
341      if ((*h).p == NULL)
342      {
343        if (h->lcm!=NULL) pFree1((*h).lcm);
344        return;
345      }
346      /*computes the ecart*/
347      if (strat->honey)
348      {
349        if (ei <= (*h).ecart)
350          (*h).ecart = d-pFDeg((*h).p);
351        else
352          (*h).ecart = d-pFDeg((*h).p)+ei-(*h).ecart;
353        pLDeg((*h).p,&((*h).length));
354        //(*h).length = pLength((*h).p);
355      }
356      else
357        (*h).ecart = pLDeg((*h).p,&((*h).length))-pFDeg((*h).p);
358      if (TEST_OPT_CANCELUNIT) cancelunit(h);
359      if (strat->syzComp!=0)
360      {
361        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
362        {
363          if (TEST_OPT_DEBUG) PrintS(" > sysComp\n");
364          return;
365        }
366      }
367      /*- try to reduce the s-polynomial -*/
368      pass++;
369      d = pFDeg((*h).p)+(*h).ecart;
370      /*
371      *test whether the polynomial should go to the lazyset L
372      *-if the degree jumps
373      *-if the number of pre-defined reductions jumps
374      */
375      if ((strat->Ll >= 0)
376      && ((d >= reddeg) || (pass > strat->LazyPass)))
377      {
378        at = strat->posInL(strat->L,strat->Ll,*h,strat);
379        if (at <= strat->Ll)
380        {
381          i=strat->sl+1;
382          do
383          {
384            i--;
385            if (i<0) return;
386          } while (!pDivisibleBy(strat->S[i],(*h).p));
387          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
388          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
389          (*h).p = NULL;
390          return;
391        }
392      }
393      else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
394      {
395        Print(".%d",d);mflush();
396        reddeg = d+1;
397      }
398      j = 0;
399    }
400    else
401    {
402      if (TEST_OPT_DEBUG) PrintS("-");
403      j++;
404    }
405  }
406}
407
408/*2
409*reduces h with elements from T choosing  the first possible
410* element in t with respect to the given pDivisibleBy
411*/
412void redFirst (LObject* h,kStrategy strat)
413{
414  int at,reddeg,d,i;
415  int pass = 0;
416  int j = 0;
417
418  if (TEST_OPT_CANCELUNIT) cancelunit(h);
419  d = pFDeg((*h).p)+(*h).ecart;
420  reddeg = strat->LazyDegree+d;
421  loop
422  {
423    if (j > strat->tl)
424    {
425      if (TEST_OPT_DEBUG) PrintLn();
426      return;
427    }
428    if (TEST_OPT_DEBUG) Print("%d",j);
429    if (pDivisibleBy(strat->T[j].p,(*h).p))
430    {
431      if (strat->interpt) test_int_std(strat->kIdeal);
432      if (TEST_OPT_DEBUG) PrintS("+\n");
433      /*
434      * the polynomial to reduce with is;
435      * T[j].p
436      */
437      if (!TEST_OPT_INTSTRATEGY)
438        pNorm(strat->T[j].p);
439      if (TEST_OPT_DEBUG)
440      {
441        wrp(h->p);
442        PrintS(" with ");
443        wrp(strat->T[j].p);
444      }
445      (*h).p = spSpolyRed(strat->T[j].p,(*h).p,strat->kNoether);
446      if (TEST_OPT_DEBUG)
447      {
448        PrintS(" to ");
449        wrp(h->p);
450      }
451      if ((*h).p == NULL)
452      {
453        if (h->lcm!=NULL) pFree1((*h).lcm);
454        return;
455      }
456      if (TEST_OPT_CANCELUNIT) cancelunit(h);
457      /*computes the ecart*/
458      d = pLDeg((*h).p,&((*h).length));
459      (*h).ecart = d-pFDeg((*h).p);
460      if ((strat->syzComp!=0) && !strat->honey)
461      {
462        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
463        {
464          if (TEST_OPT_DEBUG) PrintS(" > sysComp\n");
465          return;
466        }
467      }
468      /*- try to reduce the s-polynomial -*/
469      pass++;
470      /*
471      *test whether the polynomial should go to the lazyset L
472      *-if the degree jumps
473      *-if the number of pre-defined reductions jumps
474      */
475      if ((strat->Ll >= 0)
476      && ((d >= reddeg) || (pass > strat->LazyPass))
477      && !strat->homog)
478      {
479        at = strat->posInL(strat->L,strat->Ll,*h,strat);
480        if (at <= strat->Ll)
481        {
482          i=strat->sl+1;
483          do
484          {
485            i--;
486            if (i<0) return;
487          } while (!pDivisibleBy(strat->S[i],(*h).p));
488          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
489          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
490          (*h).p = NULL;
491          return;
492        }
493      }
494      if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
495      {
496        reddeg = d+1;
497        Print(".%d",d);mflush();
498      }
499      j = 0;
500      if TEST_OPT_DEBUG PrintLn();
501    }
502    else
503    {
504      if (TEST_OPT_DEBUG) PrintS("-");
505      j++;
506    }
507  }
508}
509
510/*2
511* reduces h with elements from T choosing the best possible
512* element in t with respect to the ecart and length
513*/
514void redMoraBest (LObject* h,kStrategy strat)
515{
516  poly pi;
517  int reddeg,d,ei,li,i,at;
518  int j = 0;
519  int pass = 0;
520
521  if (TEST_OPT_CANCELUNIT) cancelunit(h);
522  d = pFDeg((*h).p)+(*h).ecart;
523  reddeg = strat->LazyDegree+d;
524  loop
525  {
526    if (j > strat->tl)
527    {
528      if (TEST_OPT_DEBUG) PrintLn();
529      return;
530    }
531    if (TEST_OPT_DEBUG) Print("%d",j);
532    if (pDivisibleBy(strat->T[j].p,(*h).p))
533    {
534      if (strat->interpt) test_int_std(strat->kIdeal);
535      if (TEST_OPT_DEBUG) PrintS("+");
536      /*- compute the s-polynomial -*/
537      pi = strat->T[j].p;
538      ei = strat->T[j].ecart;
539      li = strat->T[j].length;
540      /*
541      * the polynomial to reduce with (up to the moment) is;
542      * pi with ecart ei and length li
543      */
544      i = j;
545      loop
546      {
547        /*- takes the best possible with respect to ecart and length -*/
548        i++;
549        if (i > strat->tl) break;
550        if (TEST_OPT_DEBUG) Print("%d",i);
551        if (((strat->T[i].ecart < ei)
552          || ((strat->T[i].ecart == ei)
553        && (strat->T[i].length < li)))
554        && pDivisibleBy(strat->T[i].p,(*h).p))
555        {
556          if (TEST_OPT_DEBUG) PrintS("+");
557          /*
558          * the polynomial to reduce with is now:
559          */
560          pi = strat->T[i].p;
561          ei = strat->T[i].ecart;
562          li = strat->T[i].length;
563        }
564        else
565        {
566          if (TEST_OPT_DEBUG) PrintS("-");
567        }
568      }
569      /*
570      * end of search: best is pi
571      */
572      if ((ei > (*h).ecart) && (!strat->kHEdgeFound))
573      {
574        /*
575        * It is not possible to reduce h with smaller ecart;
576        * if possible h goes to the lazy-set L,i.e
577        * if its position in L would be not the last one
578        */
579        strat->fromT = TRUE;
580        if (strat->Ll >= 0) /*- L is not empty -*/
581        {
582          at = strat->posInL(strat->L,strat->Ll,(*h),strat);
583          if (at <= strat->Ll)
584          {
585            /*- h will not become the next element to reduce -*/
586            enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
587            if (TEST_OPT_DEBUG) Print(" ecart too big; -> L%d\n",at);
588            (*h).p = NULL;
589            strat->fromT = FALSE;
590            return;
591          }
592        }
593        /*put the polynomial also in the pair set*/
594        if (TEST_OPT_MOREPAIRS)
595        {
596          if (!TEST_OPT_INTSTRATEGY)
597            pNorm((*h).p);
598          enterpairs((*h).p,strat->sl,(*h).ecart,0,strat);
599        }
600      }
601      if (TEST_OPT_DEBUG)
602      {
603        wrp(h->p);
604        PrintS(" with ");
605        wrp(pi);
606      }
607      doRed(h,&pi,strat->fromT,strat);
608      strat->fromT=FALSE;
609      if (TEST_OPT_DEBUG)
610      {
611        PrintS(" to ");
612        wrp(h->p);
613      }
614      if ((*h).p == NULL)
615      {
616        if (h->lcm!=NULL) pFree1((*h).lcm);
617        return;
618      }
619      /*computes the ecart*/
620      if (strat->honey)
621      {
622        if (ei <= (*h).ecart)
623          (*h).ecart = d-pFDeg((*h).p);
624        else
625          (*h).ecart = d-pFDeg((*h).p)+ei-(*h).ecart;
626        (*h).length = pLength((*h).p);
627      }
628      else
629        (*h).ecart = pLDeg((*h).p,&((*h).length))-pFDeg((*h).p);
630      if (TEST_OPT_CANCELUNIT) cancelunit(h);
631      if ((strat->syzComp!=0) && !strat->honey)
632      {
633        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
634        {
635          if (TEST_OPT_DEBUG) PrintS(" > sysComp\n");
636          return;
637        }
638      }
639      /*- try to reduce the s-polynomial -*/
640      pass++;
641      d = pFDeg((*h).p)+(*h).ecart;
642      /*
643      *test whether the polynomial should go to the lazyset L
644      *-if the degree jumps
645      *-if the number of pre-defined reductions jumps
646      */
647      if ((strat->Ll >= 0)
648      && ((d >= reddeg) || (pass > strat->LazyPass)))
649      {
650        at = strat->posInL(strat->L,strat->Ll,*h,strat);
651        if (at <= strat->Ll)
652        {
653          i=strat->sl+1;
654          do
655          {
656            i--;
657            if (i<0) return;
658          } while (!pDivisibleBy(strat->S[i],(*h).p));
659          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
660          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
661          (*h).p = NULL;
662          return;
663        }
664      }
665      else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
666      {
667        reddeg = d+1;
668        Print(".%d",d);mflush();
669      }
670      j = 0;
671      if TEST_OPT_DEBUG PrintLn();
672    }
673    else
674    {
675      if (TEST_OPT_DEBUG) PrintS("-");
676      j++;
677    }
678  }
679}
680
681/*2
682* reduces h with elements from T choosing first possible
683* element in T with respect to the given ecart
684* used for computing normal forms outside std
685*/
686static poly redMoraNF (poly h,kStrategy strat)
687{
688  poly pi;
689  LObject H;
690  int o,ei,li;
691  int j = 0;
692  int z = 10;
693
694  H.p = h;
695  o = pFDeg(h);
696  H.ecart = pLDeg(H.p,&H.length)-o;
697  cancelunit(&H);
698  loop
699  {
700    if (j > strat->tl)
701    {
702      if (TEST_OPT_DEBUG) PrintLn();
703      return H.p;
704    }
705    if (TEST_OPT_DEBUG) Print("%d",j);
706    if (pDivisibleBy(strat->T[j].p,H.p))
707    {
708      if (strat->interpt) test_int_std(strat->kIdeal);
709      if (TEST_OPT_DEBUG) PrintS("+");
710      /*- remember the found T-poly -*/
711      pi = strat->T[j].p;
712      ei = strat->T[j].ecart;
713      li = strat->T[j].length;
714      /*
715      * the polynomial to reduce with (up to the moment) is;
716      * pi with ecart ei and length li
717      */
718      loop
719      {
720        /*- look for a better one with respect to ecart -*/
721        /*- stop, if the ecart is small enough (<=ecart(H)) -*/
722        j++;
723        if (j > strat->tl) break;
724        if (ei <= H.ecart) break;
725        if (TEST_OPT_DEBUG) Print("%d",j);
726        if (((strat->T[j].ecart < ei)
727          || ((strat->T[j].ecart == ei)
728        && (strat->T[j].length < li)))
729        && pDivisibleBy(strat->T[j].p,H.p))
730        {
731          if (TEST_OPT_DEBUG) PrintS("+");
732          /*
733          * the polynomial to reduce with is now;
734          */
735          pi = strat->T[j].p;
736          ei = strat->T[j].ecart;
737          li = strat->T[j].length;
738        }
739        else
740        {
741          if (TEST_OPT_DEBUG) PrintS("-");
742        }
743      }
744      /*
745      * end of search: have to reduce with pi
746      */
747      z++;
748      if (z>10)
749      {
750        pNormalize(H.p);
751        z=0;
752      }
753      if ((ei > H.ecart) && (!strat->kHEdgeFound))
754      {
755        /*
756        * It is not possible to reduce h with smaller ecart;
757        * we have to reduce with bad ecart: H has t enter in T
758        */
759        doRed(&H,&pi,TRUE,strat);
760        if (H.p == NULL)
761        {
762          if (TEST_OPT_DEBUG) PrintS(" to 0\n");
763          return NULL;
764        }
765      }
766      else
767      {
768        /*
769        * we reduce with good ecart, h need not to be put to T
770        */
771        doRed(&H,&pi,FALSE,strat);
772        if (H.p == NULL)
773        {
774          if (TEST_OPT_DEBUG) PrintS(" to 0\n");
775          return NULL;
776        }
777      }
778      /*- try to reduce the s-polynomial -*/
779      o = pFDeg(H.p);
780      cancelunit(&H);
781      H.ecart = pLDeg(H.p,&(H.length))-o;
782      j = 0;
783    }
784    else
785    {
786      if (TEST_OPT_DEBUG) PrintS("-");
787      j++;
788    }
789  }
790}
791
792/*2
793*reorders  L with respect to posInL
794*/
795void reorderL(kStrategy strat)
796{
797  int i,j,at;
798  LObject p;
799
800  for (i=1; i<=strat->Ll; i++)
801  {
802    at = strat->posInL(strat->L,i-1,strat->L[i],strat);
803    if (at != i)
804    {
805      p = strat->L[i];
806      for (j=i-1; j>=at; j--) strat->L[j+1] = strat->L[j];
807      strat->L[at] = p;
808    }
809  }
810}
811
812/*2
813*reorders  T with respect to length
814*/
815void reorderT(kStrategy strat)
816{
817  int i,j,at;
818  TObject p;
819
820  for (i=1; i<=strat->tl; i++)
821  {
822    if (strat->T[i-1].length > strat->T[i].length)
823    {
824      p = strat->T[i];
825      at = i-1;
826      loop
827      {
828        at--;
829        if (at < 0) break;
830        if (strat->T[i].length > strat->T[at].length) break;
831      }
832      for (j = i-1; j>at; j--)
833      {
834        strat->T[j+1]=strat->T[j];
835      }
836      strat->T[at+1]=p;
837    }
838  }
839}
840
841/*2
842*looks whether exactly pVariables-1 axis are used
843*returns last != 0 in this case
844*last is the (first) unused axis
845*/
846void missingAxis (int* last,kStrategy strat)
847{
848  int   i = 0;
849  int   k = 0;
850
851  *last = 0;
852  loop
853  {
854    i++;
855    if (i > pVariables) break;
856    if (strat->NotUsedAxis[i])
857    {
858      *last = i;
859      k++;
860    }
861    if (k>1)
862    {
863      *last = 0;
864      break;
865    }
866  }
867}
868
869/*2
870*last is the only non used axis, it looks
871*for a monomial in p being a pure power of this
872*variable and returns TRUE in this case
873*(*length) gives the length between the pure power and the leading term
874*(should be minimal)
875*/
876BOOLEAN hasPurePower (poly p,int last, int *length,kStrategy strat)
877{
878  poly h;
879  int i;
880
881  if (pNext(p) == strat->tail)
882    return FALSE;
883  if (pMinComp(p) == strat->ak)
884  {
885    *length = 0;
886    h = p;
887    while (h != NULL)
888    {
889      i = pIsPurePower(h);
890      if (i==last) return TRUE;
891      (*length)++;
892      pIter(h);
893    }
894  }
895  return FALSE;
896}
897
898/*2
899* looks up the position of polynomial p in L
900* in the case of looking for the pure powers
901*/
902int posInL10 (LSet set, int length, LObject p,kStrategy strat)
903{
904  int j,dp,dL;
905
906  if (length<0) return 0;
907  if (hasPurePower(p.p,strat->lastAxis,&dp,strat))
908  {
909    for (j=length; j>=0; j--)
910    {
911      if (!hasPurePower(set[j].p,strat->lastAxis,&dL,strat))
912        return j+1;
913      if (dp < dL)
914        return j+1;
915      if ((dp == dL)
916      && (pFDeg(set[j].p)+set[j].ecart >= pFDeg(p.p)+p.ecart))
917        return j+1;
918    }
919  }
920  j=length;
921  loop
922  {
923    if (j<0) break;
924    if (!hasPurePower(set[j].p,strat->lastAxis,&dL,strat)) break;
925    j--;
926  }
927  return strat->posInLOld(set,j,p,strat);
928}
929
930/*2
931* computes the s-polynomials L[ ].p in L
932*/
933void updateL(kStrategy strat)
934{
935  LObject p;
936  int dL;
937  int j=strat->Ll;
938  loop
939  {
940    if (j<0) break;
941    if (hasPurePower(strat->L[j].p,strat->lastAxis,&dL,strat))
942    {
943      p=strat->L[strat->Ll];
944      strat->L[strat->Ll]=strat->L[j];
945      strat->L[j]=p;
946      break;
947    }
948    j--;
949  }
950  if (j<0)
951  {
952    j=strat->Ll;
953    loop
954    {
955      if (j<0) break;
956      if (pNext(strat->L[j].p) == strat->tail)
957      {
958        pFree1(strat->L[j].p);    /*deletes the short spoly and computes*/
959        strat->L[j].p=spSpolyCreate(strat->L[j].p1,strat->L[j].p2,strat->kNoether);   /*the real one*/
960        if (!strat->honey)
961          strat->initEcart(&strat->L[j]);
962        else
963          strat->L[j].length = pLength(strat->L[j].p);
964        if (hasPurePower(strat->L[j].p,strat->lastAxis,&dL,strat))
965        {
966          p=strat->L[strat->Ll];
967          strat->L[strat->Ll]=strat->L[j];
968          strat->L[j]=p;
969          break;
970        }
971      }
972      j--;
973    }
974  }
975}
976
977/*2
978* computes the s-polynomials L[ ].p in L and
979* cuts elements in L above noether
980*/
981void updateLHC(kStrategy strat)
982{
983  int i = 0;
984  while (i <= strat->Ll)
985  {
986    if (pNext(strat->L[i].p) == strat->tail)
987    {
988       /*- deletes the int spoly and computes -*/
989      if (pComp0(strat->L[i].p,strat->kNoether) == -1)
990      {
991        pFree1(strat->L[i].p);
992        strat->L[i].p = NULL;
993      }
994      else
995      {
996        pFree1(strat->L[i].p);
997        strat->L[i].p = spSpolyCreate(strat->L[i].p1,strat->L[i].p2,strat->kNoether);
998        strat->L[i].ecart = pLDeg(strat->L[i].p,&strat->L[i].length)-pFDeg(strat->L[i].p);
999      }
1000    }
1001    else
1002      deleteHC(&strat->L[i].p,&strat->L[i].ecart,&strat->L[i].length,strat);
1003   if (strat->L[i].p == NULL)
1004      deleteInL(strat->L,&strat->Ll,i,strat);
1005    else
1006      i++;
1007  }
1008}
1009
1010/*2
1011* cuts in T above strat->kNoether and tries to cancel a unit
1012*/
1013void updateT(kStrategy strat)
1014{
1015  int i = 0;
1016  LObject p;
1017
1018  while (i <= strat->tl)
1019  {
1020    deleteHCs(&strat->T[i],strat);
1021    /*- tries to cancel a unit: -*/
1022    p.p = strat->T[i].p;
1023    p.ecart = strat->T[i].ecart;
1024    p.length = strat->T[i].length;
1025    cancelunit(&p);
1026    strat->T[i].p = p.p;
1027    strat->T[i].ecart = p.ecart;
1028    strat->T[i].length = p.length;
1029    i++;
1030  }
1031}
1032
1033/*2
1034* arranges red, pos and T if strat->kHEdgeFound (first time)
1035*/
1036void firstUpdate(kStrategy strat)
1037{
1038  if (strat->update)
1039  {
1040    strat->update = (strat->tl == -1);
1041    if (TEST_OPT_WEIGHTM)
1042    {
1043      pFDeg=pFDegOld;
1044      pLDeg=pLDegOld;
1045      if (ecartWeights)
1046      {
1047        Free((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1048        ecartWeights=NULL;
1049      }
1050    }
1051    if (TEST_OPT_FASTHC)
1052    {
1053      strat->posInL = strat->posInLOld;
1054      strat->lastAxis = 0;
1055    }
1056    if (BTEST1(27))
1057      return;
1058    if (!BTEST1(20))        /*- take the first possible -*/
1059      strat->red = redFirst;
1060    updateT(strat);
1061    strat->posInT = posInT2;
1062    reorderT(strat);
1063  }
1064}
1065
1066/*2
1067*-puts p to the standardbasis s at position at
1068*-reduces the tail of p if TEST_OPT_REDTAIL
1069*-tries to cancel a unit
1070*-HEckeTest
1071*  if TRUE
1072*  - decides about reduction-strategies
1073*  - computes noether
1074*  - stops computation if BTEST1(27)
1075*  - cuts the tails of the polynomials
1076*    in s,t and the elements in L above noether
1077*    and cancels units if possible
1078*  - reorders s,L
1079*/
1080void enterSMora (LObject p,int atS,kStrategy strat)
1081{
1082  int i;
1083
1084#ifdef SDRING
1085  if (pSDRING
1086  && (atS<=strat->sl)
1087  && pComparePolys(p.p,strat->S[atS]))
1088  {
1089    if (TEST_OPT_PROT)
1090      PrintS("m");
1091    p.p=NULL;
1092    return;
1093  }
1094  if (pSDRING
1095  && (atS<strat->sl)
1096  && pComparePolys(p.p,strat->S[atS+1]))
1097  {
1098    if (TEST_OPT_PROT)
1099      PrintS("m");
1100    p.p=NULL;
1101    return;
1102  }
1103  if (pSDRING
1104  && (atS>0)
1105  && pComparePolys(p.p,strat->S[atS-1]))
1106  {
1107    if (TEST_OPT_PROT)
1108      PrintS("m");
1109    p.p=NULL;
1110    return;
1111  }
1112#endif
1113  strat->news = TRUE;
1114  /*- puts p to the standardbasis s at position atS -*/
1115  if (strat->sl == IDELEMS(strat->Shdl)-1)
1116  {
1117    pEnlargeSet(&strat->S,IDELEMS(strat->Shdl),setmax);
1118    strat->ecartS = (intset) ReAlloc(strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int),
1119                                     (IDELEMS(strat->Shdl)+setmax)*sizeof(int));
1120    if (strat->fromQ)
1121    {
1122      strat->fromQ = (intset)ReAlloc(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int),
1123                                    (IDELEMS(strat->Shdl)+setmax)*sizeof(int));
1124    }
1125    IDELEMS(strat->Shdl) += setmax;
1126    strat->Shdl->m=strat->S;
1127  }
1128  for (i=strat->sl+1; i>atS; i--)
1129  {
1130    strat->S[i] = strat->S[i-1];
1131    strat->ecartS[i] = strat->ecartS[i-1];
1132  }
1133  if (strat->fromQ)
1134  {
1135    for (i=strat->sl+1; i>=atS+1; i--)
1136    {
1137      strat->fromQ[i] = strat->fromQ[i-1];
1138    }
1139    strat->fromQ[atS]=0;
1140  }
1141  /*- save result -*/
1142  strat->S[atS] = p.p;
1143  strat->ecartS[atS] = p.ecart;
1144  strat->sl++;
1145  if (TEST_OPT_DEBUG)
1146  {
1147    Print("new s%d:",atS);
1148    wrp(p.p);
1149    PrintLn();
1150  }
1151  if ((!strat->kHEdgeFound) || (strat->kNoether!=NULL)) HEckeTest(p.p,strat);
1152  if (strat->kHEdgeFound)
1153  {
1154    if (newHEdge(strat->S,strat->ak,strat))
1155    {
1156      firstUpdate(strat);
1157      if (BTEST1(27))
1158        return;
1159      /*- cuts elements in L above noether and reorders L -*/
1160      updateLHC(strat);
1161      /*- reorders L with respect to posInL -*/
1162      reorderL(strat);
1163    }
1164  }
1165  else if (strat->kNoether!=NULL)
1166    strat->kHEdgeFound = TRUE;
1167  else if (TEST_OPT_FASTHC)
1168  {
1169    if (strat->posInLOldFlag)
1170    {
1171      missingAxis(&strat->lastAxis,strat);
1172      if (strat->lastAxis)
1173      {
1174        strat->posInLOld = strat->posInL;
1175        strat->posInLOldFlag = FALSE;
1176        strat->posInL = posInL10;
1177        updateL(strat);
1178        reorderL(strat);
1179      }
1180    }
1181    else if (strat->lastAxis)
1182      updateL(strat);
1183  }
1184}
1185
1186/*2
1187*-puts p to the standardbasis s at position at
1188*-HEckeTest
1189*  if TRUE
1190*  - computes noether
1191*/
1192void enterSMoraNF (LObject p, int atS,kStrategy strat)
1193{
1194  int i;
1195
1196  /*- puts p to the standardbasis s at position at -*/
1197  if (strat->sl == IDELEMS(strat->Shdl)-1)
1198  {
1199    pEnlargeSet(&strat->S,IDELEMS(strat->Shdl),setmax);
1200    strat->ecartS = (intset) ReAlloc(strat->ecartS,IDELEMS(strat->Shdl)*sizeof(intset),
1201                                     (IDELEMS(strat->Shdl)+setmax)*sizeof(intset));
1202    IDELEMS(strat->Shdl) += setmax;
1203    strat->Shdl->m=strat->S;
1204  }
1205  for (i=strat->sl+1; i>atS; i--)
1206  {
1207    strat->S[i] = strat->S[i-1];
1208    strat->ecartS[i] = strat->ecartS[i-1];
1209  }
1210  strat->S[atS] = p.p;/*- save result -*/
1211  strat->ecartS[atS] = p.ecart;
1212  strat->sl++;
1213  if ((!strat->kHEdgeFound) || (strat->kNoether!=NULL)) HEckeTest(p.p,strat);
1214  if (strat->kHEdgeFound)
1215    newHEdge(strat->S,strat->ak,strat);
1216  else if (strat->kNoether!=NULL)
1217    strat->kHEdgeFound = TRUE;
1218}
1219
1220void initMora(ideal F,kStrategy strat)
1221{
1222  int i,j;
1223  idhdl h;
1224
1225  strat->NotUsedAxis = (BOOLEAN *)Alloc((pVariables+1)*sizeof(BOOLEAN));
1226  for (j=1; j<=pVariables; j++) strat->NotUsedAxis[j] = TRUE;
1227  strat->enterS = enterSMora;
1228  strat->initEcartPair = initEcartPairMora; /*- ecart approximation -*/
1229  strat->posInLOld = strat->posInL;
1230  strat->posInLOldFlag = TRUE;
1231  strat->initEcart = initEcartNormal;
1232  strat->kHEdgeFound = ppNoether != NULL;
1233  if ( strat->kHEdgeFound )
1234     strat->kNoether = pCopy(ppNoether);
1235  if (BTEST1(20))
1236    strat->red = redMoraBest;/*- look for the best in T -*/
1237  else if (strat->kHEdgeFound || strat->homog)
1238    strat->red = redFirst;  /*take the first possible in T*/
1239  else if (BTEST1(19))
1240    strat->red = redEcart19;/*take the first possible in T, rquires T sorted by ecart*/
1241  else
1242    strat->red = redEcart;/*take the first possible in under ecart-restriction*/
1243  if (strat->kHEdgeFound)
1244  {
1245    strat->HCord = pFDeg(ppNoether)+1;
1246    strat->posInT = posInT2;
1247  }
1248  else
1249  {
1250    strat->HCord = 32000;/*- very large -*/
1251  }
1252  /*reads the ecartWeights used for Graebes method from the
1253   *intvec ecart and set ecartWeights
1254   */
1255  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1256  {
1257    //interred  machen   Aenderung
1258    pFDegOld=pFDeg;
1259    pLDegOld=pLDeg;
1260    h=ggetid("ecart");
1261    if ((h!=NULL) && (IDTYP(h)==INTVEC_CMD))
1262    {
1263      ecartWeights=iv2array(IDINTVEC(h));
1264    }
1265    else
1266    {
1267      ecartWeights=(short *)Alloc((pVariables+1)*sizeof(short));
1268      /*uses automatic computation of the ecartWeights to set them*/
1269      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
1270    }
1271    pFDeg=totaldegreeWecart;
1272    pLDeg=maxdegreeWecart;
1273    for(i=1; i<=pVariables; i++)
1274      Print(" %d",ecartWeights[i]);
1275    PrintLn();
1276    mflush();
1277  }
1278}
1279
1280ideal mora (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
1281{
1282  int srmax;
1283  int lrmax = 0;
1284  int olddeg = 0;
1285  int reduc = 0;
1286  int hilbeledeg=1,hilbcount=0;
1287
1288#ifdef SDRING
1289  polyset aug=(polyset)Alloc(setmax*sizeof(poly));
1290  int augmax=setmax, augl=-1;
1291  poly oldLcm;
1292#endif
1293
1294  strat->update = TRUE;
1295  /*- setting global variables ------------------- -*/
1296  initBuchMoraCrit(strat);
1297  initHilbCrit(F,Q,&hilb,strat);
1298  initMora(F,strat);
1299  initBuchMoraPos(strat);
1300  /*Shdl=*/initBuchMora(F,Q,strat);
1301  if (TEST_OPT_FASTHC) missingAxis(&strat->lastAxis,strat);
1302  /*updateS in initBuchMora has Hecketest
1303  * and could have put strat->kHEdgdeFound FALSE*/
1304  if (ppNoether!=NULL)
1305  {
1306    strat->kHEdgeFound = TRUE;
1307  }
1308  if (strat->kHEdgeFound && strat->update)
1309  {
1310    firstUpdate(strat);
1311    updateLHC(strat);
1312    reorderL(strat);
1313  }
1314  if (TEST_OPT_FASTHC && (strat->lastAxis) && strat->posInLOldFlag)
1315  {
1316    strat->posInLOld = strat->posInL;
1317    strat->posInLOldFlag = FALSE;
1318    strat->posInL = posInL10;
1319    updateL(strat);
1320    reorderL(strat);
1321  }
1322  srmax = strat->sl;
1323  /*- compute-------------------------------------------*/
1324  while (strat->Ll >= 0)
1325  {
1326    if (lrmax< strat->Ll) lrmax=strat->Ll; /*stat*/
1327    test_int_std(strat->kIdeal);
1328    if (TEST_OPT_DEBUG) messageSets(strat);
1329    if (TEST_OPT_DEGBOUND
1330    && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p)> Kstd1_deg))
1331    {
1332      /*
1333      * stops computation if
1334      * - 24 (degBound)
1335      *   && upper degree is bigger than Kstd1_deg
1336      */
1337      while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1338      break;
1339    }
1340    strat->P = strat->L[strat->Ll];/*- picks the last element from the lazyset L -*/
1341    if (strat->Ll==0) strat->interpt=TRUE;
1342    strat->Ll--;
1343    if (pNext(strat->P.p) == strat->tail)
1344    {
1345      pFree1(strat->P.p);/*- deletes the short spoly and computes -*/
1346      strat->P.p = spSpolyCreate(strat->P.p1,strat->P.p2,strat->kNoether);/*- the real one -*/
1347      if (!strat->honey)
1348        strat->initEcart(&strat->P);
1349      else
1350        strat->P.length = pLength(strat->P.p);
1351    }
1352#ifdef SDRING
1353    if (strat->P.p != NULL)
1354#endif
1355    {
1356      if (TEST_OPT_PROT) message(strat->P.ecart+pFDeg(strat->P.p),&olddeg,&reduc,strat);
1357      strat->red(&strat->P,strat);/*- reduction of the element choosen from L -*/
1358    }
1359    if (strat->P.p != NULL)
1360    {
1361#ifdef SDRING
1362      aug[0]=strat->P.p;
1363      augl=0;
1364      if (pSDRING)
1365      {
1366        oldLcm=strat->P.lcm;
1367#ifdef SRING
1368        if (pSRING) psAug(pCopy(strat->P.p),pOne(),&aug,&augl,&augmax);
1369#endif
1370#ifdef DRING
1371        if (pDRING) pdAug(pCopy(strat->P.p),&aug,&augl,&augmax);
1372#endif
1373      }
1374      for (augl++;augl != 0;)
1375      {
1376        strat->P.p=aug[--augl];
1377        if (pSDRING)
1378        {
1379          if (oldLcm==NULL) strat->P.lcm=NULL;
1380          else  strat->P.lcm=pCopy1(oldLcm);
1381        }
1382        if ((augl!=0) && (strat->P.p!=NULL)) strat->red(&strat->P,strat);
1383        if (strat->P.p != NULL)
1384        {
1385#endif
1386          if (TEST_OPT_PROT) PrintS("s");/*- statistic -*/
1387          /*- enter P.p into s and b: -*/
1388          if (!TEST_OPT_INTSTRATEGY)
1389          {
1390            pNorm(strat->P.p);
1391          }
1392          strat->P.p = redtail(strat->P.p,strat->sl,strat);
1393          if ((!strat->noTailReduction) && (!strat->honey))
1394          {
1395            strat->initEcart(&strat->P);
1396          }
1397          if TEST_OPT_INTSTRATEGY
1398          {
1399            //pContent(strat->P.p);
1400            pCleardenom(strat->P.p);// also does a pContent
1401          }
1402          cancelunit(&strat->P);/*- tries to cancel a unit -*/
1403          enterT(strat->P,strat);
1404          {
1405            int pos;
1406#ifdef SDRING
1407            pos = posInS(strat->S,strat->sl,strat->P.p);
1408            if (pSDRING && (pos<=strat->sl)
1409            && (pComparePolys(strat->P.p,strat->S[pos])))
1410            {
1411              if (TEST_OPT_PROT)
1412                PrintS("d");
1413            }
1414            else
1415#endif
1416            {
1417              enterpairs(strat->P.p,strat->sl,strat->P.ecart,0,strat);
1418              if (strat->sl==-1)
1419              {
1420                pos=0;
1421              }
1422              else
1423              {
1424                pos = posInS(strat->S,strat->sl,strat->P.p);
1425              }
1426              strat->enterS(strat->P,pos,strat);
1427            }
1428            if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1429          }
1430          if (strat->P.lcm!=NULL) pFree1(strat->P.lcm);
1431#ifdef KDEBUG
1432          strat->P.lcm=NULL;
1433#endif
1434#ifdef SDRING
1435        }
1436      }
1437      /* delete the old pair */
1438      if (pSDRING &&(oldLcm!=NULL)) pFree1(oldLcm);
1439#endif
1440#ifdef KDEBUG
1441      memset(&strat->P,0,sizeof(strat->P));
1442#endif
1443      if (strat->sl>srmax) srmax = strat->sl; /*stat.*/
1444      if (strat->Ll>lrmax) lrmax = strat->Ll;
1445    }
1446    if (strat->kHEdgeFound)
1447    {
1448      if ((BTEST1(27))
1449      || ((TEST_OPT_MULTBOUND) && (scMult0Int((strat->Shdl)) < mu)))
1450      {
1451        /*
1452        * stops computation if strat->kHEdgeFound and
1453        * - 27 (finiteDeterminacyTest)
1454        * or
1455        * - 23
1456        *   (multBound)
1457        *   && multiplicity of the ideal is smaller then a predefined number mu
1458        */
1459        while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1460      }
1461    }
1462  }
1463  /*- complete reduction of the standard basis------------------------ -*/
1464  if (TEST_OPT_REDSB) completeReduce(strat);
1465  /*- release temp data------------------------------- -*/
1466  exitBuchMora(strat);
1467  /*- polynomials used for HECKE: HC, noether -*/
1468  if (BTEST1(27))
1469  {
1470    if (strat->kHEdge)
1471      Kstd1_mu=pFDeg(strat->kHEdge);
1472    else
1473      Kstd1_mu=-1;
1474  }
1475  pDelete(&strat->kHEdge);
1476  strat->update = TRUE; //???
1477  strat->lastAxis = 0; //???
1478  pDelete(&strat->kNoether);
1479  Free((ADDRESS)strat->NotUsedAxis,(pVariables+1)*sizeof(BOOLEAN));
1480#ifdef SDRING
1481  Free((ADDRESS)aug,augmax*sizeof(poly));
1482#endif
1483  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1484  if (TEST_OPT_WEIGHTM)
1485  {
1486    pFDeg=pFDegOld;
1487    pLDeg=pLDegOld;
1488    if (ecartWeights)
1489    {
1490      Free((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1491      ecartWeights=NULL;
1492    }
1493  }
1494  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1495  return (strat->Shdl);
1496}
1497
1498poly kNF1 (ideal F,ideal Q,poly q, kStrategy strat, int lazyReduce)
1499{
1500  poly   p;
1501  int   i;
1502  int   j;
1503  int   o;
1504  LObject   h;
1505  BITSET save_test=test;
1506
1507  if ((idIs0(F))&&(Q==NULL))
1508    return pCopy(q); /*F=0*/
1509  strat->ak = idRankFreeModule(F);
1510  /*- creating temp data structures------------------- -*/
1511  strat->kHEdgeFound = ppNoether != NULL;
1512  strat->kNoether    = pCopy(ppNoether);
1513  test|=Sy_bit(OPT_REDTAIL);
1514  test&=~Sy_bit(OPT_INTSTRATEGY);
1515  if (TEST_OPT_STAIRCASEBOUND
1516  && (0<Kstd1_deg)
1517  && ((!strat->kHEdgeFound)
1518    ||(TEST_OPT_DEGBOUND && (pWTotaldegree(strat->kNoether)<Kstd1_deg))))
1519  {
1520    pDelete(&strat->kNoether);
1521    strat->kNoether=pOne();
1522    pGetExp(strat->kNoether,1)=Kstd1_deg+1;
1523    pSetm(strat->kNoether);
1524    strat->kHEdgeFound=TRUE;
1525  }
1526  initBuchMoraCrit(strat);
1527  initBuchMoraPos(strat);
1528  initMora(F,strat);
1529  strat->enterS = enterSMoraNF;
1530  /*- set T -*/
1531  strat->tl = -1;
1532  strat->tmax = setmax;
1533  strat->T = initT();
1534  /*- set S -*/
1535  strat->sl = -1;
1536  /*- init local data struct.-------------------------- -*/
1537  /*Shdl=*/initS(F,Q,strat);
1538  if (lazyReduce==0)
1539  {
1540    for (i=strat->sl; i>=0; i--)
1541      pNorm(strat->S[i]);
1542  }
1543  /*- puts the elements of S also to T -*/
1544  for (i=0; i<=strat->sl; i++)
1545  {
1546    h.p = strat->S[i];
1547    h.ecart = strat->ecartS[i];
1548    h.length = pLength(h.p);
1549    enterT(h,strat);
1550  }
1551  /*- compute------------------------------------------- -*/
1552  p = pCopy(q);
1553  deleteHC(&p,&o,&j,strat);
1554  if (p!=NULL) p = redMoraNF(p,strat);
1555  if ((p!=NULL)&&(lazyReduce==0))
1556  {
1557    p = redtail(p,strat->sl,strat);
1558  }
1559  /*- release temp data------------------------------- -*/
1560  cleanT(strat);
1561  Free((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
1562  Free((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
1563  Free((ADDRESS)strat->NotUsedAxis,(pVariables+1)*sizeof(BOOLEAN));
1564  if ((Q!=NULL)&&(strat->fromQ!=NULL))
1565  {
1566    i=((IDELEMS(Q)+IDELEMS(F)+15)/16)*16;
1567    Free((ADDRESS)strat->fromQ,i*sizeof(int));
1568    strat->fromQ=NULL;
1569  }
1570  pDelete(&strat->kHEdge);
1571  pDelete(&strat->kNoether);
1572  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1573  {
1574    pFDeg=pFDegOld;
1575    pLDeg=pLDegOld;
1576    if (ecartWeights)
1577    {
1578      Free((ADDRESS *)&ecartWeights,(pVariables+1)*sizeof(short));
1579      ecartWeights=NULL;
1580    }
1581  }
1582  idDelete(&strat->Shdl);
1583  test=save_test;
1584  return p;
1585}
1586
1587ideal kNF1 (ideal F,ideal Q,ideal q, kStrategy strat, int lazyReduce)
1588{
1589  poly   p;
1590  int   i;
1591  int   j;
1592  int   o;
1593  LObject   h;
1594  ideal res;
1595  BITSET save_test=test;
1596
1597  if (idIs0(q)) return idInit(1,q->rank);
1598  if ((idIs0(F))&&(Q==NULL))
1599    return idCopy(q); /*F=0*/
1600  strat->ak = idRankFreeModule(F);
1601  /*- creating temp data structures------------------- -*/
1602  strat->kHEdgeFound = ppNoether != NULL;
1603  strat->kNoether=pCopy(ppNoether);
1604  test|=Sy_bit(OPT_REDTAIL);
1605  if (TEST_OPT_STAIRCASEBOUND
1606  && (0<Kstd1_deg)
1607  && ((!strat->kHEdgeFound)
1608    ||(TEST_OPT_DEGBOUND && (pWTotaldegree(strat->kNoether)<Kstd1_deg))))
1609  {
1610    pDelete(&strat->kNoether);
1611    strat->kNoether=pOne();
1612    pGetExp(strat->kNoether,1)=Kstd1_deg+1;
1613    pSetm(strat->kNoether);
1614    strat->kHEdgeFound=TRUE;
1615  }
1616  initBuchMoraCrit(strat);
1617  initBuchMoraPos(strat);
1618  initMora(F,strat);
1619  strat->enterS = enterSMoraNF;
1620  /*- set T -*/
1621  strat->tl = -1;
1622  strat->tmax = setmax;
1623  strat->T = initT();
1624  /*- set S -*/
1625  strat->sl = -1;
1626  /*- init local data struct.-------------------------- -*/
1627  /*Shdl=*/initS(F,Q,strat);
1628  if (TEST_OPT_INTSTRATEGY&&(lazyReduce==0))
1629  {
1630    for (i=strat->sl; i>=0; i--)
1631      pNorm(strat->S[i]);
1632  }
1633  /*- compute------------------------------------------- -*/
1634  res=idInit(IDELEMS(q),q->rank);
1635  for (i=0; i<IDELEMS(q); i++)
1636  {
1637    if (q->m[i]!=NULL)
1638    {
1639      p = pCopy(q->m[i]);
1640      deleteHC(&p,&o,&j,strat);
1641      if (p!=NULL)
1642      {
1643        /*- puts the elements of S also to T -*/
1644        for (j=0; j<=strat->sl; j++)
1645        {
1646          h.p = strat->S[j];
1647          h.ecart = strat->ecartS[j];
1648          h.length = pLength(h.p);
1649          enterT(h,strat);
1650        }
1651        p = redMoraNF(p,strat);
1652        if ((p!=NULL)&&(lazyReduce==0))
1653        {
1654          p = redtail(p,strat->sl,strat);
1655        }
1656        cleanT(strat);
1657      }
1658      res->m[i]=p;
1659    }
1660    //else
1661    //  res->m[i]=NULL;
1662    if (TEST_OPT_PROT)
1663    {
1664      PrintS("-");mflush();
1665    }
1666  }
1667  /*- release temp data------------------------------- -*/
1668  Free((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
1669  Free((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
1670  if ((Q!=NULL)&&(strat->fromQ!=NULL))
1671  {
1672    i=((IDELEMS(Q)+IDELEMS(F)+15)/16)*16;
1673    Free((ADDRESS)strat->fromQ,i*sizeof(int));
1674    strat->fromQ=NULL;
1675  }
1676  pDelete(&strat->kHEdge);
1677  pDelete(&strat->kNoether);
1678  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1679  {
1680    pFDeg=pFDegOld;
1681    pLDeg=pLDegOld;
1682    if (ecartWeights)
1683    {
1684      Free((ADDRESS *)&ecartWeights,(pVariables+1)*sizeof(short));
1685      ecartWeights=NULL;
1686    }
1687  }
1688  idDelete(&strat->Shdl);
1689  test=save_test;
1690  return res;
1691}
1692
1693pFDegProc pOldFDeg;
1694intvec * kModW;
1695
1696int kModDeg(poly p)
1697{
1698  int o=pOldFDeg(p);
1699  int i=pGetComp(p);
1700  if (i==0) return o;
1701  return o+(*kModW)[i-1];
1702}
1703
1704ideal std(ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
1705          int newIdeal)
1706{
1707  ideal r;
1708  BOOLEAN b=pLexOrder,toReset=FALSE;
1709  BOOLEAN delete_w=(w==NULL);
1710  kStrategy strat=(kStrategy)Alloc0(sizeof(skStrategy));
1711
1712  if(!TEST_OPT_RETURN_SB)
1713    strat->syzComp = syzComp;
1714  if (TEST_OPT_SB_1)
1715    strat->newIdeal = newIdeal;
1716  if (currRing->ch==0) strat->LazyPass=2;
1717  else                 strat->LazyPass=20;
1718  strat->LazyDegree = 1;
1719  if ((h==testHomog)
1720#ifdef DRING
1721  && (!pDRING)
1722#endif
1723  )
1724  {
1725    if (idRankFreeModule(F)==0)
1726    {
1727      h = (tHomog)idHomIdeal(F,Q);
1728      w=NULL;
1729    }
1730    else
1731      h = (tHomog)idHomModule(F,Q,w);
1732    //Print("test homog:%d\n",h);
1733    //if ((h==isHomog)&&(w!=NULL)&&(*w!=NULL))
1734    //{
1735    //  (*w)->show();
1736    //  PrintLn();
1737    //  if (F!=NULL) jjPRINT_MA0(idModule2Matrix(idCopy(F)),sNoName);
1738    //}
1739  }
1740#ifdef DRING
1741  if (pDRING) h=isNotHomog;
1742#endif
1743  if (h==isHomog)
1744  {
1745    if ((w!=NULL) && (*w!=NULL))
1746    {
1747      kModW = *w;
1748      pOldFDeg = pFDeg;
1749      pFDeg = kModDeg;
1750      toReset = TRUE;
1751    }
1752    pLexOrder = TRUE;
1753    if (hilb==NULL) strat->LazyPass*=2;
1754  }
1755  strat->homog=h;
1756  spSet(currRing);
1757  if (pOrdSgn==-1)
1758  {
1759    if (w!=NULL)
1760      r=mora(F,Q,*w,hilb,strat);
1761    else
1762      r=mora(F,Q,NULL,hilb,strat);
1763  }
1764  else
1765  {
1766    if (w!=NULL)
1767      r=bba(F,Q,*w,hilb,strat);
1768    else
1769      r=bba(F,Q,NULL,hilb,strat);
1770  }
1771#ifdef KDEBUG
1772  int i;
1773  for (i=0; i<IDELEMS(r); i++) pTest(r->m[i]);
1774#endif
1775  if (toReset)
1776  {
1777    kModW = NULL;
1778    pFDeg = pOldFDeg;
1779  }
1780  pLexOrder = b;
1781//Print("%d reductions canceled \n",strat->cel);
1782  HCord=strat->HCord;
1783  Free((ADDRESS)strat,sizeof(skStrategy));
1784  if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
1785  return r;
1786}
1787
1788lists min_std(ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
1789              int reduced)
1790{
1791  ideal r=NULL;
1792  int Kstd1_OldDeg,i;
1793  BOOLEAN b=pLexOrder,toReset=FALSE;
1794  BOOLEAN delete_w=(w==NULL);
1795  BOOLEAN oldDegBound=TEST_OPT_DEGBOUND;
1796  kStrategy strat=(kStrategy)Alloc0(sizeof(skStrategy));
1797
1798  if(!TEST_OPT_RETURN_SB)
1799     strat->syzComp = syzComp;
1800  if (currRing->ch==0) strat->LazyPass=2;
1801  else                 strat->LazyPass=20;
1802  strat->LazyDegree = 1;
1803  strat->minim=(reduced % 2)+1;
1804  if ((h==testHomog)
1805#ifdef DRING
1806  && (!pDRING)
1807#endif
1808  )
1809  {
1810    if (idRankFreeModule(F)==0)
1811    {
1812      h = (tHomog)idHomIdeal(F,Q);
1813      w=NULL;
1814    }
1815    else
1816    {
1817      h = (tHomog)idHomModule(F,Q,w);
1818    }
1819  }
1820#ifdef DRING
1821  if (pDRING) h=isNotHomog;
1822#endif
1823  if (h==isHomog)
1824  {
1825    if ((w!=NULL) && (*w!=NULL))
1826    {
1827      kModW = *w;
1828      pOldFDeg = pFDeg;
1829      pFDeg = kModDeg;
1830      toReset = TRUE;
1831      if (reduced>1)
1832      {
1833        Kstd1_OldDeg=Kstd1_deg;
1834        Kstd1_deg = -1;
1835        for (i=IDELEMS(F)-1;i>=0;i--)
1836        {
1837          if ((F->m[i]!=NULL) && (pFDeg(F->m[i])>=Kstd1_deg))
1838            Kstd1_deg = pFDeg(F->m[i])+1;
1839        }
1840      }
1841    }
1842    pLexOrder = TRUE;
1843    strat->LazyPass*=2;
1844  }
1845  strat->homog=h;
1846  spSet(currRing);
1847  if (pOrdSgn==-1)
1848  {
1849    if (w!=NULL)
1850      r=mora(F,Q,*w,hilb,strat);
1851    else
1852      r=mora(F,Q,NULL,hilb,strat);
1853  }
1854  else
1855  {
1856    if (w!=NULL)
1857      r=bba(F,Q,*w,hilb,strat);
1858    else
1859      r=bba(F,Q,NULL,hilb,strat);
1860  }
1861#ifdef KDEBUG
1862  {
1863    int i;
1864    for (i=0; i<IDELEMS(r); i++) pTest(r->m[i]);
1865  }
1866#endif
1867  idSkipZeroes(r);
1868  if (toReset)
1869  {
1870    kModW = NULL;
1871    pFDeg = pOldFDeg;
1872  }
1873  pLexOrder = b;
1874  HCord=strat->HCord;
1875  if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
1876  lists l=(lists)Alloc(sizeof(slists));
1877  l->Init(2);
1878  l->m[0].rtyp=IDEAL_CMD;
1879  l->m[0].data=(void *)r;
1880  l->m[1].rtyp=IDEAL_CMD;
1881  if (strat->M==NULL)
1882  {
1883    l->m[1].data=(void *)idInit(1,F->rank);
1884    Warn("no minimal generating set computed");
1885  } 
1886  else
1887  {
1888    idSkipZeroes(strat->M);
1889    l->m[1].data=(void *)strat->M;
1890  }
1891  Free((ADDRESS)strat,sizeof(skStrategy));
1892  if (reduced>2)
1893  { 
1894    Kstd1_deg=Kstd1_OldDeg;
1895    if (!oldDegBound)
1896      test &= ~Sy_bit(OPT_DEGBOUND);
1897  }
1898  return l;
1899}
1900
1901poly kNF(ideal F, ideal Q, poly p,int syzComp, int lazyReduce)
1902{
1903  if (p==NULL)
1904     return NULL;
1905  kStrategy strat=(kStrategy)Alloc0(sizeof(skStrategy));
1906  strat->syzComp = syzComp;
1907  spSet(currRing);
1908  if (pOrdSgn==-1)
1909    p=kNF1(F,Q,p,strat,lazyReduce);
1910  else
1911    p=kNF2(F,Q,p,strat,lazyReduce);
1912  Free((ADDRESS)strat,sizeof(skStrategy));
1913  return p;
1914}
1915
1916ideal kNF(ideal F, ideal Q, ideal p,int syzComp,int lazyReduce)
1917{
1918  ideal res;
1919  spSet(currRing);
1920  if (TEST_OPT_PROT)
1921  {
1922    Print("(S:%d)",IDELEMS(p));mflush();
1923  }
1924  kStrategy strat=(kStrategy)Alloc0(sizeof(skStrategy));
1925  strat->syzComp = syzComp;
1926  if (pOrdSgn==-1)
1927    res=kNF1(F,Q,p,strat,lazyReduce);
1928  else
1929    res=kNF2(F,Q,p,strat,lazyReduce);
1930  if (TEST_OPT_PROT)
1931  {
1932    PrintLn();
1933  }
1934  Free((ADDRESS)strat,sizeof(skStrategy));
1935  return res;
1936}
1937
1938/*2
1939*interreduces F
1940*/
1941ideal kInterRed (ideal F, ideal Q)
1942{
1943  int j;
1944  kStrategy strat = (kStrategy)Alloc0(sizeof(skStrategy));
1945
1946//  if (TEST_OPT_PROT)
1947//  {
1948//    writeTime("start InterRed:");
1949//    mflush();
1950//  }
1951  //strat->syzComp     = 0;
1952  strat->kHEdgeFound = ppNoether != NULL;
1953  strat->kNoether=pCopy(ppNoether);
1954  strat->ak = idRankFreeModule(F);
1955  spSet(currRing);
1956  initBuchMoraCrit(strat);
1957  strat->NotUsedAxis = (BOOLEAN *)Alloc((pVariables+1)*sizeof(BOOLEAN));
1958  for (j=1; j<=pVariables; j++) strat->NotUsedAxis[j] = TRUE;
1959  strat->enterS      = enterSBba;
1960  strat->posInT      = posInT0;
1961  strat->initEcart   = initEcartNormal;
1962  strat->sl   = -1;
1963  strat->tl          = -1;
1964  strat->tmax        = setmax;
1965  strat->T           = initT();
1966  if (pOrdSgn == -1)   strat->honey = TRUE;
1967  initS(F,Q,strat);
1968  updateS(TRUE,strat);
1969  if (TEST_OPT_REDSB && TEST_OPT_INTSTRATEGY)
1970    completeReduce(strat);
1971  pDelete(&strat->kHEdge);
1972  Free((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
1973  Free((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
1974  Free((ADDRESS)strat->NotUsedAxis,(pVariables+1)*sizeof(BOOLEAN));
1975  if (strat->fromQ)
1976  {
1977    for (j=0;j<IDELEMS(strat->Shdl);j++)
1978    {
1979      if(strat->fromQ[j]) pDelete(&strat->Shdl->m[j]);
1980    }
1981    Free((ADDRESS)strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
1982    strat->fromQ=NULL;
1983    idSkipZeroes(strat->Shdl);
1984  }
1985//  if (TEST_OPT_PROT)
1986//  {
1987//    writeTime("end Interred:");
1988//    mflush();
1989//  }
1990  ideal shdl=strat->Shdl;
1991  Free((ADDRESS)strat,sizeof(skStrategy));
1992  return shdl;
1993}
Note: See TracBrowser for help on using the repository browser.