source: git/kernel/gr_kstd2.cc @ b7cfaf

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