source: git/Singular/kstd2.cc @ 512a2b

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