source: git/kernel/GBEngine/kspoly.cc @ b94a72

spielwiese
Last change on this file since b94a72 was b94a72, checked in by Hans Schoenemann <hannes@…>, 4 years ago
fix: Tst/Long/primdecint.tst, Tst/New/stdZtests.tst
  • Property mode set to 100644
File size: 45.0 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#ifdef HAVE_SHIFTBBA
23#include "polys/shiftop.h"
24#endif
25
26#ifdef KDEBUG
27VAR int red_count = 0;
28VAR int create_count = 0;
29// define this if reductions are reported on TEST_OPT_DEBUG
30#define TEST_OPT_DEBUG_RED
31#endif
32
33/***************************************************************
34 *
35 * Reduces PR with PW
36 * Assumes PR != NULL, PW != NULL, Lm(PW) divides Lm(PR)
37 *
38 * returns 0: okay
39 *         1: tailRing changed
40 *         -1: cannot change tailRing
41 *         2: cannot change tailRing: strat==NULL
42 *
43 ***************************************************************/
44int ksReducePolyZ(LObject* PR,
45                 TObject* PW,
46                 poly spNoether,
47                 number *coef,
48                 kStrategy strat)
49{
50#ifdef KDEBUG
51  red_count++;
52#ifdef TEST_OPT_DEBUG_RED
53//  if (TEST_OPT_DEBUG)
54//  {
55//    Print("Red %d:", red_count); PR->wrp(); Print(" with:");
56//    PW->wrp();
57//    //printf("\necart(PR)-ecart(PW): %i\n",PR->ecart-PW->ecart);
58//    //pWrite(PR->p);
59//  }
60#endif
61#endif
62  int ret = 0;
63  ring tailRing = PR->tailRing;
64  kTest_L(PR,tailRing);
65  kTest_T(PW);
66
67  poly p1 = PR->GetLmTailRing();   // p2 | p1
68  poly p2 = PW->GetLmTailRing();   // i.e. will reduce p1 with p2; lm = LT(p1) / LM(p2)
69  poly t2 = pNext(p2), lm = p1;    // t2 = p2 - LT(p2); really compute P = LC(p2)*p1 - LT(p1)/LM(p2)*p2
70  assume(p1 != NULL && p2 != NULL);// Attention, we have rings and there LC(p2) and LC(p1) are special
71  p_CheckPolyRing(p1, tailRing);
72  p_CheckPolyRing(p2, tailRing);
73
74  pAssume1(p2 != NULL && p1 != NULL &&
75           p_DivisibleBy(p2,  p1, tailRing));
76
77  pAssume1(p_GetComp(p1, tailRing) == p_GetComp(p2, tailRing) ||
78           (p_GetComp(p2, tailRing) == 0 &&
79            p_MaxComp(pNext(p2),tailRing) == 0));
80
81#ifdef HAVE_PLURAL
82  if (rIsPluralRing(currRing))
83  {
84    // for the time being: we know currRing==strat->tailRing
85    // no exp-bound checking needed
86    // (only needed if exp-bound(tailring)<exp-b(currRing))
87    if (PR->bucket!=NULL)  nc_kBucketPolyRed_Z(PR->bucket, p2,coef);
88    else
89    {
90      poly _p = (PR->t_p != NULL ? PR->t_p : PR->p);
91      assume(_p != NULL);
92      nc_PolyPolyRed(_p, p2,coef, currRing);
93      if (PR->t_p!=NULL) PR->t_p=_p; else PR->p=_p;
94      PR->pLength=0; // usually not used, GetpLength re-computes it if needed
95    }
96    return 0;
97  }
98#endif
99
100  if (t2==NULL)           // Divisor is just one term, therefore it will
101  {                       // just cancel the leading term
102    // adjust lead coefficient if needed
103    if (! n_IsOne(pGetCoeff(p2), tailRing->cf))
104    {
105      number bn = pGetCoeff(lm);
106      number an = pGetCoeff(p2);
107      int ct = ksCheckCoeff(&an, &bn, tailRing->cf);    // Calculate special LC
108      p_SetCoeff(lm, bn, tailRing);
109      if ((ct == 0) || (ct == 2))
110      PR->Tail_Mult_nn(an);
111      if (coef != NULL) *coef = an;
112      else n_Delete(&an, tailRing->cf);
113    }
114    PR->LmDeleteAndIter();
115    if (coef != NULL) *coef = n_Init(1, tailRing->cf);
116    return 0;
117  }
118
119  p_ExpVectorSub(lm, p2, tailRing); // Calculate the Monomial we must multiply to p2
120
121  //if (tailRing != currRing)
122  {
123    // check that reduction does not violate exp bound
124    while (PW->max_exp != NULL && !p_LmExpVectorAddIsOk(lm, PW->max_exp, tailRing))
125    {
126      // undo changes of lm
127      p_ExpVectorAdd(lm, p2, tailRing);
128      if (strat == NULL) return 2;
129      if (! kStratChangeTailRing(strat, PR, PW)) return -1;
130      tailRing = strat->tailRing;
131      p1 = PR->GetLmTailRing();
132      p2 = PW->GetLmTailRing();
133      t2 = pNext(p2);
134      lm = p1;
135      p_ExpVectorSub(lm, p2, tailRing);
136      ret = 1;
137    }
138  }
139
140#ifdef HAVE_SHIFTBBA
141  poly lmRight;
142  if (tailRing->isLPring)
143  {
144    assume(PR->shift == 0);
145    assume(PW->shift == si_max(p_mFirstVblock(PW->p, tailRing) - 1, 0));
146    k_SplitFrame(lm, lmRight, PW->shift + 1, tailRing);
147  }
148#endif
149
150  // take care of coef buisness
151  if (! n_IsOne(pGetCoeff(p2), tailRing->cf))
152  {
153    number bn = pGetCoeff(lm);
154    number an = pGetCoeff(p2);
155    int ct = ksCheckCoeff(&an, &bn, tailRing->cf);    // Calculate special LC
156    p_SetCoeff(lm, bn, tailRing);
157    if ((ct == 0) || (ct == 2))
158      PR->Tail_Mult_nn(an);
159    if (coef != NULL) *coef = an;
160    else n_Delete(&an, tailRing->cf);
161  }
162  else
163  {
164    if (coef != NULL) *coef = n_Init(1, tailRing->cf);
165  }
166
167
168  // and finally,
169#ifdef HAVE_SHIFTBBA
170  if (tailRing->isLPring)
171  {
172    PR->Tail_Minus_mm_Mult_qq(lm, tailRing->p_Procs->pp_Mult_mm(t2, lmRight, tailRing), pLength(t2), spNoether);
173  }
174  else
175#endif
176  {
177    PR->Tail_Minus_mm_Mult_qq(lm, t2, pLength(t2) /*PW->GetpLength() - 1*/, spNoether);
178  }
179  assume(PW->GetpLength() == pLength(PW->p != NULL ? PW->p : PW->t_p));
180  PR->LmDeleteAndIter();
181
182  return ret;
183}
184
185int ksReducePoly(LObject* PR,
186                 TObject* PW,
187                 poly spNoether,
188                 number *coef,
189                 kStrategy strat)
190{
191#ifdef KDEBUG
192  red_count++;
193#ifdef TEST_OPT_DEBUG_RED
194//  if (TEST_OPT_DEBUG)
195//  {
196//    Print("Red %d:", red_count); PR->wrp(); Print(" with:");
197//    PW->wrp();
198//    //printf("\necart(PR)-ecart(PW): %i\n",PR->ecart-PW->ecart);
199//    //pWrite(PR->p);
200//  }
201#endif
202#endif
203  int ret = 0;
204  ring tailRing = PR->tailRing;
205  kTest_L(PR,tailRing);
206  kTest_T(PW);
207
208  poly p1 = PR->GetLmTailRing();   // p2 | p1
209  poly p2 = PW->GetLmTailRing();   // i.e. will reduce p1 with p2; lm = LT(p1) / LM(p2)
210  poly t2 = pNext(p2), lm = p1;    // t2 = p2 - LT(p2); really compute P = LC(p2)*p1 - LT(p1)/LM(p2)*p2
211  assume(p1 != NULL && p2 != NULL);// Attention, we have rings and there LC(p2) and LC(p1) are special
212  p_CheckPolyRing(p1, tailRing);
213  p_CheckPolyRing(p2, tailRing);
214
215  pAssume1(p2 != NULL && p1 != NULL &&
216           p_DivisibleBy(p2,  p1, tailRing));
217
218  pAssume1(p_GetComp(p1, tailRing) == p_GetComp(p2, tailRing) ||
219           (p_GetComp(p2, tailRing) == 0 &&
220            p_MaxComp(pNext(p2),tailRing) == 0));
221
222#ifdef HAVE_PLURAL
223  if (rIsPluralRing(currRing))
224  {
225    // for the time being: we know currRing==strat->tailRing
226    // no exp-bound checking needed
227    // (only needed if exp-bound(tailring)<exp-b(currRing))
228    if (PR->bucket!=NULL)  nc_kBucketPolyRed_Z(PR->bucket, p2,coef);
229    else
230    {
231      poly _p = (PR->t_p != NULL ? PR->t_p : PR->p);
232      assume(_p != NULL);
233      nc_PolyPolyRed(_p, p2,coef, currRing);
234      if (PR->t_p!=NULL) PR->t_p=_p; else PR->p=_p;
235      PR->pLength=0; // usually not used, GetpLength re-computes it if needed
236    }
237    return 0;
238  }
239#endif
240
241  if (t2==NULL)           // Divisor is just one term, therefore it will
242  {                       // just cancel the leading term
243    PR->LmDeleteAndIter();
244    if (coef != NULL) *coef = n_Init(1, tailRing->cf);
245    return 0;
246  }
247
248  p_ExpVectorSub(lm, p2, tailRing); // Calculate the Monomial we must multiply to p2
249
250  //if (tailRing != currRing)
251  {
252    // check that reduction does not violate exp bound
253    while (PW->max_exp != NULL && !p_LmExpVectorAddIsOk(lm, PW->max_exp, tailRing))
254    {
255      // undo changes of lm
256      p_ExpVectorAdd(lm, p2, tailRing);
257      if (strat == NULL) return 2;
258      if (! kStratChangeTailRing(strat, PR, PW)) return -1;
259      tailRing = strat->tailRing;
260      p1 = PR->GetLmTailRing();
261      p2 = PW->GetLmTailRing();
262      t2 = pNext(p2);
263      lm = p1;
264      p_ExpVectorSub(lm, p2, tailRing);
265      ret = 1;
266    }
267  }
268
269#ifdef HAVE_SHIFTBBA
270  poly lmRight;
271  if (tailRing->isLPring)
272  {
273    assume(PR->shift == 0);
274    assume(PW->shift == si_max(p_mFirstVblock(PW->p, tailRing) - 1, 0));
275    k_SplitFrame(lm, lmRight, PW->shift + 1, tailRing);
276  }
277#endif
278
279  // take care of coef buisness
280  if (! n_IsOne(pGetCoeff(p2), tailRing->cf))
281  {
282    number bn = pGetCoeff(lm);
283    number an = pGetCoeff(p2);
284    int ct = ksCheckCoeff(&an, &bn, tailRing->cf);    // Calculate special LC
285    p_SetCoeff(lm, bn, tailRing);
286    if ((ct == 0) || (ct == 2))
287      PR->Tail_Mult_nn(an);
288    if (coef != NULL) *coef = an;
289    else n_Delete(&an, tailRing->cf);
290  }
291  else
292  {
293    if (coef != NULL) *coef = n_Init(1, tailRing->cf);
294  }
295
296
297  // and finally,
298#ifdef HAVE_SHIFTBBA
299  if (tailRing->isLPring)
300  {
301    PR->Tail_Minus_mm_Mult_qq(lm, tailRing->p_Procs->pp_Mult_mm(t2, lmRight, tailRing), pLength(t2), spNoether);
302  }
303  else
304#endif
305  {
306    PR->Tail_Minus_mm_Mult_qq(lm, t2, pLength(t2) /*PW->GetpLength() - 1*/, spNoether);
307  }
308  assume(PW->GetpLength() == pLength(PW->p != NULL ? PW->p : PW->t_p));
309  PR->LmDeleteAndIter();
310
311  return ret;
312}
313
314#ifdef HAVE_RINGS
315int ksReducePolyGCD(LObject* PR,
316                 TObject* PW,
317                 poly spNoether,
318                 number *coef,
319                 kStrategy strat)
320{
321#ifdef KDEBUG
322  red_count++;
323#ifdef TEST_OPT_DEBUG_RED
324//  if (TEST_OPT_DEBUG)
325//  {
326//    Print("Red %d:", red_count); PR->wrp(); Print(" with:");
327//    PW->wrp();
328//    //printf("\necart(PR)-ecart(PW): %i\n",PR->ecart-PW->ecart);
329//    //pWrite(PR->p);
330//  }
331#endif
332#endif
333  int ret = 0;
334  ring tailRing = PR->tailRing;
335  kTest_L(PR, tailRing);
336  kTest_T(PW);
337
338  poly p1 = PR->GetLmTailRing();
339  poly p2 = PW->GetLmTailRing();
340  poly t2 = pNext(p2), lm = pOne();
341  assume(p1 != NULL && p2 != NULL);// Attention, we have rings and there LC(p2) and LC(p1) are special
342  p_CheckPolyRing(p1, tailRing);
343  p_CheckPolyRing(p2, tailRing);
344
345  pAssume1(p2 != NULL && p1 != NULL &&
346           p_DivisibleBy(p2,  p1, tailRing));
347
348  pAssume1(p_GetComp(p1, tailRing) == p_GetComp(p2, tailRing) ||
349           (p_GetComp(p2, tailRing) == 0 &&
350            p_MaxComp(pNext(p2),tailRing) == 0));
351
352#ifdef HAVE_PLURAL
353  if (rIsPluralRing(currRing))
354  {
355    // for the time being: we know currRing==strat->tailRing
356    // no exp-bound checking needed
357    // (only needed if exp-bound(tailring)<exp-b(currRing))
358    if (PR->bucket!=NULL)  nc_kBucketPolyRed_Z(PR->bucket, p2,coef);
359    else
360    {
361      poly _p = (PR->t_p != NULL ? PR->t_p : PR->p);
362      assume(_p != NULL);
363      nc_PolyPolyRed(_p, p2,coef, currRing);
364      if (PR->t_p!=NULL) PR->t_p=_p; else PR->p=_p;
365      PR->pLength=0; // usually not used, GetpLength re-computes it if needed
366    }
367    return 0;
368  }
369#endif
370  // check that reduction does not violate exp bound
371  while (PW->max_exp != NULL && !p_LmExpVectorAddIsOk(lm, PW->max_exp, tailRing))
372  {
373    // undo changes of lm
374    p_ExpVectorAdd(lm, p2, tailRing);
375    if (strat == NULL) return 2;
376    if (! kStratChangeTailRing(strat, PR, PW)) return -1;
377    tailRing = strat->tailRing;
378    p1 = PR->GetLmTailRing();
379    p2 = PW->GetLmTailRing();
380    t2 = pNext(p2);
381    lm = p1;
382    p_ExpVectorSub(lm, p2, tailRing);
383    ret = 1;
384  }
385
386#ifdef HAVE_SHIFTBBA
387  poly lmRight;
388  if (tailRing->isLPring)
389  {
390    assume(PR->shift == 0);
391    assume(PW->shift == si_max(p_mFirstVblock(PW->p, tailRing) - 1, 0));
392    k_SplitFrame(lm, lmRight, PW->shift + 1, tailRing);
393  }
394#endif
395
396  number ct, an, bn;
397  // take care of coef buisness
398  if (! n_IsOne(pGetCoeff(p2), tailRing->cf))
399  {
400    ct = n_ExtGcd(pGetCoeff(p1), pGetCoeff(p2), &an, &bn, tailRing->cf);    // Calculate GCD
401#ifdef HAVE_SHIFTBBA
402    if(rIsLPRing(tailRing)) /* with this test: error at New/stdZtests.tst, infinite : Long/primdecint.tst */
403    {
404      if (n_IsZero(an, tailRing->cf) || n_IsZero(bn, tailRing->cf))
405      {
406        // NOTE: not sure why this is not checked in the commutative case, this *does* happen and then zero coeff errors are reported
407        // NOTE: we are probably leaking memory of lm=pOne(), but we cannot delete it since it could also be lm=p1
408        n_Delete(&an, tailRing->cf);
409        n_Delete(&bn, tailRing->cf);
410        n_Delete(&ct, tailRing->cf);
411        return ret;
412      }
413    }
414#endif
415    /* negate bn since we subtract in Tail_Minus_mm_Mult_qq */
416    bn  = n_InpNeg(bn, tailRing->cf);
417    p_SetCoeff(lm, bn, tailRing);
418    PR->Tail_Mult_nn(an);
419  }
420  else
421  {
422    if (coef != NULL) *coef = n_Init(1, tailRing->cf);
423  }
424
425
426  // and finally,
427#ifdef HAVE_SHIFTBBA
428  if (tailRing->isLPring)
429  {
430    PR->Tail_Minus_mm_Mult_qq(lm, tailRing->p_Procs->pp_Mult_mm(t2, lmRight, tailRing), pLength(t2), spNoether);
431  }
432  else
433#endif
434  {
435    PR->Tail_Minus_mm_Mult_qq(lm, t2, pLength(t2) /*PW->GetpLength() - 1*/, spNoether);
436  }
437  assume(PW->GetpLength() == pLength(PW->p != NULL ? PW->p : PW->t_p));
438  pSetCoeff(PR->p, ct);
439
440  return ret;
441}
442#endif
443
444/* Computes a reduction of the lead coefficient only. We have already tested
445 * that lm(PW) divides lm(PR), but lc(PW) does not divide lc(PR). We have
446 * computed division with remainder on the lead coefficients, parameter
447 * coef is the corresponding multiple for PW we need. The new lead
448 * coefficient, i.e. the remainder of lc division has already been
449 * set before calling this function. We do not drop the lead term at
450 * the end, but keep the adjusted, correct lead term. */
451int ksReducePolyLC(LObject* PR,
452                 TObject* PW,
453                 poly spNoether,
454                 number *coef,
455                 kStrategy strat)
456{
457#ifdef KDEBUG
458  red_count++;
459#ifdef TEST_OPT_DEBUG_RED
460//  if (TEST_OPT_DEBUG)
461//  {
462//    Print("Red %d:", red_count); PR->wrp(); Print(" with:");
463//    PW->wrp();
464//    //printf("\necart(PR)-ecart(PW): %i\n",PR->ecart-PW->ecart);
465//    //pWrite(PR->p);
466//  }
467#endif
468#endif
469  /* printf("PR->P: ");
470   * p_Write(PR->p, currRing, PR->tailRing); */
471  int ret = 0;
472  ring tailRing = PR->tailRing;
473  kTest_L(PR,tailRing);
474  kTest_T(PW);
475
476  poly p1 = PR->GetLmTailRing();   // p2 | p1
477  poly p2 = PW->GetLmTailRing();   // i.e. will reduce p1 with p2; lm = LT(p1) / LM(p2)
478  poly t2 = pNext(p2), lm = p1;    // t2 = p2 - LT(p2); really compute P = LC(p2)*p1 - LT(p1)/LM(p2)*p2
479  assume(p1 != NULL && p2 != NULL);// Attention, we have rings and there LC(p2) and LC(p1) are special
480  p_CheckPolyRing(p1, tailRing);
481  p_CheckPolyRing(p2, tailRing);
482
483  pAssume1(p2 != NULL && p1 != NULL &&
484           p_DivisibleBy(p2,  p1, tailRing));
485
486  pAssume1(p_GetComp(p1, tailRing) == p_GetComp(p2, tailRing) ||
487           (p_GetComp(p2, tailRing) == 0 &&
488            p_MaxComp(pNext(p2),tailRing) == 0));
489
490#ifdef HAVE_PLURAL
491  if (rIsPluralRing(currRing))
492  {
493    // for the time being: we know currRing==strat->tailRing
494    // no exp-bound checking needed
495    // (only needed if exp-bound(tailring)<exp-b(currRing))
496    if (PR->bucket!=NULL)  nc_kBucketPolyRed_Z(PR->bucket, p2,coef);
497    else
498    {
499      poly _p = (PR->t_p != NULL ? PR->t_p : PR->p);
500      assume(_p != NULL);
501      nc_PolyPolyRed(_p, p2,coef, currRing);
502      if (PR->t_p!=NULL) PR->t_p=_p; else PR->p=_p;
503      PR->pLength=0; // usually not used, GetpLength re-computes it if needed
504    }
505    return 0;
506  }
507#endif
508
509  p_ExpVectorSub(lm, p2, tailRing); // Calculate the Monomial we must multiply to p2
510  p_SetCoeff(lm, n_Init(1, tailRing), tailRing);
511  while (PW->max_exp != NULL && !p_LmExpVectorAddIsOk(lm, PW->max_exp, tailRing))
512  {
513    // undo changes of lm
514    p_ExpVectorAdd(lm, p2, tailRing);
515    if (strat == NULL) return 2;
516    /* if (! kStratChangeTailRing(strat, PR, PW)) return -1; */
517    tailRing = strat->tailRing;
518    p1 = PR->GetLmTailRing();
519    p2 = PW->GetLmTailRing();
520    t2 = pNext(p2);
521    lm = p1;
522    p_ExpVectorSub(lm, p2, tailRing);
523    ret = 1;
524  }
525
526#ifdef HAVE_SHIFTBBA
527  poly lmRight;
528  if (tailRing->isLPring)
529  {
530    assume(PR->shift == 0);
531    assume(PW->shift == si_max(p_mFirstVblock(PW->p, tailRing) - 1, 0));
532    k_SplitFrame(lm, lmRight, PW->shift + 1, tailRing);
533  }
534#endif
535
536  // and finally,
537#ifdef HAVE_SHIFTBBA
538  if (tailRing->isLPring)
539  {
540    PR->Tail_Minus_mm_Mult_qq(lm, tailRing->p_Procs->pp_Mult_mm(p2, lmRight, tailRing), pLength(p2), spNoether);
541  }
542  else
543#endif
544  {
545    PR->Tail_Minus_mm_Mult_qq(lm, p2, pLength(p2) /*PW->GetpLength() - 1*/, spNoether);
546  }
547  assume(PW->GetpLength() == pLength(PW->p != NULL ? PW->p : PW->t_p));
548
549  PR->LmDeleteAndIter();
550  p_SetCoeff(PR->p, *coef, currRing);
551
552#if defined(KDEBUG) && defined(TEST_OPT_DEBUG_RED)
553  if (TEST_OPT_DEBUG)
554  {
555    Print(" to: "); PR->wrp(); Print("\n");
556    //printf("\nt^%i ", PR->ecart);pWrite(pHead(PR->p));
557  }
558#endif
559  return ret;
560}
561
562int ksReducePolyBound(LObject* PR,
563                 TObject* PW,
564                 int bound,
565                 poly spNoether,
566                 number *coef,
567                 kStrategy strat)
568{
569#ifdef KDEBUG
570  red_count++;
571#ifdef TEST_OPT_DEBUG_RED
572  if (TEST_OPT_DEBUG)
573  {
574    Print("Red %d:", red_count); PR->wrp(); Print(" with:");
575    PW->wrp();
576    //printf("\necart(PR)-ecart(PW): %i\n",PR->ecart-PW->ecart);
577    //pWrite(PR->p);
578  }
579#endif
580#endif
581  int ret = 0;
582  ring tailRing = PR->tailRing;
583  kTest_L(PR,tailRing);
584  kTest_T(PW);
585
586  poly p1 = PR->GetLmTailRing();   // p2 | p1
587  poly p2 = PW->GetLmTailRing();   // i.e. will reduce p1 with p2; lm = LT(p1) / LM(p2)
588  poly t2 = pNext(p2), lm = p1;    // t2 = p2 - LT(p2); really compute P = LC(p2)*p1 - LT(p1)/LM(p2)*p2
589  assume(p1 != NULL && p2 != NULL);// Attention, we have rings and there LC(p2) and LC(p1) are special
590  p_CheckPolyRing(p1, tailRing);
591  p_CheckPolyRing(p2, tailRing);
592
593  pAssume1(p2 != NULL && p1 != NULL &&
594           p_DivisibleBy(p2,  p1, tailRing));
595
596  pAssume1(p_GetComp(p1, tailRing) == p_GetComp(p2, tailRing) ||
597           (p_GetComp(p2, tailRing) == 0 &&
598            p_MaxComp(pNext(p2),tailRing) == 0));
599
600#ifdef HAVE_PLURAL
601  if (rIsPluralRing(currRing))
602  {
603    // for the time being: we know currRing==strat->tailRing
604    // no exp-bound checking needed
605    // (only needed if exp-bound(tailring)<exp-b(currRing))
606    if (PR->bucket!=NULL)  nc_kBucketPolyRed_Z(PR->bucket, p2,coef);
607    else
608    {
609      poly _p = (PR->t_p != NULL ? PR->t_p : PR->p);
610      assume(_p != NULL);
611      nc_PolyPolyRed(_p, p2,coef, currRing);
612      if (PR->t_p!=NULL) PR->t_p=_p; else PR->p=_p;
613      PR->pLength=0; // usually not used, GetpLength re-computes it if needed
614    }
615    return 0;
616  }
617#endif
618
619  if (t2==NULL)           // Divisor is just one term, therefore it will
620  {                       // just cancel the leading term
621    PR->LmDeleteAndIter();
622    if (coef != NULL) *coef = n_Init(1, tailRing);
623    return 0;
624  }
625
626  p_ExpVectorSub(lm, p2, tailRing); // Calculate the Monomial we must multiply to p2
627
628  if (tailRing != currRing)
629  {
630    // check that reduction does not violate exp bound
631    while (PW->max_exp != NULL && !p_LmExpVectorAddIsOk(lm, PW->max_exp, tailRing))
632    {
633      // undo changes of lm
634      p_ExpVectorAdd(lm, p2, tailRing);
635      if (strat == NULL) return 2;
636      if (! kStratChangeTailRing(strat, PR, PW)) return -1;
637      tailRing = strat->tailRing;
638      p1 = PR->GetLmTailRing();
639      p2 = PW->GetLmTailRing();
640      t2 = pNext(p2);
641      lm = p1;
642      p_ExpVectorSub(lm, p2, tailRing);
643      ret = 1;
644    }
645  }
646
647#ifdef HAVE_SHIFTBBA
648  poly lmRight;
649  if (tailRing->isLPring)
650  {
651    assume(PR->shift == 0);
652    assume(PW->shift == si_max(p_mFirstVblock(PW->p, tailRing) - 1, 0));
653    k_SplitFrame(lm, lmRight, PW->shift + 1, tailRing);
654  }
655#endif
656
657  // take care of coef buisness
658  if (! n_IsOne(pGetCoeff(p2), tailRing))
659  {
660    number bn = pGetCoeff(lm);
661    number an = pGetCoeff(p2);
662    int ct = ksCheckCoeff(&an, &bn, tailRing->cf);    // Calculate special LC
663    p_SetCoeff(lm, bn, tailRing);
664    if ((ct == 0) || (ct == 2))
665      PR->Tail_Mult_nn(an);
666    if (coef != NULL) *coef = an;
667    else n_Delete(&an, tailRing);
668  }
669  else
670  {
671    if (coef != NULL) *coef = n_Init(1, tailRing);
672  }
673
674
675  // and finally,
676#ifdef HAVE_SHIFTBBA
677  if (tailRing->isLPring)
678  {
679    PR->Tail_Minus_mm_Mult_qq(lm, tailRing->p_Procs->pp_Mult_mm(t2, lmRight, tailRing), pLength(t2), spNoether);
680  }
681  else
682#endif
683  {
684    PR->Tail_Minus_mm_Mult_qq(lm, t2, pLength(t2) /*PW->GetpLength() - 1*/, spNoether);
685  }
686  assume(PW->GetpLength() == pLength(PW->p != NULL ? PW->p : PW->t_p));
687  PR->LmDeleteAndIter();
688
689#if defined(KDEBUG) && defined(TEST_OPT_DEBUG_RED)
690  if (TEST_OPT_DEBUG)
691  {
692    Print(" to: "); PR->wrp(); Print("\n");
693    //printf("\nt^%i ", PR->ecart);pWrite(pHead(PR->p));
694  }
695#endif
696  return ret;
697}
698
699/***************************************************************
700 *
701 * Reduces PR with PW
702 * Assumes PR != NULL, PW != NULL, Lm(PW) divides Lm(PR)
703 *
704 ***************************************************************/
705
706int ksReducePolySig(LObject* PR,
707                 TObject* PW,
708                 long /*idx*/,
709                 poly spNoether,
710                 number *coef,
711                 kStrategy strat)
712{
713#ifdef KDEBUG
714  red_count++;
715#ifdef TEST_OPT_DEBUG_RED
716  if (TEST_OPT_DEBUG)
717  {
718    Print("Red %d:", red_count); PR->wrp(); Print(" with:");
719    PW->wrp();
720  }
721#endif
722#endif
723  int ret = 0;
724  ring tailRing = PR->tailRing;
725  kTest_L(PR,tailRing);
726  kTest_T(PW);
727
728  // signature-based stuff:
729  // checking for sig-safeness first
730  // NOTE: This has to be done in the current ring
731  //
732  /**********************************************
733   *
734   * TODO:
735   * --------------------------------------------
736   * if strat->sbaOrder == 1
737   * Since we are subdividing lower index and
738   * current index reductions it is enough to
739   * look at the polynomial part of the signature
740   * for a check. This should speed-up checking
741   * a lot!
742   * if !strat->sbaOrder == 0
743   * We are not subdividing lower and current index
744   * due to the fact that we are using the induced
745   * Schreyer order
746   *
747   * nevertheless, this different behaviour is
748   * taken care of by is_sigsafe
749   * => one reduction procedure can be used for
750   * both, the incremental and the non-incremental
751   * attempt!
752   * --------------------------------------------
753   *
754   *********************************************/
755  //printf("COMPARE IDX: %ld -- %ld\n",idx,strat->currIdx);
756  if (!PW->is_sigsafe)
757  {
758    poly sigMult = pCopy(PW->sig);   // copy signature of reducer
759//#if 1
760#ifdef DEBUGF5
761    printf("IN KSREDUCEPOLYSIG: \n");
762    pWrite(pHead(f1));
763    pWrite(pHead(f2));
764    pWrite(sigMult);
765    printf("--------------\n");
766#endif
767    p_ExpVectorAddSub(sigMult,PR->GetLmCurrRing(),PW->GetLmCurrRing(),currRing);
768//#if 1
769#ifdef DEBUGF5
770    printf("------------------- IN KSREDUCEPOLYSIG: --------------------\n");
771    pWrite(pHead(f1));
772    pWrite(pHead(f2));
773    pWrite(sigMult);
774    pWrite(PR->sig);
775    printf("--------------\n");
776#endif
777    int sigSafe = p_LmCmp(PR->sig,sigMult,currRing);
778    // now we can delete the copied polynomial data used for checking for
779    // sig-safeness of the reduction step
780//#if 1
781#ifdef DEBUGF5
782    printf("%d -- %d sig\n",sigSafe,PW->is_sigsafe);
783
784#endif
785    //pDelete(&f1);
786    pDelete(&sigMult);
787    // go on with the computations only if the signature of p2 is greater than the
788    // signature of fm*p1
789    if(sigSafe != 1)
790    {
791      PR->is_redundant = TRUE;
792      return 3;
793    }
794    //PW->is_sigsafe  = TRUE;
795  }
796  PR->is_redundant = FALSE;
797  poly p1 = PR->GetLmTailRing();   // p2 | p1
798  poly p2 = PW->GetLmTailRing();   // i.e. will reduce p1 with p2; lm = LT(p1) / LM(p2)
799  poly t2 = pNext(p2), lm = p1;    // t2 = p2 - LT(p2); really compute P = LC(p2)*p1 - LT(p1)/LM(p2)*p2
800  assume(p1 != NULL && p2 != NULL);// Attention, we have rings and there LC(p2) and LC(p1) are special
801  p_CheckPolyRing(p1, tailRing);
802  p_CheckPolyRing(p2, tailRing);
803
804  pAssume1(p2 != NULL && p1 != NULL &&
805      p_DivisibleBy(p2,  p1, tailRing));
806
807  pAssume1(p_GetComp(p1, tailRing) == p_GetComp(p2, tailRing) ||
808      (p_GetComp(p2, tailRing) == 0 &&
809       p_MaxComp(pNext(p2),tailRing) == 0));
810
811#ifdef HAVE_PLURAL
812  if (rIsPluralRing(currRing))
813  {
814    // for the time being: we know currRing==strat->tailRing
815    // no exp-bound checking needed
816    // (only needed if exp-bound(tailring)<exp-b(currRing))
817    if (PR->bucket!=NULL)  nc_kBucketPolyRed_Z(PR->bucket, p2,coef);
818    else
819    {
820      poly _p = (PR->t_p != NULL ? PR->t_p : PR->p);
821      assume(_p != NULL);
822      nc_PolyPolyRed(_p, p2, coef, currRing);
823      if (PR->t_p!=NULL) PR->t_p=_p; else PR->p=_p;
824      PR->pLength=0; // usaully not used, GetpLength re-comoutes it if needed
825    }
826    return 0;
827  }
828#endif
829
830  if (t2==NULL)           // Divisor is just one term, therefore it will
831  {                       // just cancel the leading term
832    PR->LmDeleteAndIter();
833    if (coef != NULL) *coef = n_Init(1, tailRing->cf);
834    return 0;
835  }
836
837  p_ExpVectorSub(lm, p2, tailRing); // Calculate the Monomial we must multiply to p2
838
839  if (tailRing != currRing)
840  {
841    // check that reduction does not violate exp bound
842    while (PW->max_exp != NULL && !p_LmExpVectorAddIsOk(lm, PW->max_exp, tailRing))
843    {
844      // undo changes of lm
845      p_ExpVectorAdd(lm, p2, tailRing);
846      if (strat == NULL) return 2;
847      if (! kStratChangeTailRing(strat, PR, PW)) return -1;
848      tailRing = strat->tailRing;
849      p1 = PR->GetLmTailRing();
850      p2 = PW->GetLmTailRing();
851      t2 = pNext(p2);
852      lm = p1;
853      p_ExpVectorSub(lm, p2, tailRing);
854      ret = 1;
855    }
856  }
857
858#ifdef HAVE_SHIFTBBA
859  poly lmRight;
860  if (tailRing->isLPring)
861  {
862    assume(PR->shift == 0);
863    assume(PW->shift == si_max(p_mFirstVblock(PW->p, tailRing) - 1, 0));
864    k_SplitFrame(lm, lmRight, PW->shift + 1, tailRing);
865  }
866#endif
867
868  // take care of coef buisness
869  if (! n_IsOne(pGetCoeff(p2), tailRing->cf))
870  {
871    number bn = pGetCoeff(lm);
872    number an = pGetCoeff(p2);
873    int ct = ksCheckCoeff(&an, &bn, tailRing->cf);    // Calculate special LC
874    p_SetCoeff(lm, bn, tailRing);
875    if ((ct == 0) || (ct == 2))
876      PR->Tail_Mult_nn(an);
877    if (coef != NULL) *coef = an;
878    else n_Delete(&an, tailRing->cf);
879  }
880  else
881  {
882    if (coef != NULL) *coef = n_Init(1, tailRing->cf);
883  }
884
885
886  // and finally,
887#ifdef HAVE_SHIFTBBA
888  if (tailRing->isLPring)
889  {
890    PR->Tail_Minus_mm_Mult_qq(lm, tailRing->p_Procs->pp_Mult_mm(t2, lmRight, tailRing), pLength(t2), spNoether);
891  }
892  else
893#endif
894  {
895    PR->Tail_Minus_mm_Mult_qq(lm, t2, PW->GetpLength() - 1, spNoether);
896  }
897  assume(PW->GetpLength() == pLength(PW->p != NULL ? PW->p : PW->t_p));
898  PR->LmDeleteAndIter();
899
900#if defined(KDEBUG) && defined(TEST_OPT_DEBUG_RED)
901  if (TEST_OPT_DEBUG)
902  {
903    Print(" to: "); PR->wrp(); Print("\n");
904  }
905#endif
906  return ret;
907}
908
909int ksReducePolySigRing(LObject* PR,
910                 TObject* PW,
911                 long /*idx*/,
912                 poly spNoether,
913                 number *coef,
914                 kStrategy strat)
915{
916#ifdef KDEBUG
917  red_count++;
918#ifdef TEST_OPT_DEBUG_RED
919  if (TEST_OPT_DEBUG)
920  {
921    Print("Red %d:", red_count); PR->wrp(); Print(" with:");
922    PW->wrp();
923  }
924#endif
925#endif
926  int ret = 0;
927  ring tailRing = PR->tailRing;
928  kTest_L(PR,tailRing);
929  kTest_T(PW);
930
931  // signature-based stuff:
932  // checking for sig-safeness first
933  // NOTE: This has to be done in the current ring
934  //
935  /**********************************************
936   *
937   * TODO:
938   * --------------------------------------------
939   * if strat->sbaOrder == 1
940   * Since we are subdividing lower index and
941   * current index reductions it is enough to
942   * look at the polynomial part of the signature
943   * for a check. This should speed-up checking
944   * a lot!
945   * if !strat->sbaOrder == 0
946   * We are not subdividing lower and current index
947   * due to the fact that we are using the induced
948   * Schreyer order
949   *
950   * nevertheless, this different behaviour is
951   * taken care of by is_sigsafe
952   * => one reduction procedure can be used for
953   * both, the incremental and the non-incremental
954   * attempt!
955   * --------------------------------------------
956   *
957   *********************************************/
958  //printf("COMPARE IDX: %ld -- %ld\n",idx,strat->currIdx);
959  if (!PW->is_sigsafe)
960  {
961    poly sigMult = pCopy(PW->sig);   // copy signature of reducer
962//#if 1
963#ifdef DEBUGF5
964    printf("IN KSREDUCEPOLYSIG: \n");
965    pWrite(pHead(f1));
966    pWrite(pHead(f2));
967    pWrite(sigMult);
968    printf("--------------\n");
969#endif
970    p_ExpVectorAddSub(sigMult,PR->GetLmCurrRing(),PW->GetLmCurrRing(),currRing);
971    //I have also to set the leading coeficient for sigMult (in the case of rings)
972    if(rField_is_Ring(currRing))
973    {
974      pSetCoeff(sigMult,nMult(nDiv(pGetCoeff(PR->p),pGetCoeff(PW->p)), pGetCoeff(sigMult)));
975      if(nIsZero(pGetCoeff(sigMult)))
976      {
977        sigMult = NULL;
978      }
979    }
980//#if 1
981#ifdef DEBUGF5
982    printf("------------------- IN KSREDUCEPOLYSIG: --------------------\n");
983    pWrite(pHead(f1));
984    pWrite(pHead(f2));
985    pWrite(sigMult);
986    pWrite(PR->sig);
987    printf("--------------\n");
988#endif
989    int sigSafe;
990    if(!rField_is_Ring(currRing))
991      sigSafe = p_LmCmp(PR->sig,sigMult,currRing);
992    // now we can delete the copied polynomial data used for checking for
993    // sig-safeness of the reduction step
994//#if 1
995#ifdef DEBUGF5
996    printf("%d -- %d sig\n",sigSafe,PW->is_sigsafe);
997
998#endif
999    if(rField_is_Ring(currRing))
1000    {
1001      // Set the sig
1002      poly origsig = pCopy(PR->sig);
1003      if(sigMult != NULL)
1004        PR->sig = pHead(pSub(PR->sig, sigMult));
1005      //The sigs have the same lm, have to substract
1006      //It may happen that now the signature is 0 (drop)
1007      if(PR->sig == NULL)
1008      {
1009        strat->sigdrop=TRUE;
1010      }
1011      else
1012      {
1013        if(pLtCmp(PR->sig,origsig) == 1)
1014        {
1015          // do not allow this reduction - it will increase it's signature
1016          // and the partially standard basis is just till the old sig, not the new one
1017          PR->is_redundant = TRUE;
1018          pDelete(&PR->sig);
1019          PR->sig = origsig;
1020          strat->blockred++;
1021          return 3;
1022        }
1023        if(pLtCmp(PR->sig,origsig) == -1)
1024        {
1025          strat->sigdrop=TRUE;
1026        }
1027      }
1028      pDelete(&origsig);
1029    }
1030    //pDelete(&f1);
1031    // go on with the computations only if the signature of p2 is greater than the
1032    // signature of fm*p1
1033    if(sigSafe != 1 && !rField_is_Ring(currRing))
1034    {
1035      PR->is_redundant = TRUE;
1036      return 3;
1037    }
1038    //PW->is_sigsafe  = TRUE;
1039  }
1040  PR->is_redundant = FALSE;
1041  poly p1 = PR->GetLmTailRing();   // p2 | p1
1042  poly p2 = PW->GetLmTailRing();   // i.e. will reduce p1 with p2; lm = LT(p1) / LM(p2)
1043  poly t2 = pNext(p2), lm = p1;    // t2 = p2 - LT(p2); really compute P = LC(p2)*p1 - LT(p1)/LM(p2)*p2
1044  assume(p1 != NULL && p2 != NULL);// Attention, we have rings and there LC(p2) and LC(p1) are special
1045  p_CheckPolyRing(p1, tailRing);
1046  p_CheckPolyRing(p2, tailRing);
1047
1048  pAssume1(p2 != NULL && p1 != NULL &&
1049      p_DivisibleBy(p2,  p1, tailRing));
1050
1051  pAssume1(p_GetComp(p1, tailRing) == p_GetComp(p2, tailRing) ||
1052      (p_GetComp(p2, tailRing) == 0 &&
1053       p_MaxComp(pNext(p2),tailRing) == 0));
1054
1055#ifdef HAVE_PLURAL
1056  if (rIsPluralRing(currRing))
1057  {
1058    // for the time being: we know currRing==strat->tailRing
1059    // no exp-bound checking needed
1060    // (only needed if exp-bound(tailring)<exp-b(currRing))
1061    if (PR->bucket!=NULL)  nc_kBucketPolyRed_Z(PR->bucket, p2,coef);
1062    else
1063    {
1064      poly _p = (PR->t_p != NULL ? PR->t_p : PR->p);
1065      assume(_p != NULL);
1066      nc_PolyPolyRed(_p, p2, coef, currRing);
1067      if (PR->t_p!=NULL) PR->t_p=_p; else PR->p=_p;
1068      PR->pLength=0; // usaully not used, GetpLength re-comoutes it if needed
1069    }
1070    return 0;
1071  }
1072#endif
1073
1074  if (t2==NULL)           // Divisor is just one term, therefore it will
1075  {                       // just cancel the leading term
1076    PR->LmDeleteAndIter();
1077    if (coef != NULL) *coef = n_Init(1, tailRing->cf);
1078    return 0;
1079  }
1080
1081  p_ExpVectorSub(lm, p2, tailRing); // Calculate the Monomial we must multiply to p2
1082
1083  if (tailRing != currRing)
1084  {
1085    // check that reduction does not violate exp bound
1086    while (PW->max_exp != NULL && !p_LmExpVectorAddIsOk(lm, PW->max_exp, tailRing))
1087    {
1088      // undo changes of lm
1089      p_ExpVectorAdd(lm, p2, tailRing);
1090      if (strat == NULL) return 2;
1091      if (! kStratChangeTailRing(strat, PR, PW)) return -1;
1092      tailRing = strat->tailRing;
1093      p1 = PR->GetLmTailRing();
1094      p2 = PW->GetLmTailRing();
1095      t2 = pNext(p2);
1096      lm = p1;
1097      p_ExpVectorSub(lm, p2, tailRing);
1098      ret = 1;
1099    }
1100  }
1101
1102#ifdef HAVE_SHIFTBBA
1103  poly lmRight;
1104  if (tailRing->isLPring)
1105  {
1106    assume(PR->shift == 0);
1107    assume(PW->shift == si_max(p_mFirstVblock(PW->p, tailRing) - 1, 0));
1108    k_SplitFrame(lm, lmRight, PW->shift + 1, tailRing);
1109  }
1110#endif
1111
1112  // take care of coef buisness
1113  if(rField_is_Ring(currRing))
1114  {
1115    p_SetCoeff(lm, nDiv(pGetCoeff(lm),pGetCoeff(p2)), tailRing);
1116    if (coef != NULL) *coef = n_Init(1, tailRing->cf);
1117  }
1118  else
1119  {
1120    if (! n_IsOne(pGetCoeff(p2), tailRing->cf))
1121    {
1122      number bn = pGetCoeff(lm);
1123      number an = pGetCoeff(p2);
1124      int ct = ksCheckCoeff(&an, &bn, tailRing->cf);    // Calculate special LC
1125      p_SetCoeff(lm, bn, tailRing);
1126      if (((ct == 0) || (ct == 2)))
1127        PR->Tail_Mult_nn(an);
1128      if (coef != NULL) *coef = an;
1129      else n_Delete(&an, tailRing->cf);
1130    }
1131    else
1132    {
1133      if (coef != NULL) *coef = n_Init(1, tailRing->cf);
1134    }
1135  }
1136
1137  // and finally,
1138#ifdef HAVE_SHIFTBBA
1139  if (tailRing->isLPring)
1140  {
1141    PR->Tail_Minus_mm_Mult_qq(lm, tailRing->p_Procs->pp_Mult_mm(t2, lmRight, tailRing), pLength(t2), spNoether);
1142  }
1143  else
1144#endif
1145  {
1146    PR->Tail_Minus_mm_Mult_qq(lm, t2, PW->GetpLength() - 1, spNoether);
1147  }
1148  assume(PW->GetpLength() == pLength(PW->p != NULL ? PW->p : PW->t_p));
1149  PR->LmDeleteAndIter();
1150
1151#if defined(KDEBUG) && defined(TEST_OPT_DEBUG_RED)
1152  if (TEST_OPT_DEBUG)
1153  {
1154    Print(" to: "); PR->wrp(); Print("\n");
1155  }
1156#endif
1157  return ret;
1158}
1159
1160/***************************************************************
1161 *
1162 * Creates S-Poly of p1 and p2
1163 *
1164 *
1165 ***************************************************************/
1166void ksCreateSpoly(LObject* Pair,   poly spNoether,
1167                   int use_buckets, ring tailRing,
1168                   poly m1, poly m2, TObject** R)
1169{
1170#ifdef KDEBUG
1171  create_count++;
1172#endif
1173  kTest_L(Pair,tailRing);
1174  poly p1 = Pair->p1;
1175  poly p2 = Pair->p2;
1176  Pair->tailRing = tailRing;
1177
1178  assume(p1 != NULL);
1179  assume(p2 != NULL);
1180  assume(tailRing != NULL);
1181
1182  poly a1 = pNext(p1), a2 = pNext(p2);
1183  number lc1 = pGetCoeff(p1), lc2 = pGetCoeff(p2);
1184  int co=0/*, ct = ksCheckCoeff(&lc1, &lc2, currRing->cf)*/; // gcd and zero divisors
1185  (void) ksCheckCoeff(&lc1, &lc2, currRing->cf);
1186
1187  int l1=0, l2=0;
1188
1189  if (currRing->pCompIndex >= 0)
1190  {
1191    if (__p_GetComp(p1, currRing)!=__p_GetComp(p2, currRing))
1192    {
1193      if (__p_GetComp(p1, currRing)==0)
1194      {
1195        co=1;
1196        p_SetCompP(p1,__p_GetComp(p2, currRing), currRing, tailRing);
1197      }
1198      else
1199      {
1200        co=2;
1201        p_SetCompP(p2, __p_GetComp(p1, currRing), currRing, tailRing);
1202      }
1203    }
1204  }
1205
1206  // get m1 = LCM(LM(p1), LM(p2))/LM(p1)
1207  //     m2 = LCM(LM(p1), LM(p2))/LM(p2)
1208  if (m1 == NULL)
1209    k_GetLeadTerms(p1, p2, currRing, m1, m2, tailRing);
1210
1211#ifdef HAVE_SHIFTBBA
1212  poly m12, m22;
1213  if (tailRing->isLPring)
1214  {
1215    assume(p_mFirstVblock(p1, tailRing) <= 1 || p_mFirstVblock(p2, tailRing) <= 1);
1216    k_SplitFrame(m1, m12, si_max(p_mFirstVblock(p1, tailRing), 1), tailRing);
1217    k_SplitFrame(m2, m22, si_max(p_mFirstVblock(p2, tailRing), 1), tailRing);
1218    // manually free the coeffs, because pSetCoeff0 is used in the next step
1219    n_Delete(&(m1->coef), tailRing->cf);
1220    n_Delete(&(m2->coef), tailRing->cf);
1221  }
1222#endif
1223
1224  pSetCoeff0(m1, lc2);
1225  pSetCoeff0(m2, lc1);  // and now, m1 * LT(p1) == m2 * LT(p2)
1226
1227  if (R != NULL)
1228  {
1229    if (Pair->i_r1 == -1)
1230    {
1231      l1 = pLength(p1) - 1;
1232    }
1233    else
1234    {
1235      l1 = (R[Pair->i_r1])->GetpLength() - 1;
1236    }
1237    if ((Pair->i_r2 == -1)||(R[Pair->i_r2]==NULL))
1238    {
1239      l2 = pLength(p2) - 1;
1240    }
1241    else
1242    {
1243      l2 = (R[Pair->i_r2])->GetpLength() - 1;
1244    }
1245  }
1246
1247  // get m2 * a2
1248  if (spNoether != NULL)
1249  {
1250    l2 = -1;
1251    a2 = tailRing->p_Procs->pp_Mult_mm_Noether(a2, m2, spNoether, l2, tailRing);
1252    assume(l2 == pLength(a2));
1253  }
1254  else
1255#ifdef HAVE_SHIFTBBA
1256    if (tailRing->isLPring)
1257    {
1258      // m2*a2*m22
1259      a2 = tailRing->p_Procs->pp_Mult_mm(tailRing->p_Procs->pp_mm_Mult(a2, m2, tailRing), m22, tailRing);
1260    }
1261    else
1262#endif
1263    {
1264      a2 = tailRing->p_Procs->pp_Mult_mm(a2, m2, tailRing);
1265    }
1266#ifdef HAVE_RINGS
1267  if (!(rField_is_Domain(currRing))) l2 = pLength(a2);
1268#endif
1269
1270  Pair->SetLmTail(m2, a2, l2, use_buckets, tailRing);
1271
1272#ifdef HAVE_SHIFTBBA
1273  if (tailRing->isLPring)
1274  {
1275    // get m2*a2*m22 - m1*a1*m12
1276    Pair->Tail_Minus_mm_Mult_qq(m1, tailRing->p_Procs->pp_Mult_mm(a1, m12, tailRing), l1, spNoether);
1277  }
1278  else
1279#endif
1280  {
1281    // get m2*a2 - m1*a1
1282    Pair->Tail_Minus_mm_Mult_qq(m1, a1, l1, spNoether);
1283  }
1284
1285  // Clean-up time
1286  Pair->LmDeleteAndIter();
1287  p_LmDelete(m1, tailRing);
1288#ifdef HAVE_SHIFTBBA
1289  if (tailRing->isLPring)
1290  {
1291    // just to be sure, check that the shift is correct
1292    assume(Pair->shift == 0);
1293    assume(si_max(p_mFirstVblock(Pair->p, tailRing) - 1, 0) == Pair->shift); // == 0
1294
1295    p_LmDelete(m12, tailRing);
1296    p_LmDelete(m22, tailRing);
1297    // m2 is already deleted
1298  }
1299#endif
1300
1301  if (co != 0)
1302  {
1303    if (co==1)
1304    {
1305      p_SetCompP(p1,0, currRing, tailRing);
1306    }
1307    else
1308    {
1309      p_SetCompP(p2,0, currRing, tailRing);
1310    }
1311  }
1312}
1313
1314int ksReducePolyTail(LObject* PR, TObject* PW, poly Current, poly spNoether)
1315{
1316  BOOLEAN ret;
1317  number coef;
1318  poly Lp =     PR->GetLmCurrRing();
1319  poly Save =   PW->GetLmCurrRing();
1320
1321  kTest_L(PR,PR->tailRing);
1322  kTest_T(PW);
1323  pAssume(pIsMonomOf(Lp, Current));
1324
1325  assume(Lp != NULL && Current != NULL && pNext(Current) != NULL);
1326  assume(PR->bucket == NULL);
1327
1328  LObject Red(pNext(Current), PR->tailRing);
1329  TObject With(PW, Lp == Save);
1330
1331  pAssume(!pHaveCommonMonoms(Red.p, With.p));
1332  ret = ksReducePoly(&Red, &With, spNoether, &coef);
1333
1334  if (!ret)
1335  {
1336    if (! n_IsOne(coef, currRing->cf))
1337    {
1338      pNext(Current) = NULL;
1339      if (Current == PR->p && PR->t_p != NULL)
1340        pNext(PR->t_p) = NULL;
1341      PR->Mult_nn(coef);
1342    }
1343
1344    n_Delete(&coef, currRing->cf);
1345    pNext(Current) = Red.GetLmTailRing();
1346    if (Current == PR->p && PR->t_p != NULL)
1347      pNext(PR->t_p) = pNext(Current);
1348  }
1349
1350  if (Lp == Save)
1351    With.Delete();
1352
1353  return ret;
1354}
1355
1356int ksReducePolyTailBound(LObject* PR, TObject* PW, int bound, poly Current, poly spNoether)
1357{
1358  BOOLEAN ret;
1359  number coef;
1360  poly Lp =     PR->GetLmCurrRing();
1361  poly Save =   PW->GetLmCurrRing();
1362
1363  kTest_L(PR,PR->tailRing);
1364  kTest_T(PW);
1365  pAssume(pIsMonomOf(Lp, Current));
1366
1367  assume(Lp != NULL && Current != NULL && pNext(Current) != NULL);
1368  assume(PR->bucket == NULL);
1369
1370  LObject Red(pNext(Current), PR->tailRing);
1371  TObject With(PW, Lp == Save);
1372
1373  pAssume(!pHaveCommonMonoms(Red.p, With.p));
1374  ret = ksReducePolyBound(&Red, &With,bound, spNoether, &coef);
1375
1376  if (!ret)
1377  {
1378    if (! n_IsOne(coef, currRing))
1379    {
1380      pNext(Current) = NULL;
1381      if (Current == PR->p && PR->t_p != NULL)
1382        pNext(PR->t_p) = NULL;
1383      PR->Mult_nn(coef);
1384    }
1385
1386    n_Delete(&coef, currRing);
1387    pNext(Current) = Red.GetLmTailRing();
1388    if (Current == PR->p && PR->t_p != NULL)
1389      pNext(PR->t_p) = pNext(Current);
1390  }
1391
1392  if (Lp == Save)
1393    With.Delete();
1394
1395  return ret;
1396}
1397
1398/***************************************************************
1399 *
1400 * Auxillary Routines
1401 *
1402 *
1403 ***************************************************************/
1404
1405/*2
1406* creates the leading term of the S-polynomial of p1 and p2
1407* do not destroy p1 and p2
1408* remarks:
1409*   1. the coefficient is 0 (p_Init)
1410*   1. a) in the case of coefficient ring, the coefficient is calculated
1411*   2. pNext is undefined
1412*/
1413//static void bbb() { int i=0; }
1414poly ksCreateShortSpoly(poly p1, poly p2, ring tailRing)
1415{
1416  poly a1 = pNext(p1), a2 = pNext(p2);
1417#ifdef HAVE_SHIFTBBA
1418  int shift1, shift2;
1419  if (tailRing->isLPring)
1420  {
1421    // assume: LM is shifted, tail unshifted
1422    assume(p_FirstVblock(a1, tailRing) <= 1);
1423    assume(p_FirstVblock(a2, tailRing) <= 1);
1424    // save the shift of the LM so we can shift the other monomials on demand
1425    shift1 = p_mFirstVblock(p1, tailRing) - 1;
1426    shift2 = p_mFirstVblock(p2, tailRing) - 1;
1427  }
1428#endif
1429  long c1=p_GetComp(p1, currRing),c2=p_GetComp(p2, currRing);
1430  long c;
1431  poly m1,m2;
1432  number t1 = NULL,t2 = NULL;
1433  int cm,i;
1434  BOOLEAN equal;
1435
1436#ifdef HAVE_RINGS
1437  BOOLEAN is_Ring=rField_is_Ring(currRing);
1438  number lc1 = pGetCoeff(p1), lc2 = pGetCoeff(p2);
1439  if (is_Ring)
1440  {
1441    ksCheckCoeff(&lc1, &lc2, currRing->cf); // gcd and zero divisors
1442    if (a1 != NULL) t2 = nMult(pGetCoeff(a1),lc2);
1443    if (a2 != NULL) t1 = nMult(pGetCoeff(a2),lc1);
1444    while (a1 != NULL && nIsZero(t2))
1445    {
1446      pIter(a1);
1447      nDelete(&t2);
1448      if (a1 != NULL) t2 = nMult(pGetCoeff(a1),lc2);
1449    }
1450    while (a2 != NULL && nIsZero(t1))
1451    {
1452      pIter(a2);
1453      nDelete(&t1);
1454      if (a2 != NULL) t1 = nMult(pGetCoeff(a2),lc1);
1455    }
1456  }
1457#endif
1458
1459#ifdef HAVE_SHIFTBBA
1460  // shift the next monomial on demand
1461  if (tailRing->isLPring)
1462  {
1463    a1 = p_LPCopyAndShiftLM(a1, shift1, tailRing);
1464    a2 = p_LPCopyAndShiftLM(a2, shift2, tailRing);
1465  }
1466#endif
1467  if (a1==NULL)
1468  {
1469    if(a2!=NULL)
1470    {
1471      m2=p_Init(currRing);
1472x2:
1473      for (i = (currRing->N); i; i--)
1474      {
1475        c = p_GetExpDiff(p1, p2,i, currRing);
1476        if (c>0)
1477        {
1478          p_SetExp(m2,i,(c+p_GetExp(a2,i,tailRing)),currRing);
1479        }
1480        else
1481        {
1482          p_SetExp(m2,i,p_GetExp(a2,i,tailRing),currRing);
1483        }
1484      }
1485      if ((c1==c2)||(c2!=0))
1486      {
1487        p_SetComp(m2,p_GetComp(a2,tailRing), currRing);
1488      }
1489      else
1490      {
1491        p_SetComp(m2,c1,currRing);
1492      }
1493      p_Setm(m2, currRing);
1494#ifdef HAVE_RINGS
1495      if (is_Ring)
1496      {
1497          nDelete(&lc1);
1498          nDelete(&lc2);
1499          nDelete(&t2);
1500          pSetCoeff0(m2, t1);
1501      }
1502#endif
1503      return m2;
1504    }
1505    else
1506    {
1507#ifdef HAVE_RINGS
1508      if (is_Ring)
1509      {
1510        nDelete(&lc1);
1511        nDelete(&lc2);
1512        nDelete(&t1);
1513        nDelete(&t2);
1514      }
1515#endif
1516      return NULL;
1517    }
1518  }
1519  if (a2==NULL)
1520  {
1521    m1=p_Init(currRing);
1522x1:
1523    for (i = (currRing->N); i; i--)
1524    {
1525      c = p_GetExpDiff(p2, p1,i,currRing);
1526      if (c>0)
1527      {
1528        p_SetExp(m1,i,(c+p_GetExp(a1,i, tailRing)),currRing);
1529      }
1530      else
1531      {
1532        p_SetExp(m1,i,p_GetExp(a1,i, tailRing), currRing);
1533      }
1534    }
1535    if ((c1==c2)||(c1!=0))
1536    {
1537      p_SetComp(m1,p_GetComp(a1,tailRing),currRing);
1538    }
1539    else
1540    {
1541      p_SetComp(m1,c2,currRing);
1542    }
1543    p_Setm(m1, currRing);
1544#ifdef HAVE_RINGS
1545    if (is_Ring)
1546    {
1547      pSetCoeff0(m1, t2);
1548      nDelete(&lc1);
1549      nDelete(&lc2);
1550      nDelete(&t1);
1551    }
1552#endif
1553    return m1;
1554  }
1555  m1 = p_Init(currRing);
1556  m2 = p_Init(currRing);
1557  loop
1558  {
1559    for (i = (currRing->N); i; i--)
1560    {
1561      c = p_GetExpDiff(p1, p2,i,currRing);
1562      if (c > 0)
1563      {
1564        p_SetExp(m2,i,(c+p_GetExp(a2,i,tailRing)), currRing);
1565        p_SetExp(m1,i,p_GetExp(a1,i, tailRing), currRing);
1566      }
1567      else
1568      {
1569        p_SetExp(m1,i,(p_GetExp(a1,i,tailRing)-c), currRing);
1570        p_SetExp(m2,i,p_GetExp(a2,i, tailRing), currRing);
1571      }
1572    }
1573    if(c1==c2)
1574    {
1575      p_SetComp(m1,p_GetComp(a1, tailRing), currRing);
1576      p_SetComp(m2,p_GetComp(a2, tailRing), currRing);
1577    }
1578    else
1579    {
1580      if(c1!=0)
1581      {
1582        p_SetComp(m1,p_GetComp(a1, tailRing), currRing);
1583        p_SetComp(m2,c1, currRing);
1584      }
1585      else
1586      {
1587        p_SetComp(m2,p_GetComp(a2, tailRing), currRing);
1588        p_SetComp(m1,c2, currRing);
1589      }
1590    }
1591    p_Setm(m1,currRing);
1592    p_Setm(m2,currRing);
1593    cm = p_LmCmp(m1, m2,currRing);
1594    if (cm!=0)
1595    {
1596      if(cm==1)
1597      {
1598        p_LmFree(m2,currRing);
1599#ifdef HAVE_RINGS
1600        if (is_Ring)
1601        {
1602          pSetCoeff0(m1, t2);
1603          nDelete(&lc1);
1604          nDelete(&lc2);
1605          nDelete(&t1);
1606        }
1607#endif
1608        return m1;
1609      }
1610      else
1611      {
1612        p_LmFree(m1,currRing);
1613#ifdef HAVE_RINGS
1614        if (is_Ring)
1615        {
1616          pSetCoeff0(m2, t1);
1617          nDelete(&lc1);
1618          nDelete(&lc2);
1619          nDelete(&t2);
1620        }
1621#endif
1622        return m2;
1623      }
1624    }
1625#ifdef HAVE_RINGS
1626    if (is_Ring)
1627    {
1628      equal = nEqual(t1,t2);
1629    }
1630    else
1631#endif
1632    {
1633      t1 = nMult(pGetCoeff(a2),pGetCoeff(p1));
1634      t2 = nMult(pGetCoeff(a1),pGetCoeff(p2));
1635      equal = nEqual(t1,t2);
1636      nDelete(&t2);
1637      nDelete(&t1);
1638    }
1639    if (!equal)
1640    {
1641      p_LmFree(m2,currRing);
1642#ifdef HAVE_RINGS
1643      if (is_Ring)
1644      {
1645          pSetCoeff0(m1, nSub(t1, t2));
1646          nDelete(&lc1);
1647          nDelete(&lc2);
1648          nDelete(&t1);
1649          nDelete(&t2);
1650      }
1651#endif
1652      return m1;
1653    }
1654    pIter(a1);
1655    pIter(a2);
1656#ifdef HAVE_RINGS
1657    if (is_Ring)
1658    {
1659      if (a2 != NULL)
1660      {
1661        nDelete(&t1);
1662        t1 = nMult(pGetCoeff(a2),lc1);
1663      }
1664      if (a1 != NULL)
1665      {
1666        nDelete(&t2);
1667        t2 = nMult(pGetCoeff(a1),lc2);
1668      }
1669      while ((a1 != NULL) && nIsZero(t2))
1670      {
1671        pIter(a1);
1672        if (a1 != NULL)
1673        {
1674          nDelete(&t2);
1675          t2 = nMult(pGetCoeff(a1),lc2);
1676        }
1677      }
1678      while ((a2 != NULL) && nIsZero(t1))
1679      {
1680        pIter(a2);
1681        if (a2 != NULL)
1682        {
1683          nDelete(&t1);
1684          t1 = nMult(pGetCoeff(a2),lc1);
1685        }
1686      }
1687    }
1688#endif
1689#ifdef HAVE_SHIFTBBA
1690    if (tailRing->isLPring)
1691    {
1692      a1 = p_LPCopyAndShiftLM(a1, shift1, tailRing);
1693      a2 = p_LPCopyAndShiftLM(a2, shift2, tailRing);
1694    }
1695#endif
1696    if (a2==NULL)
1697    {
1698      p_LmFree(m2,currRing);
1699      if (a1==NULL)
1700      {
1701#ifdef HAVE_RINGS
1702        if (is_Ring)
1703        {
1704          nDelete(&lc1);
1705          nDelete(&lc2);
1706          nDelete(&t1);
1707          nDelete(&t2);
1708        }
1709#endif
1710        p_LmFree(m1,currRing);
1711        return NULL;
1712      }
1713      goto x1;
1714    }
1715    if (a1==NULL)
1716    {
1717      p_LmFree(m1,currRing);
1718      goto x2;
1719    }
1720  }
1721}
Note: See TracBrowser for help on using the repository browser.