source: git/kernel/gr_kstd2.cc @ 54be36

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