source: git/kernel/gr_kstd2.cc @ a9c298

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