source: git/Singular/kstd1.cc @ 416465

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