source: git/Singular/kstd1.cc @ dd01bf0

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