source: git/Singular/kstd2.cc @ 7d423e

spielwiese
Last change on this file since 7d423e was 7d423e, checked in by Olaf Bachmann <obachman@…>, 25 years ago
walk git-svn-id: file:///usr/local/Singular/svn/trunk@3681 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 25.0 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kstd2.cc,v 1.29 1999-09-27 14:58:09 obachman Exp $ */
5/*
6*  ABSTRACT -  Kernel: alg. of Buchberger
7*/
8
9#include "mod2.h"
10#include "tok.h"
11#include "mmemory.h"
12#include "polys.h"
13#include "ideals.h"
14#include "febase.h"
15#include "kutil.h"
16#include "kstd1.h"
17#include "kstd2.h"
18#include "khstd.h"
19#include "spolys.h"
20#include "cntrlc.h"
21#include "weight.h"
22#include "ipid.h"
23#include "ipshell.h"
24#include "intvec.h"
25#include "spSpolyLoop.h"
26#include "kbPolyProcs.h"
27
28// #include "timer.h"
29
30/*2
31* consider the part above syzComp:
32* (assume the polynomial comes from a syz computation)
33* - it is a constant term: return a copy of it
34* - else: return NULL
35*/
36static poly kFromInput(poly p,kStrategy strat)
37{
38  poly q=p;
39
40  if (pGetComp(q)>strat->syzComp) return NULL;
41  while ((q!=NULL) && (pGetComp(q)<=strat->syzComp)) pIter(q);
42  if (pIsConstantComp(q))
43    return pHead(q);
44  return NULL;
45}
46
47/*2
48*  reduction procedure for the syz
49*  and TEST_OPT_MINRES: special minimizing during computations
50*  assumes homogeneous case and degree-ordering
51*/
52static void redSyz (LObject* h,kStrategy strat)
53{
54  int j = 0,i=0,pos;
55  BOOLEAN exchanged=pDivisibleBy((*h).p2,(*h).p1);
56  poly p,q;
57
58  if (exchanged)
59  {
60    q = kFromInput((*h).p1,strat);
61    if (q==NULL)
62    {
63      exchanged = FALSE;
64    }
65    else
66    {
67      while (i<=strat->Ll)
68      {
69        if ((strat->L[i].p1==strat->P.p1) || (strat->L[i].p2==strat->P.p1))
70        {
71          deleteInL(strat->L,&strat->Ll,i,strat);
72        }
73        else
74          i++;
75      }
76      i = 0;
77    }
78  }
79  if (TEST_OPT_DEBUG)
80  {
81    PrintS("red:");
82    wrp(h->p);
83  }
84  loop
85  {
86    if (pDivisibleBy(strat->S[j],(*h).p))
87    {
88      if ((!exchanged) && (pEqual((*h).p,strat->S[j])))
89      {
90        q = kFromInput(strat->S[j],strat);
91        if (q!=NULL)
92        {
93          exchanged = TRUE;
94          p = strat->S[j];
95          if (!TEST_OPT_INTSTRATEGY)
96            pNorm((*h).p);
97          else
98          {
99            //pContent((*h).p);
100            pCleardenom((*h).p);// also does a pContent
101          }
102          strat->S[j] = (*h).p;
103          (*h).p = p;
104          while ((i<=strat->tl) && (strat->T[i].p!=p)) i++;
105          if (i<=strat->tl) strat->T[i].p = strat->S[j];
106          for (i=0;i<=strat->Ll;i++)
107          {
108            if (strat->L[i].p1==p) strat->L[i].p1=strat->S[j];
109            if (strat->L[i].p2==p) strat->L[i].p2=strat->S[j];
110          }
111        }
112      }
113      //if (strat->interpt) test_int_std(strat->kIdeal);
114      /*- compute the s-polynomial -*/
115      if (TEST_OPT_DEBUG)
116      {
117        PrintS(" with ");
118        wrp(strat->S[j]);
119      }
120      (*h).p = spSpolyRed(strat->S[j],(*h).p,strat->kNoether,
121                          strat->spSpolyLoop);
122      if (TEST_OPT_DEBUG)
123      {
124        PrintS("\nto "); wrp((*h).p);PrintLn();
125      }
126      if ((*h).p == NULL)
127      {
128        if (h->lcm!=NULL) pFree1((*h).lcm);
129#ifdef KDEBUG
130        (*h).lcm=NULL;
131#endif
132        return;
133      }
134/*- try to reduce the s-polynomial -*/
135      j = 0;
136    }
137    else
138    {
139      if (j >= strat->sl)
140      {
141        if (exchanged)
142        {
143          if (pGetComp((*h).p) > strat->syzComp)
144          {
145            pDelete(&((*h).p));
146            return;
147          }
148          else
149          {
150            if (!TEST_OPT_INTSTRATEGY)
151            {
152              pos = posInS(strat->S,strat->sl,(*h).p);
153              pNorm((*h).p);
154              (*h).p = redtailSyz((*h).p,pos-1,strat);
155            }
156            p = (*h).p;
157            while ((pNext(p)!=NULL) && (pGetComp(pNext(p))<=strat->syzComp))
158               pIter(p);
159            pDelete(&pNext(p));
160            pNext(p) = q;
161          }
162        }
163        else if (!TEST_OPT_INTSTRATEGY)
164        {
165          pos = posInS(strat->S,strat->sl,(*h).p);
166          pNorm((*h).p);
167          (*h).p = redtailSyz((*h).p,pos-1,strat);
168        }
169        enterTBba((*h),strat->tl+1,strat);
170        return;
171      }
172      j++;
173    }
174  }
175}
176
177/*2
178*  reduction procedure for the homogeneous case
179*  and the case of a degree-ordering
180*/
181static void redHomog (LObject* h,kStrategy strat)
182{
183  if (strat->tl<0)
184  {
185    if (TEST_OPT_INTSTRATEGY) pCleardenom(h->p);
186    enterTBba((*h),0,strat);
187    return;
188  }
189#ifdef KDEBUG
190  if (TEST_OPT_DEBUG)
191  {
192    PrintS("red:");
193    wrp(h->p);
194    PrintS(" ");
195  }
196#endif
197  int j;
198  while (1)
199  {
200    j = 0;
201    K_INIT_SHORT_EVECTOR(h->p);
202    while ( j <= strat->tl)
203    {
204      if (K_DIVISIBLE_BY(strat->T[j], h->p)) break;
205      j++;
206    }
207   
208    if (j > strat->tl)
209    {
210      if (TEST_OPT_INTSTRATEGY)
211      {
212        pCleardenom(h->p);
213        enterTBba((*h), strat->posInT(strat->T,strat->tl,(*h)), strat);
214      }
215      else
216        enterTBba((*h),strat->tl+1,strat);
217      return;
218    }
219
220    // now we found one which is divisible
221    kbReducePoly(h, &(strat->T[j]),
222                 strat->kNoether);
223#ifdef KDEBUG
224    if (TEST_OPT_DEBUG)
225    {
226      PrintS("\nto ");
227      wrp(h->p);
228      PrintLn();
229    }
230#endif
231    if (h->p == NULL)
232    {
233      if (h->lcm!=NULL) pFree1((*h).lcm);
234#ifdef KDEBUG
235      (*h).lcm=NULL;
236#endif
237      return;
238    }
239  }
240}
241
242
243/*2
244*  reduction procedure for the inhomogeneous case
245*  and not a degree-ordering
246*/
247static void redLazy (LObject* h,kStrategy strat)
248{
249  if (strat->tl<0)
250  {
251    enterTBba((*h),0,strat);
252    return;
253  }
254
255  int at,d,i;
256  int j = 0;
257  int pass = 0;
258  int reddeg = pFDeg((*h).p);
259
260  while (1)
261  {
262    j = 0;
263    while (j <= strat->tl)
264    {
265      if (pDivisibleBy1(strat->T[j].p,(*h).p)) break;
266      j++;
267    }
268   
269    if (j>strat->tl)
270    {
271      if (TEST_OPT_INTSTRATEGY)
272      {
273        pCleardenom(h->p);// also does a pContent
274      }
275      enterTBba((*h),strat->tl+1,strat);
276      return;
277    }
278
279    if (TEST_OPT_DEBUG)
280    {
281      PrintS("red:");
282      wrp(h->p);
283      PrintS(" with ");
284      wrp(strat->T[j].p);
285    }
286    kbReducePoly(h, &(strat->T[j]), strat->kNoether);
287    if (TEST_OPT_DEBUG)
288    {
289      PrintS("\nto ");
290      wrp(h->p);
291      PrintLn();
292    }
293    if ((*h).p == NULL)
294    {
295      if (h->lcm!=NULL) pFree1((*h).lcm);
296#ifdef KDEBUG
297      (*h).lcm=NULL;
298#endif
299      return;
300    }
301    /*- try to reduce the s-polynomial -*/
302    pass++;
303    d = pFDeg((*h).p);
304    if ((strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
305    {
306      at = posInL11(strat->L,strat->Ll,*h,strat);
307      if (at <= strat->Ll)
308      {
309        i=strat->sl+1;
310        do
311        {
312          i--;
313          if (i<0)
314          {
315            enterTBba((*h),strat->tl+1,strat);
316            return;
317          }
318        }
319        while (!pDivisibleBy1(strat->S[i],(*h).p));
320        if (TEST_OPT_DEBUG) Print(" ->L[%d]\n",at);
321        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
322        (*h).p = NULL;
323        return;
324      }
325    }
326    else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d != reddeg))
327    {
328      Print(".%d",d);mflush();
329      reddeg = d;
330    }
331  }
332}
333
334/*2
335*  reduction procedure for the sugar-strategy (honey)
336* reduces h with elements from T choosing first possible
337* element in T with respect to the given ecart
338*/
339static void redHoney (LObject*  h,kStrategy strat)
340{
341  if (strat->tl<0)
342  {
343    enterTBba((*h),0,strat);
344    return;
345  }
346
347  poly pi;
348  int i,j,at,reddeg,d,pass,ei, ii;
349
350  pass = j = 0;
351  d = reddeg = pFDeg((*h).p)+(*h).ecart;
352  while(1)
353  {
354    j = 0;
355    K_INIT_SHORT_EVECTOR(h->p);
356    while (j<= strat->tl)
357    {
358      if (K_DIVISIBLE_BY(strat->T[j], h->p)) break;
359      j++;
360    }
361   
362    if (j > strat->tl)
363    {
364      if (TEST_OPT_INTSTRATEGY)
365      {
366        pCleardenom(h->p);// also does a pContent
367      }
368      at=strat->posInT(strat->T,strat->tl,(*h));
369      enterTBba((*h),at,strat);
370      return;
371    }
372   
373    pi = strat->T[j].p;
374    ei = strat->T[j].ecart;
375    ii = j;
376    /*
377     * the polynomial to reduce with (up to the moment) is;
378     * pi with ecart ei
379     */
380    i = j;
381    while(1)
382    {
383      /*- takes the first possible with respect to ecart -*/
384      i++;
385      if (i > strat->tl)
386        break;
387      if ((!BTEST1(20)) && (ei <= (*h).ecart))
388        break;
389      if ((strat->T[i].ecart < ei) && pDivisibleBy(strat->T[i].p,(*h).p))
390      {
391        /*
392         * the polynomial to reduce with is now;
393         */
394        pi = strat->T[i].p;
395        ei = strat->T[i].ecart;
396        ii = i;
397      }
398    }
399
400    /*
401     * end of search: have to reduce with pi
402     */
403    if ((pass!=0) && (ei > (*h).ecart))
404    {
405      /*
406       * It is not possible to reduce h with smaller ecart;
407       * if possible h goes to the lazy-set L,i.e
408       * if its position in L would be not the last one
409       */
410      if (strat->Ll >= 0) /* L is not empty */
411      {
412        at = strat->posInL(strat->L,strat->Ll,*h,strat);
413        if(at <= strat->Ll)
414          /*- h will not become the next element to reduce -*/
415        {
416          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
417          if (TEST_OPT_DEBUG) Print(" ecart too big: -> L%d\n",at);
418          (*h).p = NULL;
419          return;
420        }
421      }
422      if (TEST_OPT_MOREPAIRS)
423      {
424        /*put the polynomial also in the pair set*/
425        strat->fromT = TRUE;
426        if (!TEST_OPT_INTSTRATEGY) pNorm((*h).p);
427        enterpairs((*h).p,strat->sl,(*h).ecart,0,strat);
428      }
429    }
430    if (TEST_OPT_DEBUG)
431    {
432      PrintS("red:");
433      wrp(h->p);
434      PrintS(" with ");
435      wrp(pi);
436    }
437    if (strat->fromT)
438    {
439      strat->fromT=FALSE;
440      h->p = pCopy(h->p);
441    }
442    kbReducePoly(h, &(strat->T[ii]), strat->kNoether);
443    if (TEST_OPT_DEBUG)
444    {
445      PrintS("\nto ");
446      wrp(h->p);
447      PrintLn();
448    }
449    if ((*h).p == NULL)
450    {
451      if (h->lcm!=NULL) pFree1((*h).lcm);
452#ifdef KDEBUG
453      (*h).lcm=NULL;
454#endif
455      return;
456    }
457    /* compute the ecart */
458    if (ei <= (*h).ecart)
459      (*h).ecart = d-pFDeg((*h).p);
460    else
461      (*h).ecart = d-pFDeg((*h).p)+ei-(*h).ecart;
462    /*
463     * try to reduce the s-polynomial h
464     *test first whether h should go to the lazyset L
465     *-if the degree jumps
466     *-if the number of pre-defined reductions jumps
467     */
468    pass++;
469    d = pFDeg((*h).p)+(*h).ecart;
470    if ((strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
471    {
472      at = strat->posInL(strat->L,strat->Ll,*h,strat);
473      if (at <= strat->Ll)
474      {
475        /*test if h is already standardbasis element*/
476        i=strat->sl+1;
477        do
478        {
479          i--;
480          if (i<0)
481          {
482            at=strat->posInT(strat->T,strat->tl,(*h));
483            enterTBba((*h),at,strat);
484            return;
485          }
486        } while (!pDivisibleBy(strat->S[i],(*h).p));
487        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
488        if (TEST_OPT_DEBUG)
489          Print(" degree jumped: -> L%d\n",at);
490        (*h).p = NULL;
491        return;
492      }
493    }
494    else if (TEST_OPT_PROT && (strat->Ll < 0) && (d > reddeg))
495    {
496      reddeg = d;
497      Print(".%d",d); mflush();
498    }
499  }
500}
501
502/*2
503*  reduction procedure for tests only
504*  reduces with elements from T and chooses the best possible
505*/
506static void redBest (LObject*  h,kStrategy strat)
507{
508  if (strat->tl<0)
509  {
510    enterTBba((*h),0,strat);
511    return;
512  }
513
514  int j,jbest,at,reddeg,d,pass;
515  poly     p,ph;
516  pass = j = 0;
517
518  if (strat->honey)
519    reddeg = pFDeg((*h).p)+(*h).ecart;
520  else
521    reddeg = pFDeg((*h).p);
522  loop
523  {
524    if (pDivisibleBy(strat->T[j].p,(*h).p))
525    {
526      //if (strat->interpt) test_int_std(strat->kIdeal);
527      /* compute the s-polynomial */
528      if (!TEST_OPT_INTSTRATEGY) pNorm((*h).p);
529      p = spSpolyShortBba(strat->T[j].p,(*h).p);
530      /* computes only the first monomial of the spoly  */
531      if (p)
532      {
533        jbest = j;
534        /* looking for the best possible reduction */
535        if ((strat->syzComp==0) || (pMinComp(p) <= strat->syzComp))
536        {
537          loop
538          {
539            j++;
540            if (j > strat->tl)
541              break;
542            if (pDivisibleBy(strat->T[j].p,(*h).p))
543            {
544              ph = spSpolyShortBba(strat->T[j].p,(*h).p);
545              if (ph==NULL)
546              {
547                pFree1(p);
548                pDelete(&((*h).p));
549                if (h->lcm!=NULL) pFree1((*h).lcm);
550#ifdef KDEBUG
551                (*h).lcm=NULL;
552#endif
553                return;
554              }
555              else if (pComp0(ph,p) == -1)
556              {
557                pFree1(p);
558                p = ph;
559                jbest = j;
560              }
561              else
562              {
563                pFree1(ph);
564              }
565            }
566          }
567        }
568        pFree1(p);
569        (*h).p = spSpolyRed(strat->T[jbest].p,(*h).p,strat->kNoether,
570                            strat->spSpolyLoop);
571      }
572      else
573      {
574        if (h->lcm!=NULL) pFree1((*h).lcm);
575#ifdef KDEBUG
576        (*h).lcm=NULL;
577#endif
578        (*h).p = NULL;
579        return;
580      }
581      if (strat->honey && pLexOrder)
582        strat->initEcart(h);
583      if (strat->honey || pLexOrder)
584      {
585        pass++;
586        d = pFDeg((*h).p);
587        if (strat->honey)
588          d += (*h).ecart;
589        if ((strat->Ll >= 0) && ((pass > strat->LazyPass) || (d > reddeg)))
590        {
591          at = strat->posInL(strat->L,strat->Ll,*h,strat);
592          if (at <= strat->Ll)
593          {
594            enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
595            (*h).p = NULL;
596            return;
597          }
598        }
599        else if (TEST_OPT_PROT && (strat->Ll < 0) && (d != reddeg))
600        {
601          reddeg = d;
602          Print("%d.");
603          mflush();
604        }
605      }
606      j = 0;
607    }
608    else
609    {
610      if (j >= strat->tl)
611      {
612        if (TEST_OPT_INTSTRATEGY)
613        {
614          pCleardenom(h->p);// also does a pContent
615        }
616        at=strat->posInT(strat->T,strat->tl,(*h));
617        enterTBba((*h),at,strat);
618        return;
619      }
620      j++;
621    }
622  }
623}
624
625/*2
626*  reduction procedure for the normal form
627*/
628
629static poly redNF (poly h,kStrategy strat)
630{
631  int j = 0;
632  int z = 3;
633
634  if (0 > strat->sl)
635  {
636    return h;
637  }
638  loop
639  {
640    if (pDivisibleBy1(strat->S[j],h))
641    {
642      //if (strat->interpt) test_int_std(strat->kIdeal);
643      /*- compute the s-polynomial -*/
644      if (TEST_OPT_DEBUG)
645      {
646        PrintS("red:");
647        wrp(h);
648        PrintS(" with ");
649        wrp(strat->S[j]);
650      }
651      h = spSpolyRed(strat->S[j],h,strat->kNoether, strat->spSpolyLoop);
652      if (TEST_OPT_DEBUG)
653      {
654        PrintS("\nto:");
655        wrp(h);
656        PrintLn();
657      }
658      if (h == NULL) return NULL;
659      z++;
660      if (z>=10)
661      {
662        z=0;
663        pNormalize(h);
664      }
665      /*- try to reduce the s-polynomial -*/
666      j = 0;
667    }
668    else
669    {
670      if (j >= strat->sl) return h;
671      j++;
672    }
673  }
674}
675
676void initBba(ideal F,kStrategy strat)
677{
678  int i;
679  idhdl h;
680 /* setting global variables ------------------- */
681  strat->enterS = enterSBba;
682  if ((BTEST1(20)) && (!strat->honey))
683    strat->red = redBest;
684  else if (strat->honey)
685    strat->red = redHoney;
686  else if (pLexOrder && !strat->homog)
687    strat->red = redLazy;
688  else
689    strat->red = redHomog;
690  if (TEST_OPT_MINRES && strat->homog && (strat->syzComp >0))
691    strat->red = redSyz;
692
693  if (pLexOrder && strat->honey)
694    strat->initEcart = initEcartNormal;
695  else
696    strat->initEcart = initEcartBBA;
697  if (strat->honey)
698    strat->initEcartPair = initEcartPairMora;
699  else
700    strat->initEcartPair = initEcartPairBba;
701  strat->kIdeal = NULL;
702  //if (strat->ak==0) strat->kIdeal->rtyp=IDEAL_CMD;
703  //else              strat->kIdeal->rtyp=MODUL_CMD;
704  //strat->kIdeal->data=(void *)strat->Shdl;
705  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
706  {
707    //interred  machen   Aenderung
708    pFDegOld=pFDeg;
709    pLDegOld=pLDeg;
710    h=ggetid("ecart");
711    if ((h!=NULL) && (IDTYP(h)==INTVEC_CMD))
712    {
713      ecartWeights=iv2array(IDINTVEC(h));
714    }
715    else
716    {
717      ecartWeights=(short *)Alloc((pVariables+1)*sizeof(short));
718      /*uses automatic computation of the ecartWeights to set them*/
719      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
720    }
721    pFDeg=totaldegreeWecart;
722    pLDeg=maxdegreeWecart;
723    for(i=1; i<=pVariables; i++)
724      Print(" %d",ecartWeights[i]);
725    PrintLn();
726    mflush();
727  }
728}
729
730
731ideal bba (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
732{
733  int   srmax,lrmax;
734  int   olddeg,reduc;
735  int hilbeledeg=1,hilbcount=0,minimcnt=0;
736
737  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
738  initHilbCrit(F,Q,&hilb,strat);
739  initBba(F,strat);
740  initBuchMoraPos(strat);
741  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
742  /*Shdl=*/initBuchMora(F, Q,strat);
743  if (strat->minim>0)
744  {
745    strat->M=idInit(IDELEMS(F),F->rank);
746  }
747  srmax = strat->sl;
748  reduc = olddeg = lrmax = 0;
749  /* compute------------------------------------------------------- */
750  while (strat->Ll >= 0)
751  {
752    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
753    if (TEST_OPT_DEBUG) messageSets(strat);
754    //test_int_std(strat->kIdeal);
755    if (strat->Ll== 0) strat->interpt=TRUE;
756    if (TEST_OPT_DEGBOUND
757    && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p)>Kstd1_deg))
758       || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p)>Kstd1_deg))))
759    {
760      /*
761      *stops computation if
762      * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
763      *a predefined number Kstd1_deg
764      */
765      while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
766      break;
767    }
768    /* picks the last element from the lazyset L */
769    strat->P = strat->L[strat->Ll];
770    strat->Ll--;
771    kTest_TS(strat);
772    if (pNext(strat->P.p) == strat->tail)
773    {
774      /* deletes the short spoly and computes */
775      pFree1(strat->P.p);
776      /* the real one */
777      kbCreateSpoly(&(strat->P),
778                    strat->kNoether);
779    }
780    if((strat->P.p1==NULL) && (strat->minim>0))
781      strat->P.p2=pCopy(strat->P.p);
782    {
783      if (strat->honey)
784      {
785        if (TEST_OPT_PROT) message(strat->P.ecart+pFDeg(strat->P.p),&olddeg,&reduc,strat);
786      }
787      else
788      {
789        if (TEST_OPT_PROT) message(pFDeg(strat->P.p),&olddeg,&reduc,strat);
790      }
791      /* reduction of the element choosen from L */
792      strat->red(&strat->P,strat);
793      pTest(strat->P.p);
794    }
795    kTest_TS(strat);
796    if (strat->P.p != NULL)
797    {
798          /* statistic */
799          if (TEST_OPT_PROT) PrintS("s");
800          /* enter P.p into s and L */
801          {
802            int pos=posInS(strat->S,strat->sl,strat->P.p);
803            {
804              if (TEST_OPT_INTSTRATEGY)
805              {
806                if ((!TEST_OPT_MINRES)||(strat->syzComp==0)||(!strat->homog))
807                {
808                  strat->P.p = redtailBba(strat->P.p,pos-1,strat);
809                  //if (strat->redTailChange)
810                    pCleardenom(strat->P.p);
811                }
812              }
813              else
814              {
815                pNorm(strat->P.p);
816                if ((!TEST_OPT_MINRES)||(strat->syzComp==0)||(!strat->homog))
817                {
818                  strat->P.p = redtailBba(strat->P.p,pos-1,strat);
819                }
820              }
821              if (TEST_OPT_DEBUG)
822              {
823                PrintS("new s:");
824                wrp(strat->P.p);
825                PrintLn();
826              }
827              if((strat->P.p1==NULL) && (strat->minim>0))
828              {
829                if (strat->minim==1)
830                {
831                  strat->M->m[minimcnt]=pCopy(strat->P.p);
832                  pDelete(&strat->P.p2);
833                }
834                else
835                {
836                  strat->M->m[minimcnt]=strat->P.p2;
837                  strat->P.p2=NULL;
838                }
839                minimcnt++;
840              }
841              enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat);
842              if (strat->sl==-1) pos=0;
843              else pos=posInS(strat->S,strat->sl,strat->P.p);
844              strat->enterS(strat->P,pos,strat);
845            }
846            if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
847          }
848          if (strat->P.lcm!=NULL) pFree1(strat->P.lcm);
849      if (strat->sl>srmax) srmax = strat->sl;
850    }
851#ifdef KDEBUG
852    strat->P.lcm=NULL;
853#endif
854    kTest_TS(strat);
855  }
856  if (TEST_OPT_DEBUG) messageSets(strat);
857  /* complete reduction of the standard basis--------- */
858  if (TEST_OPT_REDSB) completeReduce(strat);
859  /* release temp data-------------------------------- */
860  exitBuchMora(strat);
861  if (TEST_OPT_WEIGHTM)
862  {
863    pFDeg=pFDegOld;
864    pLDeg=pLDegOld;
865    if (ecartWeights)
866    {
867      Free((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
868      ecartWeights=NULL;
869    }
870  }
871  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
872  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
873  return (strat->Shdl);
874}
875
876poly kNF2 (ideal F,ideal Q,poly q,kStrategy strat, int lazyReduce)
877{
878  poly   p;
879  int   i;
880
881  if ((idIs0(F))&&(Q==NULL))
882    return pCopy(q); /*F=0*/
883  strat->ak = idRankFreeModule(F);
884  /*- creating temp data structures------------------- -*/
885  BITSET save_test=test;
886  test|=Sy_bit(OPT_REDTAIL);
887  initBuchMoraCrit(strat);
888  strat->initEcart = initEcartBBA;
889  strat->enterS = enterSBba;
890  /*- set S -*/
891  strat->sl = -1;
892  strat->spSpolyLoop = spGetSpolyLoop(currRing, max(strat->ak, pMaxComp(q)),
893                                      strat->syzComp, FALSE);
894  /*- init local data struct.---------------------------------------- -*/
895  /*Shdl=*/initS(F,Q,strat);
896  /*- compute------------------------------------------------------- -*/
897  if ((TEST_OPT_INTSTRATEGY)&&(lazyReduce==0))
898  {
899    for (i=strat->sl;i>=0;i--)
900      pNorm(strat->S[i]);
901  }
902  kTest(strat);
903  if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
904  p = redNF(pCopy(q),strat);
905  if ((p!=NULL)&&(lazyReduce==0))
906  {
907    if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
908    p = redtailBba(p,strat->sl,strat);
909  }
910  /*- release temp data------------------------------- -*/
911  Free((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
912  idDelete(&strat->Shdl);
913  test=save_test;
914  if (TEST_OPT_PROT) PrintLn();
915  return p;
916}
917
918ideal kNF2 (ideal F,ideal Q,ideal q,kStrategy strat, int lazyReduce)
919{
920  poly   p;
921  int   i;
922  ideal res;
923
924  if (idIs0(q))
925    return idInit(1,q->rank);
926  if ((idIs0(F))&&(Q==NULL))
927    return idCopy(q); /*F=0*/
928  strat->ak = idRankFreeModule(F);
929  /*- creating temp data structures------------------- -*/
930  BITSET save_test=test;
931  test|=Sy_bit(OPT_REDTAIL);
932  initBuchMoraCrit(strat);
933  strat->initEcart = initEcartBBA;
934  strat->enterS = enterSBba;
935  /*- set S -*/
936  strat->sl = -1;
937  strat->spSpolyLoop =  spGetSpolyLoop(currRing,
938                                       max(strat->ak, idRankFreeModule(q)),
939                                       strat->syzComp, FALSE);
940  /*- init local data struct.---------------------------------------- -*/
941  /*Shdl=*/initS(F,Q,strat);
942  /*- compute------------------------------------------------------- -*/
943  res=idInit(IDELEMS(q),q->rank);
944  if ((TEST_OPT_INTSTRATEGY)&&(lazyReduce==0))
945  {
946    for (i=strat->sl;i>=0;i--)
947      pNorm(strat->S[i]);
948  }
949  for (i=IDELEMS(q)-1; i>=0; i--)
950  {
951    if (q->m[i]!=NULL)
952    {
953      if (TEST_OPT_PROT) { PrintS("r");mflush(); }
954      p = redNF(pCopy(q->m[i]),strat);
955      if ((p!=NULL)&&(lazyReduce==0))
956      {
957        if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
958        p = redtailBba(p,strat->sl,strat);
959      }
960      res->m[i]=p;
961    }
962    //else
963    //  res->m[i]=NULL;
964  }
965  /*- release temp data------------------------------- -*/
966  Free((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
967  idDelete(&strat->Shdl);
968  test=save_test;
969  if (TEST_OPT_PROT) PrintLn();
970  return res;
971}
972
973static ideal bbared (ideal F, ideal Q,kStrategy strat)
974{
975
976  /* complete reduction of the standard basis--------- */
977  completeReduce(strat);
978  /* release temp data-------------------------------- */
979  exitBuchMora(strat);
980  if (TEST_OPT_WEIGHTM)
981  {
982    pFDeg=pFDegOld;
983    pLDeg=pLDegOld;
984    if (ecartWeights)
985    {
986      Free((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
987      ecartWeights=NULL;
988    }
989  }
990  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
991  return (strat->Shdl);
992}
993
994ideal stdred(ideal F, ideal Q, tHomog h,intvec ** w)
995{
996  ideal r;
997  BOOLEAN b=pLexOrder,toReset=FALSE;
998  BOOLEAN delete_w=(w==NULL);
999  kStrategy strat=(kStrategy)Alloc0(sizeof(skStrategy));
1000
1001  if (rField_has_simple_inverse())
1002    strat->LazyPass=20;
1003  else
1004   strat->LazyPass=2;
1005  strat->LazyDegree = 1;
1006  strat->ak = idRankFreeModule(F);
1007  if ((h==testHomog))
1008  {
1009    if (strat->ak==0)
1010    {
1011      h = (tHomog)idHomIdeal(F,Q);
1012      w=NULL;
1013    }
1014    else
1015      h = (tHomog)idHomModule(F,Q,w);
1016  }
1017  if (h==isHomog)
1018  {
1019    if ((w!=NULL) && (*w!=NULL))
1020    {
1021      kModW = *w;
1022      strat->kModW = *w;
1023      pOldFDeg = pFDeg;
1024      pFDeg = kModDeg;
1025      toReset = TRUE;
1026    }
1027    pLexOrder = TRUE;
1028    strat->LazyPass*=2;
1029  }
1030  strat->homog=h;
1031  spSet(currRing);
1032  strat->spSpolyLoop = spGetSpolyLoop(currRing, strat);
1033  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1034  initBuchMoraPos(strat);
1035  if (pOrdSgn==1)
1036    initBba(F,strat);
1037  else
1038    initMora(F,strat);
1039  initBuchMora(F, Q,strat);
1040  //initS(F,Q,strat);
1041// Ende der Initalisierung
1042  r=bbared(F,Q,strat);
1043#ifdef KDEBUG
1044  int i;
1045  for (i=0; i<IDELEMS(r); i++) pTest(r->m[i]);
1046#endif
1047// Ende: aufraeumen
1048  if (toReset)
1049  {
1050    kModW = NULL;
1051    pFDeg = pOldFDeg;
1052  }
1053  pLexOrder = b;
1054  Free((ADDRESS)strat,sizeof(skStrategy));
1055  if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
1056  idSkipZeroes(r);
1057  return r;
1058}
Note: See TracBrowser for help on using the repository browser.