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

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