source: git/kernel/gr_kstd2.cc @ 4debf02

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