source: git/kernel/GBEngine/kspoly.cc @ 79d81e5

spielwiese
Last change on this file since 79d81e5 was 79d81e5, checked in by Hans Schoenemann <hannes@…>, 5 years ago
removed: unused variables/code
  • Property mode set to 100644
File size: 32.2 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5*  ABSTRACT -  Routines for Spoly creation and reductions
6*/
7
8// #define PDEBUG 2
9
10
11
12#include "kernel/mod2.h"
13#include "misc/options.h"
14#include "kernel/GBEngine/kutil.h"
15#include "coeffs/numbers.h"
16#include "polys/monomials/p_polys.h"
17#include "polys/templates/p_Procs.h"
18#include "polys/nc/nc.h"
19#ifdef HAVE_RINGS
20#include "kernel/polys.h"
21#endif
22
23#ifdef KDEBUG
24int red_count = 0;
25int create_count = 0;
26// define this if reductions are reported on TEST_OPT_DEBUG
27#define TEST_OPT_DEBUG_RED
28#endif
29
30/***************************************************************
31 *
32 * Reduces PR with PW
33 * Assumes PR != NULL, PW != NULL, Lm(PW) divides Lm(PR)
34 *
35 * returns 0: okay
36 *         1: tailRing changed
37 *         -1: cannot change tailRing
38 *         2: cannot change tailRing: strat==NULL
39 *
40 ***************************************************************/
41int ksReducePoly(LObject* PR,
42                 TObject* PW,
43                 poly spNoether,
44                 number *coef,
45                 kStrategy strat)
46{
47#ifdef KDEBUG
48  red_count++;
49#ifdef TEST_OPT_DEBUG_RED
50//  if (TEST_OPT_DEBUG)
51//  {
52//    Print("Red %d:", red_count); PR->wrp(); Print(" with:");
53//    PW->wrp();
54//    //printf("\necart(PR)-ecart(PW): %i\n",PR->ecart-PW->ecart);
55//    //pWrite(PR->p);
56//  }
57#endif
58#endif
59  int ret = 0;
60  ring tailRing = PR->tailRing;
61  kTest_L(PR);
62  kTest_T(PW);
63
64  poly p1 = PR->GetLmTailRing();   // p2 | p1
65  poly p2 = PW->GetLmTailRing();   // i.e. will reduce p1 with p2; lm = LT(p1) / LM(p2)
66  poly t2 = pNext(p2), lm = p1;    // t2 = p2 - LT(p2); really compute P = LC(p2)*p1 - LT(p1)/LM(p2)*p2
67  assume(p1 != NULL && p2 != NULL);// Attention, we have rings and there LC(p2) and LC(p1) are special
68  p_CheckPolyRing(p1, tailRing);
69  p_CheckPolyRing(p2, tailRing);
70
71  pAssume1(p2 != NULL && p1 != NULL &&
72           p_DivisibleBy(p2,  p1, tailRing));
73
74  pAssume1(p_GetComp(p1, tailRing) == p_GetComp(p2, tailRing) ||
75           (p_GetComp(p2, tailRing) == 0 &&
76            p_MaxComp(pNext(p2),tailRing) == 0));
77
78#ifdef HAVE_PLURAL
79  if (rIsPluralRing(currRing))
80  {
81    // for the time being: we know currRing==strat->tailRing
82    // no exp-bound checking needed
83    // (only needed if exp-bound(tailring)<exp-b(currRing))
84    if (PR->bucket!=NULL)  nc_kBucketPolyRed_Z(PR->bucket, p2,coef);
85    else
86    {
87      poly _p = (PR->t_p != NULL ? PR->t_p : PR->p);
88      assume(_p != NULL);
89      nc_PolyPolyRed(_p, p2,coef, currRing);
90      if (PR->t_p!=NULL) PR->t_p=_p; else PR->p=_p;
91      PR->pLength=0; // usually not used, GetpLength re-computes it if needed
92    }
93    return 0;
94  }
95#endif
96
97  if (t2==NULL)           // Divisor is just one term, therefore it will
98  {                       // just cancel the leading term
99    PR->LmDeleteAndIter();
100    if (coef != NULL) *coef = n_Init(1, tailRing->cf);
101    return 0;
102  }
103
104  p_ExpVectorSub(lm, p2, tailRing); // Calculate the Monomial we must multiply to p2
105
106  //if (tailRing != currRing)
107  {
108    // check that reduction does not violate exp bound
109    while (PW->max_exp != NULL && !p_LmExpVectorAddIsOk(lm, PW->max_exp, tailRing))
110    {
111      // undo changes of lm
112      p_ExpVectorAdd(lm, p2, tailRing);
113      if (strat == NULL) return 2;
114      if (! kStratChangeTailRing(strat, PR, PW)) return -1;
115      tailRing = strat->tailRing;
116      p1 = PR->GetLmTailRing();
117      p2 = PW->GetLmTailRing();
118      t2 = pNext(p2);
119      lm = p1;
120      p_ExpVectorSub(lm, p2, tailRing);
121      ret = 1;
122    }
123  }
124
125  // take care of coef buisness
126  if (! n_IsOne(pGetCoeff(p2), tailRing->cf))
127  {
128    number bn = pGetCoeff(lm);
129    number an = pGetCoeff(p2);
130    int ct = ksCheckCoeff(&an, &bn, tailRing->cf);    // Calculate special LC
131    p_SetCoeff(lm, bn, tailRing);
132    if ((ct == 0) || (ct == 2))
133      PR->Tail_Mult_nn(an);
134    if (coef != NULL) *coef = an;
135    else n_Delete(&an, tailRing->cf);
136  }
137  else
138  {
139    if (coef != NULL) *coef = n_Init(1, tailRing->cf);
140  }
141
142
143  // and finally,
144  PR->Tail_Minus_mm_Mult_qq(lm, t2, pLength(t2) /*PW->GetpLength() - 1*/, spNoether);
145  assume(PW->GetpLength() == pLength(PW->p != NULL ? PW->p : PW->t_p));
146  PR->LmDeleteAndIter();
147
148  // the following is commented out: shrinking
149#ifdef HAVE_SHIFTBBA_NONEXISTENT
150  if ( (currRing->isLPring) && (!strat->homog) )
151  {
152    // assume? h->p in currRing
153    PR->GetP();
154    poly qq = p_Shrink(PR->p, currRing->isLPring, currRing);
155    PR->Clear(); // does the right things
156    PR->p = qq;
157    PR->t_p = NULL;
158    PR->SetShortExpVector();
159  }
160#endif
161
162  return ret;
163}
164
165int ksReducePolyBound(LObject* PR,
166                 TObject* PW,
167                 int bound,
168                 poly spNoether,
169                 number *coef,
170                 kStrategy strat)
171{
172#ifdef KDEBUG
173  red_count++;
174#ifdef TEST_OPT_DEBUG_RED
175  if (TEST_OPT_DEBUG)
176  {
177    Print("Red %d:", red_count); PR->wrp(); Print(" with:");
178    PW->wrp();
179    //printf("\necart(PR)-ecart(PW): %i\n",PR->ecart-PW->ecart);
180    //pWrite(PR->p);
181  }
182#endif
183#endif
184  int ret = 0;
185  ring tailRing = PR->tailRing;
186  kTest_L(PR);
187  kTest_T(PW);
188
189  poly p1 = PR->GetLmTailRing();   // p2 | p1
190  poly p2 = PW->GetLmTailRing();   // i.e. will reduce p1 with p2; lm = LT(p1) / LM(p2)
191  poly t2 = pNext(p2), lm = p1;    // t2 = p2 - LT(p2); really compute P = LC(p2)*p1 - LT(p1)/LM(p2)*p2
192  assume(p1 != NULL && p2 != NULL);// Attention, we have rings and there LC(p2) and LC(p1) are special
193  p_CheckPolyRing(p1, tailRing);
194  p_CheckPolyRing(p2, tailRing);
195
196  pAssume1(p2 != NULL && p1 != NULL &&
197           p_DivisibleBy(p2,  p1, tailRing));
198
199  pAssume1(p_GetComp(p1, tailRing) == p_GetComp(p2, tailRing) ||
200           (p_GetComp(p2, tailRing) == 0 &&
201            p_MaxComp(pNext(p2),tailRing) == 0));
202
203#ifdef HAVE_PLURAL
204  if (rIsPluralRing(currRing))
205  {
206    // for the time being: we know currRing==strat->tailRing
207    // no exp-bound checking needed
208    // (only needed if exp-bound(tailring)<exp-b(currRing))
209    if (PR->bucket!=NULL)  nc_kBucketPolyRed_Z(PR->bucket, p2,coef);
210    else
211    {
212      poly _p = (PR->t_p != NULL ? PR->t_p : PR->p);
213      assume(_p != NULL);
214      nc_PolyPolyRed(_p, p2,coef, currRing);
215      if (PR->t_p!=NULL) PR->t_p=_p; else PR->p=_p;
216      PR->pLength=0; // usually not used, GetpLength re-computes it if needed
217    }
218    return 0;
219  }
220#endif
221
222  if (t2==NULL)           // Divisor is just one term, therefore it will
223  {                       // just cancel the leading term
224    PR->LmDeleteAndIter();
225    if (coef != NULL) *coef = n_Init(1, tailRing);
226    return 0;
227  }
228
229  p_ExpVectorSub(lm, p2, tailRing); // Calculate the Monomial we must multiply to p2
230
231  if (tailRing != currRing)
232  {
233    // check that reduction does not violate exp bound
234    while (PW->max_exp != NULL && !p_LmExpVectorAddIsOk(lm, PW->max_exp, tailRing))
235    {
236      // undo changes of lm
237      p_ExpVectorAdd(lm, p2, tailRing);
238      if (strat == NULL) return 2;
239      if (! kStratChangeTailRing(strat, PR, PW)) return -1;
240      tailRing = strat->tailRing;
241      p1 = PR->GetLmTailRing();
242      p2 = PW->GetLmTailRing();
243      t2 = pNext(p2);
244      lm = p1;
245      p_ExpVectorSub(lm, p2, tailRing);
246      ret = 1;
247    }
248  }
249
250  // take care of coef buisness
251  if (! n_IsOne(pGetCoeff(p2), tailRing))
252  {
253    number bn = pGetCoeff(lm);
254    number an = pGetCoeff(p2);
255    int ct = ksCheckCoeff(&an, &bn, tailRing->cf);    // Calculate special LC
256    p_SetCoeff(lm, bn, tailRing);
257    if ((ct == 0) || (ct == 2))
258      PR->Tail_Mult_nn(an);
259    if (coef != NULL) *coef = an;
260    else n_Delete(&an, tailRing);
261  }
262  else
263  {
264    if (coef != NULL) *coef = n_Init(1, tailRing);
265  }
266
267
268  // and finally,
269  PR->Tail_Minus_mm_Mult_qq(lm, t2, pLength(t2) /*PW->GetpLength() - 1*/, spNoether);
270  assume(PW->GetpLength() == pLength(PW->p != NULL ? PW->p : PW->t_p));
271  PR->LmDeleteAndIter();
272
273  // the following is commented out: shrinking
274#ifdef HAVE_SHIFTBBA_NONEXISTENT
275  if ( (currRing->isLPring) && (!strat->homog) )
276  {
277    // assume? h->p in currRing
278    PR->GetP();
279    poly qq = p_Shrink(PR->p, currRing->isLPring, currRing);
280    PR->Clear(); // does the right things
281    PR->p = qq;
282    PR->t_p = NULL;
283    PR->SetShortExpVector();
284  }
285#endif
286
287#if defined(KDEBUG) && defined(TEST_OPT_DEBUG_RED)
288  if (TEST_OPT_DEBUG)
289  {
290    Print(" to: "); PR->wrp(); Print("\n");
291    //printf("\nt^%i ", PR->ecart);pWrite(pHead(PR->p));
292  }
293#endif
294  return ret;
295}
296
297/***************************************************************
298 *
299 * Reduces PR with PW
300 * Assumes PR != NULL, PW != NULL, Lm(PW) divides Lm(PR)
301 *
302 ***************************************************************/
303
304int ksReducePolySig(LObject* PR,
305                 TObject* PW,
306                 long /*idx*/,
307                 poly spNoether,
308                 number *coef,
309                 kStrategy strat)
310{
311#ifdef KDEBUG
312  red_count++;
313#ifdef TEST_OPT_DEBUG_RED
314  if (TEST_OPT_DEBUG)
315  {
316    Print("Red %d:", red_count); PR->wrp(); Print(" with:");
317    PW->wrp();
318  }
319#endif
320#endif
321  int ret = 0;
322  ring tailRing = PR->tailRing;
323  kTest_L(PR);
324  kTest_T(PW);
325
326  // signature-based stuff:
327  // checking for sig-safeness first
328  // NOTE: This has to be done in the current ring
329  //
330  /**********************************************
331   *
332   * TODO:
333   * --------------------------------------------
334   * if strat->sbaOrder == 1
335   * Since we are subdividing lower index and
336   * current index reductions it is enough to
337   * look at the polynomial part of the signature
338   * for a check. This should speed-up checking
339   * a lot!
340   * if !strat->sbaOrder == 0
341   * We are not subdividing lower and current index
342   * due to the fact that we are using the induced
343   * Schreyer order
344   *
345   * nevertheless, this different behaviour is
346   * taken care of by is_sigsafe
347   * => one reduction procedure can be used for
348   * both, the incremental and the non-incremental
349   * attempt!
350   * --------------------------------------------
351   *
352   *********************************************/
353  //printf("COMPARE IDX: %ld -- %ld\n",idx,strat->currIdx);
354  if (!PW->is_sigsafe)
355  {
356    poly sigMult = pCopy(PW->sig);   // copy signature of reducer
357//#if 1
358#ifdef DEBUGF5
359    printf("IN KSREDUCEPOLYSIG: \n");
360    pWrite(pHead(f1));
361    pWrite(pHead(f2));
362    pWrite(sigMult);
363    printf("--------------\n");
364#endif
365    p_ExpVectorAddSub(sigMult,PR->GetLmCurrRing(),PW->GetLmCurrRing(),currRing);
366//#if 1
367#ifdef DEBUGF5
368    printf("------------------- IN KSREDUCEPOLYSIG: --------------------\n");
369    pWrite(pHead(f1));
370    pWrite(pHead(f2));
371    pWrite(sigMult);
372    pWrite(PR->sig);
373    printf("--------------\n");
374#endif
375    int sigSafe = p_LmCmp(PR->sig,sigMult,currRing);
376    // now we can delete the copied polynomial data used for checking for
377    // sig-safeness of the reduction step
378//#if 1
379#ifdef DEBUGF5
380    printf("%d -- %d sig\n",sigSafe,PW->is_sigsafe);
381
382#endif
383    //pDelete(&f1);
384    pDelete(&sigMult);
385    // go on with the computations only if the signature of p2 is greater than the
386    // signature of fm*p1
387    if(sigSafe != 1)
388    {
389      PR->is_redundant = TRUE;
390      return 3;
391    }
392    //PW->is_sigsafe  = TRUE;
393  }
394  PR->is_redundant = FALSE;
395  poly p1 = PR->GetLmTailRing();   // p2 | p1
396  poly p2 = PW->GetLmTailRing();   // i.e. will reduce p1 with p2; lm = LT(p1) / LM(p2)
397  poly t2 = pNext(p2), lm = p1;    // t2 = p2 - LT(p2); really compute P = LC(p2)*p1 - LT(p1)/LM(p2)*p2
398  assume(p1 != NULL && p2 != NULL);// Attention, we have rings and there LC(p2) and LC(p1) are special
399  p_CheckPolyRing(p1, tailRing);
400  p_CheckPolyRing(p2, tailRing);
401
402  pAssume1(p2 != NULL && p1 != NULL &&
403      p_DivisibleBy(p2,  p1, tailRing));
404
405  pAssume1(p_GetComp(p1, tailRing) == p_GetComp(p2, tailRing) ||
406      (p_GetComp(p2, tailRing) == 0 &&
407       p_MaxComp(pNext(p2),tailRing) == 0));
408
409#ifdef HAVE_PLURAL
410  if (rIsPluralRing(currRing))
411  {
412    // for the time being: we know currRing==strat->tailRing
413    // no exp-bound checking needed
414    // (only needed if exp-bound(tailring)<exp-b(currRing))
415    if (PR->bucket!=NULL)  nc_kBucketPolyRed_Z(PR->bucket, p2,coef);
416    else
417    {
418      poly _p = (PR->t_p != NULL ? PR->t_p : PR->p);
419      assume(_p != NULL);
420      nc_PolyPolyRed(_p, p2, coef, currRing);
421      if (PR->t_p!=NULL) PR->t_p=_p; else PR->p=_p;
422      PR->pLength=0; // usaully not used, GetpLength re-comoutes it if needed
423    }
424    return 0;
425  }
426#endif
427
428  if (t2==NULL)           // Divisor is just one term, therefore it will
429  {                       // just cancel the leading term
430    PR->LmDeleteAndIter();
431    if (coef != NULL) *coef = n_Init(1, tailRing->cf);
432    return 0;
433  }
434
435  p_ExpVectorSub(lm, p2, tailRing); // Calculate the Monomial we must multiply to p2
436
437  if (tailRing != currRing)
438  {
439    // check that reduction does not violate exp bound
440    while (PW->max_exp != NULL && !p_LmExpVectorAddIsOk(lm, PW->max_exp, tailRing))
441    {
442      // undo changes of lm
443      p_ExpVectorAdd(lm, p2, tailRing);
444      if (strat == NULL) return 2;
445      if (! kStratChangeTailRing(strat, PR, PW)) return -1;
446      tailRing = strat->tailRing;
447      p1 = PR->GetLmTailRing();
448      p2 = PW->GetLmTailRing();
449      t2 = pNext(p2);
450      lm = p1;
451      p_ExpVectorSub(lm, p2, tailRing);
452      ret = 1;
453    }
454  }
455
456  // take care of coef buisness
457  if (! n_IsOne(pGetCoeff(p2), tailRing->cf))
458  {
459    number bn = pGetCoeff(lm);
460    number an = pGetCoeff(p2);
461    int ct = ksCheckCoeff(&an, &bn, tailRing->cf);    // Calculate special LC
462    p_SetCoeff(lm, bn, tailRing);
463    if ((ct == 0) || (ct == 2))
464      PR->Tail_Mult_nn(an);
465    if (coef != NULL) *coef = an;
466    else n_Delete(&an, tailRing->cf);
467  }
468  else
469  {
470    if (coef != NULL) *coef = n_Init(1, tailRing->cf);
471  }
472
473
474  // and finally,
475  PR->Tail_Minus_mm_Mult_qq(lm, t2, PW->GetpLength() - 1, spNoether);
476  assume(PW->GetpLength() == pLength(PW->p != NULL ? PW->p : PW->t_p));
477  PR->LmDeleteAndIter();
478
479  // the following is commented out: shrinking
480#ifdef HAVE_SHIFTBBA_NONEXISTENT
481  if ( (currRing->isLPring) && (!strat->homog) )
482  {
483    // assume? h->p in currRing
484    PR->GetP();
485    poly qq = p_Shrink(PR->p, currRing->isLPring, currRing);
486    PR->Clear(); // does the right things
487    PR->p = qq;
488    PR->t_p = NULL;
489    PR->SetShortExpVector();
490  }
491#endif
492
493#if defined(KDEBUG) && defined(TEST_OPT_DEBUG_RED)
494  if (TEST_OPT_DEBUG)
495  {
496    Print(" to: "); PR->wrp(); Print("\n");
497  }
498#endif
499  return ret;
500}
501
502int ksReducePolySigRing(LObject* PR,
503                 TObject* PW,
504                 long /*idx*/,
505                 poly spNoether,
506                 number *coef,
507                 kStrategy strat)
508{
509#ifdef KDEBUG
510  red_count++;
511#ifdef TEST_OPT_DEBUG_RED
512  if (TEST_OPT_DEBUG)
513  {
514    Print("Red %d:", red_count); PR->wrp(); Print(" with:");
515    PW->wrp();
516  }
517#endif
518#endif
519  int ret = 0;
520  ring tailRing = PR->tailRing;
521  kTest_L(PR);
522  kTest_T(PW);
523
524  // signature-based stuff:
525  // checking for sig-safeness first
526  // NOTE: This has to be done in the current ring
527  //
528  /**********************************************
529   *
530   * TODO:
531   * --------------------------------------------
532   * if strat->sbaOrder == 1
533   * Since we are subdividing lower index and
534   * current index reductions it is enough to
535   * look at the polynomial part of the signature
536   * for a check. This should speed-up checking
537   * a lot!
538   * if !strat->sbaOrder == 0
539   * We are not subdividing lower and current index
540   * due to the fact that we are using the induced
541   * Schreyer order
542   *
543   * nevertheless, this different behaviour is
544   * taken care of by is_sigsafe
545   * => one reduction procedure can be used for
546   * both, the incremental and the non-incremental
547   * attempt!
548   * --------------------------------------------
549   *
550   *********************************************/
551  //printf("COMPARE IDX: %ld -- %ld\n",idx,strat->currIdx);
552  if (!PW->is_sigsafe)
553  {
554    poly sigMult = pCopy(PW->sig);   // copy signature of reducer
555//#if 1
556#ifdef DEBUGF5
557    printf("IN KSREDUCEPOLYSIG: \n");
558    pWrite(pHead(f1));
559    pWrite(pHead(f2));
560    pWrite(sigMult);
561    printf("--------------\n");
562#endif
563    p_ExpVectorAddSub(sigMult,PR->GetLmCurrRing(),PW->GetLmCurrRing(),currRing);
564    //I have also to set the leading coeficient for sigMult (in the case of rings)
565    if(rField_is_Ring(currRing))
566    {
567      pSetCoeff(sigMult,nMult(nDiv(pGetCoeff(PR->p),pGetCoeff(PW->p)), pGetCoeff(sigMult)));
568      if(nIsZero(pGetCoeff(sigMult)))
569      {
570        sigMult = NULL;
571      }
572    }
573//#if 1
574#ifdef DEBUGF5
575    printf("------------------- IN KSREDUCEPOLYSIG: --------------------\n");
576    pWrite(pHead(f1));
577    pWrite(pHead(f2));
578    pWrite(sigMult);
579    pWrite(PR->sig);
580    printf("--------------\n");
581#endif
582    int sigSafe;
583    if(!rField_is_Ring(currRing))
584      sigSafe = p_LmCmp(PR->sig,sigMult,currRing);
585    // now we can delete the copied polynomial data used for checking for
586    // sig-safeness of the reduction step
587//#if 1
588#ifdef DEBUGF5
589    printf("%d -- %d sig\n",sigSafe,PW->is_sigsafe);
590
591#endif
592    if(rField_is_Ring(currRing))
593    {
594      // Set the sig
595      poly origsig = pCopy(PR->sig);
596      if(sigMult != NULL)
597        PR->sig = pHead(pSub(PR->sig, sigMult));
598      //The sigs have the same lm, have to substract
599      //It may happen that now the signature is 0 (drop)
600      if(PR->sig == NULL)
601      {
602        strat->sigdrop=TRUE;
603      }
604      else
605      {
606        if(pLtCmp(PR->sig,origsig) == 1)
607        {
608          // do not allow this reduction - it will increase it's signature
609          // and the partially standard basis is just till the old sig, not the new one
610          PR->is_redundant = TRUE;
611          pDelete(&PR->sig);
612          PR->sig = origsig;
613          strat->blockred++;
614          return 3;
615        }
616        if(pLtCmp(PR->sig,origsig) == -1)
617        {
618          strat->sigdrop=TRUE;
619        }
620      }
621      pDelete(&origsig);
622    }
623    //pDelete(&f1);
624    // go on with the computations only if the signature of p2 is greater than the
625    // signature of fm*p1
626    if(sigSafe != 1 && !rField_is_Ring(currRing))
627    {
628      PR->is_redundant = TRUE;
629      return 3;
630    }
631    //PW->is_sigsafe  = TRUE;
632  }
633  PR->is_redundant = FALSE;
634  poly p1 = PR->GetLmTailRing();   // p2 | p1
635  poly p2 = PW->GetLmTailRing();   // i.e. will reduce p1 with p2; lm = LT(p1) / LM(p2)
636  poly t2 = pNext(p2), lm = p1;    // t2 = p2 - LT(p2); really compute P = LC(p2)*p1 - LT(p1)/LM(p2)*p2
637  assume(p1 != NULL && p2 != NULL);// Attention, we have rings and there LC(p2) and LC(p1) are special
638  p_CheckPolyRing(p1, tailRing);
639  p_CheckPolyRing(p2, tailRing);
640
641  pAssume1(p2 != NULL && p1 != NULL &&
642      p_DivisibleBy(p2,  p1, tailRing));
643
644  pAssume1(p_GetComp(p1, tailRing) == p_GetComp(p2, tailRing) ||
645      (p_GetComp(p2, tailRing) == 0 &&
646       p_MaxComp(pNext(p2),tailRing) == 0));
647
648#ifdef HAVE_PLURAL
649  if (rIsPluralRing(currRing))
650  {
651    // for the time being: we know currRing==strat->tailRing
652    // no exp-bound checking needed
653    // (only needed if exp-bound(tailring)<exp-b(currRing))
654    if (PR->bucket!=NULL)  nc_kBucketPolyRed_Z(PR->bucket, p2,coef);
655    else
656    {
657      poly _p = (PR->t_p != NULL ? PR->t_p : PR->p);
658      assume(_p != NULL);
659      nc_PolyPolyRed(_p, p2, coef, currRing);
660      if (PR->t_p!=NULL) PR->t_p=_p; else PR->p=_p;
661      PR->pLength=0; // usaully not used, GetpLength re-comoutes it if needed
662    }
663    return 0;
664  }
665#endif
666
667  if (t2==NULL)           // Divisor is just one term, therefore it will
668  {                       // just cancel the leading term
669    PR->LmDeleteAndIter();
670    if (coef != NULL) *coef = n_Init(1, tailRing->cf);
671    return 0;
672  }
673
674  p_ExpVectorSub(lm, p2, tailRing); // Calculate the Monomial we must multiply to p2
675
676  if (tailRing != currRing)
677  {
678    // check that reduction does not violate exp bound
679    while (PW->max_exp != NULL && !p_LmExpVectorAddIsOk(lm, PW->max_exp, tailRing))
680    {
681      // undo changes of lm
682      p_ExpVectorAdd(lm, p2, tailRing);
683      if (strat == NULL) return 2;
684      if (! kStratChangeTailRing(strat, PR, PW)) return -1;
685      tailRing = strat->tailRing;
686      p1 = PR->GetLmTailRing();
687      p2 = PW->GetLmTailRing();
688      t2 = pNext(p2);
689      lm = p1;
690      p_ExpVectorSub(lm, p2, tailRing);
691      ret = 1;
692    }
693  }
694  // take care of coef buisness
695  if(rField_is_Ring(currRing))
696  {
697    p_SetCoeff(lm, nDiv(pGetCoeff(lm),pGetCoeff(p2)), tailRing);
698    if (coef != NULL) *coef = n_Init(1, tailRing->cf);
699  }
700  else
701  {
702    if (! n_IsOne(pGetCoeff(p2), tailRing->cf))
703    {
704      number bn = pGetCoeff(lm);
705      number an = pGetCoeff(p2);
706      int ct = ksCheckCoeff(&an, &bn, tailRing->cf);    // Calculate special LC
707      p_SetCoeff(lm, bn, tailRing);
708      if (((ct == 0) || (ct == 2)))
709        PR->Tail_Mult_nn(an);
710      if (coef != NULL) *coef = an;
711      else n_Delete(&an, tailRing->cf);
712    }
713    else
714    {
715      if (coef != NULL) *coef = n_Init(1, tailRing->cf);
716    }
717  }
718
719  // and finally,
720  PR->Tail_Minus_mm_Mult_qq(lm, t2, PW->GetpLength() - 1, spNoether);
721  assume(PW->GetpLength() == pLength(PW->p != NULL ? PW->p : PW->t_p));
722  PR->LmDeleteAndIter();
723
724  // the following is commented out: shrinking
725#ifdef HAVE_SHIFTBBA_NONEXISTENT
726  if ( (currRing->isLPring) && (!strat->homog) )
727  {
728    // assume? h->p in currRing
729    PR->GetP();
730    poly qq = p_Shrink(PR->p, currRing->isLPring, currRing);
731    PR->Clear(); // does the right things
732    PR->p = qq;
733    PR->t_p = NULL;
734    PR->SetShortExpVector();
735  }
736#endif
737#if defined(KDEBUG) && defined(TEST_OPT_DEBUG_RED)
738  if (TEST_OPT_DEBUG)
739  {
740    Print(" to: "); PR->wrp(); Print("\n");
741  }
742#endif
743  return ret;
744}
745
746/***************************************************************
747 *
748 * Creates S-Poly of p1 and p2
749 *
750 *
751 ***************************************************************/
752void ksCreateSpoly(LObject* Pair,   poly spNoether,
753                   int use_buckets, ring tailRing,
754                   poly m1, poly m2, TObject** R)
755{
756#ifdef KDEBUG
757  create_count++;
758#endif
759  kTest_L(Pair);
760  poly p1 = Pair->p1;
761  poly p2 = Pair->p2;
762  Pair->tailRing = tailRing;
763
764  assume(p1 != NULL);
765  assume(p2 != NULL);
766  assume(tailRing != NULL);
767
768  poly a1 = pNext(p1), a2 = pNext(p2);
769  number lc1 = pGetCoeff(p1), lc2 = pGetCoeff(p2);
770  int co=0/*, ct = ksCheckCoeff(&lc1, &lc2, currRing->cf)*/; // gcd and zero divisors
771  (void) ksCheckCoeff(&lc1, &lc2, currRing->cf);
772
773  int l1=0, l2=0;
774
775  if (currRing->pCompIndex >= 0)
776  {
777    if (__p_GetComp(p1, currRing)!=__p_GetComp(p2, currRing))
778    {
779      if (__p_GetComp(p1, currRing)==0)
780      {
781        co=1;
782        p_SetCompP(p1,__p_GetComp(p2, currRing), currRing, tailRing);
783      }
784      else
785      {
786        co=2;
787        p_SetCompP(p2, __p_GetComp(p1, currRing), currRing, tailRing);
788      }
789    }
790  }
791
792  // get m1 = LCM(LM(p1), LM(p2))/LM(p1)
793  //     m2 = LCM(LM(p1), LM(p2))/LM(p2)
794  if (m1 == NULL)
795    k_GetLeadTerms(p1, p2, currRing, m1, m2, tailRing);
796
797  pSetCoeff0(m1, lc2);
798  pSetCoeff0(m2, lc1);  // and now, m1 * LT(p1) == m2 * LT(p2)
799
800  if (R != NULL)
801  {
802    if (Pair->i_r1 == -1)
803    {
804      l1 = pLength(p1) - 1;
805    }
806    else
807    {
808      l1 = (R[Pair->i_r1])->GetpLength() - 1;
809    }
810    if ((Pair->i_r2 == -1)||(R[Pair->i_r2]==NULL))
811    {
812      l2 = pLength(p2) - 1;
813    }
814    else
815    {
816      l2 = (R[Pair->i_r2])->GetpLength() - 1;
817    }
818  }
819
820  // get m2 * a2
821  if (spNoether != NULL)
822  {
823    l2 = -1;
824    a2 = tailRing->p_Procs->pp_Mult_mm_Noether(a2, m2, spNoether, l2, tailRing);
825    assume(l2 == pLength(a2));
826  }
827  else
828    a2 = tailRing->p_Procs->pp_Mult_mm(a2, m2, tailRing);
829#ifdef HAVE_RINGS
830  if (!(rField_is_Domain(currRing))) l2 = pLength(a2);
831#endif
832
833  Pair->SetLmTail(m2, a2, l2, use_buckets, tailRing);
834
835  // get m2*a2 - m1*a1
836  Pair->Tail_Minus_mm_Mult_qq(m1, a1, l1, spNoether);
837
838  // Clean-up time
839  Pair->LmDeleteAndIter();
840  p_LmDelete(m1, tailRing);
841
842  if (co != 0)
843  {
844    if (co==1)
845    {
846      p_SetCompP(p1,0, currRing, tailRing);
847    }
848    else
849    {
850      p_SetCompP(p2,0, currRing, tailRing);
851    }
852  }
853
854  // the following is commented out: shrinking
855#ifdef HAVE_SHIFTBBA_NONEXISTENT
856  if (currRing->isLPring)
857  {
858    // assume? h->p in currRing
859    Pair->GetP();
860    poly qq = p_Shrink(Pair->p, currRing->isLPring, currRing);
861    Pair->Clear(); // does the right things
862    Pair->p = qq;
863    Pair->t_p = NULL;
864    Pair->SetShortExpVector();
865  }
866#endif
867
868}
869
870int ksReducePolyTail(LObject* PR, TObject* PW, poly Current, poly spNoether)
871{
872  BOOLEAN ret;
873  number coef;
874  poly Lp =     PR->GetLmCurrRing();
875  poly Save =   PW->GetLmCurrRing();
876
877  kTest_L(PR);
878  kTest_T(PW);
879  pAssume(pIsMonomOf(Lp, Current));
880
881  assume(Lp != NULL && Current != NULL && pNext(Current) != NULL);
882  assume(PR->bucket == NULL);
883
884  LObject Red(pNext(Current), PR->tailRing);
885  TObject With(PW, Lp == Save);
886
887  pAssume(!pHaveCommonMonoms(Red.p, With.p));
888  ret = ksReducePoly(&Red, &With, spNoether, &coef);
889
890  if (!ret)
891  {
892    if (! n_IsOne(coef, currRing->cf))
893    {
894      pNext(Current) = NULL;
895      if (Current == PR->p && PR->t_p != NULL)
896        pNext(PR->t_p) = NULL;
897      PR->Mult_nn(coef);
898    }
899
900    n_Delete(&coef, currRing->cf);
901    pNext(Current) = Red.GetLmTailRing();
902    if (Current == PR->p && PR->t_p != NULL)
903      pNext(PR->t_p) = pNext(Current);
904  }
905
906  if (Lp == Save)
907    With.Delete();
908
909  // the following is commented out: shrinking
910#ifdef HAVE_SHIFTBBA_NONEXISTENT
911  if (currRing->isLPring)
912  {
913    // assume? h->p in currRing
914    PR->GetP();
915    poly qq = p_Shrink(PR->p, currRing->isLPring, currRing);
916    PR->Clear(); // does the right things
917    PR->p = qq;
918    PR->t_p = NULL;
919    PR->SetShortExpVector();
920  }
921#endif
922
923  return ret;
924}
925
926int ksReducePolyTailBound(LObject* PR, TObject* PW, int bound, poly Current, poly spNoether)
927{
928  BOOLEAN ret;
929  number coef;
930  poly Lp =     PR->GetLmCurrRing();
931  poly Save =   PW->GetLmCurrRing();
932
933  kTest_L(PR);
934  kTest_T(PW);
935  pAssume(pIsMonomOf(Lp, Current));
936
937  assume(Lp != NULL && Current != NULL && pNext(Current) != NULL);
938  assume(PR->bucket == NULL);
939
940  LObject Red(pNext(Current), PR->tailRing);
941  TObject With(PW, Lp == Save);
942
943  pAssume(!pHaveCommonMonoms(Red.p, With.p));
944  ret = ksReducePolyBound(&Red, &With,bound, spNoether, &coef);
945
946  if (!ret)
947  {
948    if (! n_IsOne(coef, currRing))
949    {
950      pNext(Current) = NULL;
951      if (Current == PR->p && PR->t_p != NULL)
952        pNext(PR->t_p) = NULL;
953      PR->Mult_nn(coef);
954    }
955
956    n_Delete(&coef, currRing);
957    pNext(Current) = Red.GetLmTailRing();
958    if (Current == PR->p && PR->t_p != NULL)
959      pNext(PR->t_p) = pNext(Current);
960  }
961
962  if (Lp == Save)
963    With.Delete();
964
965  // the following is commented out: shrinking
966#ifdef HAVE_SHIFTBBA_NONEXISTENT
967  if (currRing->isLPring)
968  {
969    // assume? h->p in currRing
970    PR->GetP();
971    poly qq = p_Shrink(PR->p, currRing->isLPring, currRing);
972    PR->Clear(); // does the right things
973    PR->p = qq;
974    PR->t_p = NULL;
975    PR->SetShortExpVector();
976  }
977#endif
978
979  return ret;
980}
981
982/***************************************************************
983 *
984 * Auxillary Routines
985 *
986 *
987 ***************************************************************/
988
989/*2
990* creates the leading term of the S-polynomial of p1 and p2
991* do not destroy p1 and p2
992* remarks:
993*   1. the coefficient is 0 (p_Init)
994*   1. a) in the case of coefficient ring, the coefficient is calculated
995*   2. pNext is undefined
996*/
997//static void bbb() { int i=0; }
998poly ksCreateShortSpoly(poly p1, poly p2, ring tailRing)
999{
1000  poly a1 = pNext(p1), a2 = pNext(p2);
1001  long c1=p_GetComp(p1, currRing),c2=p_GetComp(p2, currRing);
1002  long c;
1003  poly m1,m2;
1004  number t1 = NULL,t2 = NULL;
1005  int cm,i;
1006  BOOLEAN equal;
1007
1008#ifdef HAVE_RINGS
1009  BOOLEAN is_Ring=rField_is_Ring(currRing);
1010  number lc1 = pGetCoeff(p1), lc2 = pGetCoeff(p2);
1011  if (is_Ring)
1012  {
1013    ksCheckCoeff(&lc1, &lc2, currRing->cf); // gcd and zero divisors
1014    if (a1 != NULL) t2 = nMult(pGetCoeff(a1),lc2);
1015    if (a2 != NULL) t1 = nMult(pGetCoeff(a2),lc1);
1016    while (a1 != NULL && nIsZero(t2))
1017    {
1018      pIter(a1);
1019      nDelete(&t2);
1020      if (a1 != NULL) t2 = nMult(pGetCoeff(a1),lc2);
1021    }
1022    while (a2 != NULL && nIsZero(t1))
1023    {
1024      pIter(a2);
1025      nDelete(&t1);
1026      if (a2 != NULL) t1 = nMult(pGetCoeff(a2),lc1);
1027    }
1028  }
1029#endif
1030
1031  if (a1==NULL)
1032  {
1033    if(a2!=NULL)
1034    {
1035      m2=p_Init(currRing);
1036x2:
1037      for (i = (currRing->N); i; i--)
1038      {
1039        c = p_GetExpDiff(p1, p2,i, currRing);
1040        if (c>0)
1041        {
1042          p_SetExp(m2,i,(c+p_GetExp(a2,i,tailRing)),currRing);
1043        }
1044        else
1045        {
1046          p_SetExp(m2,i,p_GetExp(a2,i,tailRing),currRing);
1047        }
1048      }
1049      if ((c1==c2)||(c2!=0))
1050      {
1051        p_SetComp(m2,p_GetComp(a2,tailRing), currRing);
1052      }
1053      else
1054      {
1055        p_SetComp(m2,c1,currRing);
1056      }
1057      p_Setm(m2, currRing);
1058#ifdef HAVE_RINGS
1059      if (is_Ring)
1060      {
1061          nDelete(&lc1);
1062          nDelete(&lc2);
1063          nDelete(&t2);
1064          pSetCoeff0(m2, t1);
1065      }
1066#endif
1067      return m2;
1068    }
1069    else
1070    {
1071#ifdef HAVE_RINGS
1072      if (is_Ring)
1073      {
1074        nDelete(&lc1);
1075        nDelete(&lc2);
1076        nDelete(&t1);
1077        nDelete(&t2);
1078      }
1079#endif
1080      return NULL;
1081    }
1082  }
1083  if (a2==NULL)
1084  {
1085    m1=p_Init(currRing);
1086x1:
1087    for (i = (currRing->N); i; i--)
1088    {
1089      c = p_GetExpDiff(p2, p1,i,currRing);
1090      if (c>0)
1091      {
1092        p_SetExp(m1,i,(c+p_GetExp(a1,i, tailRing)),currRing);
1093      }
1094      else
1095      {
1096        p_SetExp(m1,i,p_GetExp(a1,i, tailRing), currRing);
1097      }
1098    }
1099    if ((c1==c2)||(c1!=0))
1100    {
1101      p_SetComp(m1,p_GetComp(a1,tailRing),currRing);
1102    }
1103    else
1104    {
1105      p_SetComp(m1,c2,currRing);
1106    }
1107    p_Setm(m1, currRing);
1108#ifdef HAVE_RINGS
1109    if (is_Ring)
1110    {
1111      pSetCoeff0(m1, t2);
1112      nDelete(&lc1);
1113      nDelete(&lc2);
1114      nDelete(&t1);
1115    }
1116#endif
1117    return m1;
1118  }
1119  m1 = p_Init(currRing);
1120  m2 = p_Init(currRing);
1121  loop
1122  {
1123    for (i = (currRing->N); i; i--)
1124    {
1125      c = p_GetExpDiff(p1, p2,i,currRing);
1126      if (c > 0)
1127      {
1128        p_SetExp(m2,i,(c+p_GetExp(a2,i,tailRing)), currRing);
1129        p_SetExp(m1,i,p_GetExp(a1,i, tailRing), currRing);
1130      }
1131      else
1132      {
1133        p_SetExp(m1,i,(p_GetExp(a1,i,tailRing)-c), currRing);
1134        p_SetExp(m2,i,p_GetExp(a2,i, tailRing), currRing);
1135      }
1136    }
1137    if(c1==c2)
1138    {
1139      p_SetComp(m1,p_GetComp(a1, tailRing), currRing);
1140      p_SetComp(m2,p_GetComp(a2, tailRing), currRing);
1141    }
1142    else
1143    {
1144      if(c1!=0)
1145      {
1146        p_SetComp(m1,p_GetComp(a1, tailRing), currRing);
1147        p_SetComp(m2,c1, currRing);
1148      }
1149      else
1150      {
1151        p_SetComp(m2,p_GetComp(a2, tailRing), currRing);
1152        p_SetComp(m1,c2, currRing);
1153      }
1154    }
1155    p_Setm(m1,currRing);
1156    p_Setm(m2,currRing);
1157    cm = p_LmCmp(m1, m2,currRing);
1158    if (cm!=0)
1159    {
1160      if(cm==1)
1161      {
1162        p_LmFree(m2,currRing);
1163#ifdef HAVE_RINGS
1164        if (is_Ring)
1165        {
1166          pSetCoeff0(m1, t2);
1167          nDelete(&lc1);
1168          nDelete(&lc2);
1169          nDelete(&t1);
1170        }
1171#endif
1172        return m1;
1173      }
1174      else
1175      {
1176        p_LmFree(m1,currRing);
1177#ifdef HAVE_RINGS
1178        if (is_Ring)
1179        {
1180          pSetCoeff0(m2, t1);
1181          nDelete(&lc1);
1182          nDelete(&lc2);
1183          nDelete(&t2);
1184        }
1185#endif
1186        return m2;
1187      }
1188    }
1189#ifdef HAVE_RINGS
1190    if (is_Ring)
1191    {
1192      equal = nEqual(t1,t2);
1193    }
1194    else
1195#endif
1196    {
1197      t1 = nMult(pGetCoeff(a2),pGetCoeff(p1));
1198      t2 = nMult(pGetCoeff(a1),pGetCoeff(p2));
1199      equal = nEqual(t1,t2);
1200      nDelete(&t2);
1201      nDelete(&t1);
1202    }
1203    if (!equal)
1204    {
1205      p_LmFree(m2,currRing);
1206#ifdef HAVE_RINGS
1207      if (is_Ring)
1208      {
1209          pSetCoeff0(m1, nSub(t1, t2));
1210          nDelete(&lc1);
1211          nDelete(&lc2);
1212          nDelete(&t1);
1213          nDelete(&t2);
1214      }
1215#endif
1216      return m1;
1217    }
1218    pIter(a1);
1219    pIter(a2);
1220#ifdef HAVE_RINGS
1221    if (is_Ring)
1222    {
1223      if (a2 != NULL)
1224      {
1225        nDelete(&t1);
1226        t1 = nMult(pGetCoeff(a2),lc1);
1227      }
1228      if (a1 != NULL)
1229      {
1230        nDelete(&t2);
1231        t2 = nMult(pGetCoeff(a1),lc2);
1232      }
1233      while ((a1 != NULL) && nIsZero(t2))
1234      {
1235        pIter(a1);
1236        if (a1 != NULL)
1237        {
1238          nDelete(&t2);
1239          t2 = nMult(pGetCoeff(a1),lc2);
1240        }
1241      }
1242      while ((a2 != NULL) && nIsZero(t1))
1243      {
1244        pIter(a2);
1245        if (a2 != NULL)
1246        {
1247          nDelete(&t1);
1248          t1 = nMult(pGetCoeff(a2),lc1);
1249        }
1250      }
1251    }
1252#endif
1253    if (a2==NULL)
1254    {
1255      p_LmFree(m2,currRing);
1256      if (a1==NULL)
1257      {
1258#ifdef HAVE_RINGS
1259        if (is_Ring)
1260        {
1261          nDelete(&lc1);
1262          nDelete(&lc2);
1263          nDelete(&t1);
1264          nDelete(&t2);
1265        }
1266#endif
1267        p_LmFree(m1,currRing);
1268        return NULL;
1269      }
1270      goto x1;
1271    }
1272    if (a1==NULL)
1273    {
1274      p_LmFree(m1,currRing);
1275      goto x2;
1276    }
1277  }
1278}
Note: See TracBrowser for help on using the repository browser.