source: git/kernel/kspoly.cc @ 31b00db

spielwiese
Last change on this file since 31b00db was 31b00db, checked in by Christian Eder, 10 years ago
fixes sba tail sreductions for char =/= prime
  • Property mode set to 100644
File size: 20.5 KB
RevLine 
[35aab3]1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5*  ABSTRACT -  Routines for Spoly creation and reductions
6*/
7
8// #define PDEBUG 2
[16f511]9#ifdef HAVE_CONFIG_H
[ba5e9e]10#include "singularconfig.h"
[16f511]11#endif /* HAVE_CONFIG_H */
[599326]12#include <kernel/mod2.h>
[0f401f]13#include <misc/options.h>
[599326]14#include <kernel/kutil.h>
[0f401f]15#include <coeffs/numbers.h>
[210e07]16#include <polys/monomials/p_polys.h>
[76cfef]17#include <polys/templates/p_Procs.h>
[210e07]18#include <polys/nc/nc.h>
[725ef18]19#ifdef KDEBUG
[599326]20#include <kernel/febase.h>
[725ef18]21#endif
[206e158]22#ifdef HAVE_RINGS
[737a68]23#include <kernel/polys.h>
[f92547]24#endif
[35aab3]25
26#ifdef KDEBUG
27int red_count = 0;
28int create_count = 0;
29// define this if reductions are reported on TEST_OPT_DEBUG
[493225]30#define TEST_OPT_DEBUG_RED
[35aab3]31#endif
32
33/***************************************************************
34 *
35 * Reduces PR with PW
36 * Assumes PR != NULL, PW != NULL, Lm(PW) divides Lm(PR)
37 *
38 ***************************************************************/
39int ksReducePoly(LObject* PR,
40                 TObject* PW,
41                 poly spNoether,
42                 number *coef,
43                 kStrategy strat)
44{
45#ifdef KDEBUG
46  red_count++;
47#ifdef TEST_OPT_DEBUG_RED
48  if (TEST_OPT_DEBUG)
49  {
50    Print("Red %d:", red_count); PR->wrp(); Print(" with:");
51    PW->wrp();
52  }
53#endif
54#endif
55  int ret = 0;
56  ring tailRing = PR->tailRing;
[d101b1]57  assume(kTest_L(PR));
58  assume(kTest_T(PW));
[35aab3]59
[cea6f3]60  poly p1 = PR->GetLmTailRing();   // p2 | p1
61  poly p2 = PW->GetLmTailRing();   // i.e. will reduce p1 with p2; lm = LT(p1) / LM(p2)
62  poly t2 = pNext(p2), lm = p1;    // t2 = p2 - LT(p2); really compute P = LC(p2)*p1 - LT(p1)/LM(p2)*p2
63  assume(p1 != NULL && p2 != NULL);// Attention, we have rings and there LC(p2) and LC(p1) are special
[35aab3]64  p_CheckPolyRing(p1, tailRing);
65  p_CheckPolyRing(p2, tailRing);
66
67  pAssume1(p2 != NULL && p1 != NULL &&
68           p_DivisibleBy(p2,  p1, tailRing));
69
70  pAssume1(p_GetComp(p1, tailRing) == p_GetComp(p2, tailRing) ||
71           (p_GetComp(p2, tailRing) == 0 &&
72            p_MaxComp(pNext(p2),tailRing) == 0));
73
[d60626]74#ifdef HAVE_PLURAL
[35aab3]75  if (rIsPluralRing(currRing))
76  {
77    // for the time being: we know currRing==strat->tailRing
[a9c298]78    // no exp-bound checking needed
[35aab3]79    // (only needed if exp-bound(tailring)<exp-b(currRing))
[0a8ee5]80    if (PR->bucket!=NULL)  nc_kBucketPolyRed(PR->bucket, p2,coef);
[a9c298]81    else
[35aab3]82    {
83      poly _p = (PR->t_p != NULL ? PR->t_p : PR->p);
84      assume(_p != NULL);
[073e96]85      nc_PolyPolyRed(_p, p2,coef, currRing);
[35aab3]86      if (PR->t_p!=NULL) PR->t_p=_p; else PR->p=_p;
[073e96]87      PR->pLength=0; // usually not used, GetpLength re-computes it if needed
[35aab3]88    }
89    return 0;
90  }
[d60626]91#endif
[35aab3]92
[cea6f3]93  if (t2==NULL)           // Divisor is just one term, therefore it will
94  {                       // just cancel the leading term
[585bbcb]95    PR->LmDeleteAndIter();
96    if (coef != NULL) *coef = n_Init(1, tailRing);
97    return 0;
98  }
99
[cea6f3]100  p_ExpVectorSub(lm, p2, tailRing); // Calculate the Monomial we must multiply to p2
[585bbcb]101
102  if (tailRing != currRing)
103  {
104    // check that reduction does not violate exp bound
105    while (PW->max != NULL && !p_LmExpVectorAddIsOk(lm, PW->max, tailRing))
106    {
107      // undo changes of lm
108      p_ExpVectorAdd(lm, p2, tailRing);
109      if (strat == NULL) return 2;
110      if (! kStratChangeTailRing(strat, PR, PW)) return -1;
111      tailRing = strat->tailRing;
112      p1 = PR->GetLmTailRing();
113      p2 = PW->GetLmTailRing();
114      t2 = pNext(p2);
115      lm = p1;
116      p_ExpVectorSub(lm, p2, tailRing);
117      ret = 1;
118    }
119  }
120
121  // take care of coef buisness
122  if (! n_IsOne(pGetCoeff(p2), tailRing))
123  {
124    number bn = pGetCoeff(lm);
125    number an = pGetCoeff(p2);
[073e96]126    int ct = ksCheckCoeff(&an, &bn, tailRing->cf);    // Calculate special LC
[cea6f3]127    p_SetCoeff(lm, bn, tailRing);
[585bbcb]128    if ((ct == 0) || (ct == 2))
129      PR->Tail_Mult_nn(an);
130    if (coef != NULL) *coef = an;
131    else n_Delete(&an, tailRing);
132  }
133  else
134  {
135    if (coef != NULL) *coef = n_Init(1, tailRing);
136  }
137
138
139  // and finally,
140  PR->Tail_Minus_mm_Mult_qq(lm, t2, PW->GetpLength() - 1, spNoether);
[cea6f3]141  assume(PW->GetpLength() == pLength(PW->p != NULL ? PW->p : PW->t_p));
[585bbcb]142  PR->LmDeleteAndIter();
[9f5fca]143
144  // the following is commented out: shrinking
145#ifdef HAVE_SHIFTBBA_NONEXISTENT
146  if ( (currRing->isLPring) && (!strat->homog) )
147  {
148    // assume? h->p in currRing
149    PR->GetP();
150    poly qq = p_Shrink(PR->p, currRing->isLPring, currRing);
151    PR->Clear(); // does the right things
[a9c298]152    PR->p = qq;
[9f5fca]153    PR->t_p = NULL;
154    PR->SetShortExpVector();
155  }
156#endif
[a9c298]157
[585bbcb]158#if defined(KDEBUG) && defined(TEST_OPT_DEBUG_RED)
159  if (TEST_OPT_DEBUG)
160  {
161    Print(" to: "); PR->wrp(); Print("\n");
162  }
163#endif
164  return ret;
165}
166
[0758b5]167/***************************************************************
168 *
169 * Reduces PR with PW
170 * Assumes PR != NULL, PW != NULL, Lm(PW) divides Lm(PR)
171 *
172 ***************************************************************/
173int ksReducePolySig(LObject* PR,
174                 TObject* PW,
[2e4ec14]175                 long /*idx*/,
[0758b5]176                 poly spNoether,
177                 number *coef,
178                 kStrategy strat)
179{
180#ifdef KDEBUG
181  red_count++;
182#ifdef TEST_OPT_DEBUG_RED
183  if (TEST_OPT_DEBUG)
184  {
185    Print("Red %d:", red_count); PR->wrp(); Print(" with:");
186    PW->wrp();
187  }
188#endif
189#endif
190  int ret = 0;
191  ring tailRing = PR->tailRing;
[d101b1]192  assume(kTest_L(PR));
193  assume(kTest_T(PW));
[0758b5]194
195  // signature-based stuff:
196  // checking for sig-safeness first
197  // NOTE: This has to be done in the current ring
198  //
199  /**********************************************
200   *
201   * TODO:
202   * --------------------------------------------
[493cf3d]203   * if strat->sbaOrder == 1
[a9c298]204   * Since we are subdividing lower index and
[0758b5]205   * current index reductions it is enough to
206   * look at the polynomial part of the signature
207   * for a check. This should speed-up checking
208   * a lot!
[493cf3d]209   * if !strat->sbaOrder == 0
[0758b5]210   * We are not subdividing lower and current index
211   * due to the fact that we are using the induced
212   * Schreyer order
213   *
[a9c298]214   * nevertheless, this different behaviour is
[0758b5]215   * taken care of by is_sigsafe
216   * => one reduction procedure can be used for
217   * both, the incremental and the non-incremental
218   * attempt!
219   * --------------------------------------------
220   *
221   *********************************************/
222  //printf("COMPARE IDX: %ld -- %ld\n",idx,strat->currIdx);
223  if (!PW->is_sigsafe)
224  {
[f1cef21]225    poly ftmp;
226    ring rtmp;
[31b00db]227    PR->SetLmCurrRing();
228    poly f1 = pCopy(PR->GetLmCurrRing());
229    //PR->GetLm(ftmp,rtmp);
230    //poly f1 = k_LmInit_tailRing_2_currRing(ftmp,rtmp);
[0758b5]231    poly f2 = PW->GetLmCurrRing();
232    poly sigMult = pCopy(PW->sig);   // copy signature of reducer
233    p_ExpVectorSub(f1, f2, currRing); // Calculate the Monomial we must multiply to p2
234//#if 1
235#ifdef DEBUGF5
236    printf("IN KSREDUCEPOLYSIG: \n");
237    pWrite(pHead(f1));
238    pWrite(pHead(f2));
239    pWrite(sigMult);
240    printf("--------------\n");
241#endif
[1179b5]242    sigMult = p_Mult_q(f1,sigMult,currRing);
[0758b5]243//#if 1
244#ifdef DEBUGF5
245    printf("------------------- IN KSREDUCEPOLYSIG: --------------------\n");
246    pWrite(pHead(f1));
247    pWrite(pHead(f2));
248    pWrite(sigMult);
249    pWrite(PR->sig);
250    printf("--------------\n");
251#endif
252    int sigSafe = p_LmCmp(PR->sig,sigMult,currRing);
253    // now we can delete the copied polynomial data used for checking for
254    // sig-safeness of the reduction step
255//#if 1
256#ifdef DEBUGF5
257    printf("%d -- %d sig\n",sigSafe,PW->is_sigsafe);
258
259#endif
[1179b5]260    //pDelete(&f1);
[0758b5]261    pDelete(&sigMult);
262    // go on with the computations only if the signature of p2 is greater than the
263    // signature of fm*p1
264    if(sigSafe != 1)
[a9c298]265    {
[0758b5]266      PR->is_redundant = TRUE;
267      return 3;
268    }
[576f5b]269    //PW->is_sigsafe  = TRUE;
[0758b5]270  }
271  PR->is_redundant = FALSE;
272  poly p1 = PR->GetLmTailRing();   // p2 | p1
273  poly p2 = PW->GetLmTailRing();   // i.e. will reduce p1 with p2; lm = LT(p1) / LM(p2)
274  poly t2 = pNext(p2), lm = p1;    // t2 = p2 - LT(p2); really compute P = LC(p2)*p1 - LT(p1)/LM(p2)*p2
275  assume(p1 != NULL && p2 != NULL);// Attention, we have rings and there LC(p2) and LC(p1) are special
276  p_CheckPolyRing(p1, tailRing);
277  p_CheckPolyRing(p2, tailRing);
278
279  pAssume1(p2 != NULL && p1 != NULL &&
280      p_DivisibleBy(p2,  p1, tailRing));
281
282  pAssume1(p_GetComp(p1, tailRing) == p_GetComp(p2, tailRing) ||
283      (p_GetComp(p2, tailRing) == 0 &&
284       p_MaxComp(pNext(p2),tailRing) == 0));
285
286#ifdef HAVE_PLURAL
287  if (rIsPluralRing(currRing))
288  {
289    // for the time being: we know currRing==strat->tailRing
[a9c298]290    // no exp-bound checking needed
[0758b5]291    // (only needed if exp-bound(tailring)<exp-b(currRing))
292    if (PR->bucket!=NULL)  nc_kBucketPolyRed(PR->bucket, p2,coef);
[a9c298]293    else
[0758b5]294    {
295      poly _p = (PR->t_p != NULL ? PR->t_p : PR->p);
296      assume(_p != NULL);
297      nc_PolyPolyRed(_p, p2, coef, currRing);
298      if (PR->t_p!=NULL) PR->t_p=_p; else PR->p=_p;
299      PR->pLength=0; // usaully not used, GetpLength re-comoutes it if needed
300    }
301    return 0;
302  }
303#endif
304
305  if (t2==NULL)           // Divisor is just one term, therefore it will
306  {                       // just cancel the leading term
307    PR->LmDeleteAndIter();
308    if (coef != NULL) *coef = n_Init(1, tailRing);
309    return 0;
310  }
311
312  p_ExpVectorSub(lm, p2, tailRing); // Calculate the Monomial we must multiply to p2
313
314  if (tailRing != currRing)
315  {
316    // check that reduction does not violate exp bound
317    while (PW->max != NULL && !p_LmExpVectorAddIsOk(lm, PW->max, tailRing))
318    {
319      // undo changes of lm
320      p_ExpVectorAdd(lm, p2, tailRing);
321      if (strat == NULL) return 2;
322      if (! kStratChangeTailRing(strat, PR, PW)) return -1;
323      tailRing = strat->tailRing;
324      p1 = PR->GetLmTailRing();
325      p2 = PW->GetLmTailRing();
326      t2 = pNext(p2);
327      lm = p1;
328      p_ExpVectorSub(lm, p2, tailRing);
329      ret = 1;
330    }
331  }
332
333  // take care of coef buisness
334  if (! n_IsOne(pGetCoeff(p2), tailRing))
335  {
336    number bn = pGetCoeff(lm);
337    number an = pGetCoeff(p2);
338    int ct = ksCheckCoeff(&an, &bn, tailRing->cf);    // Calculate special LC
339    p_SetCoeff(lm, bn, tailRing);
340    if ((ct == 0) || (ct == 2))
341      PR->Tail_Mult_nn(an);
342    if (coef != NULL) *coef = an;
343    else n_Delete(&an, tailRing);
344  }
345  else
346  {
347    if (coef != NULL) *coef = n_Init(1, tailRing);
348  }
349
350
351  // and finally,
352  PR->Tail_Minus_mm_Mult_qq(lm, t2, PW->GetpLength() - 1, spNoether);
353  assume(PW->GetpLength() == pLength(PW->p != NULL ? PW->p : PW->t_p));
354  PR->LmDeleteAndIter();
355
356  // the following is commented out: shrinking
357#ifdef HAVE_SHIFTBBA_NONEXISTENT
358  if ( (currRing->isLPring) && (!strat->homog) )
359  {
360    // assume? h->p in currRing
361    PR->GetP();
362    poly qq = p_Shrink(PR->p, currRing->isLPring, currRing);
363    PR->Clear(); // does the right things
[a9c298]364    PR->p = qq;
[0758b5]365    PR->t_p = NULL;
366    PR->SetShortExpVector();
367  }
368#endif
369
370#if defined(KDEBUG) && defined(TEST_OPT_DEBUG_RED)
371  if (TEST_OPT_DEBUG)
372  {
373    Print(" to: "); PR->wrp(); Print("\n");
374  }
375#endif
376  return ret;
377}
378
[35aab3]379/***************************************************************
380 *
381 * Creates S-Poly of p1 and p2
382 *
383 *
384 ***************************************************************/
385void ksCreateSpoly(LObject* Pair,   poly spNoether,
386                   int use_buckets, ring tailRing,
387                   poly m1, poly m2, TObject** R)
388{
389#ifdef KDEBUG
390  create_count++;
391#endif
[d101b1]392  assume(kTest_L(Pair));
[35aab3]393  poly p1 = Pair->p1;
394  poly p2 = Pair->p2;
395  Pair->tailRing = tailRing;
396
397  assume(p1 != NULL);
398  assume(p2 != NULL);
399  assume(tailRing != NULL);
400
401  poly a1 = pNext(p1), a2 = pNext(p2);
402  number lc1 = pGetCoeff(p1), lc2 = pGetCoeff(p2);
[6909cfb]403  int co=0/*, ct = ksCheckCoeff(&lc1, &lc2, currRing->cf)*/; // gcd and zero divisors
404  (void) ksCheckCoeff(&lc1, &lc2, currRing->cf);
[35aab3]405
406  int l1=0, l2=0;
407
408  if (p_GetComp(p1, currRing)!=p_GetComp(p2, currRing))
409  {
410    if (p_GetComp(p1, currRing)==0)
411    {
412      co=1;
413      p_SetCompP(p1,p_GetComp(p2, currRing), currRing, tailRing);
414    }
415    else
416    {
417      co=2;
418      p_SetCompP(p2, p_GetComp(p1, currRing), currRing, tailRing);
419    }
420  }
421
422  // get m1 = LCM(LM(p1), LM(p2))/LM(p1)
423  //     m2 = LCM(LM(p1), LM(p2))/LM(p2)
424  if (m1 == NULL)
425    k_GetLeadTerms(p1, p2, currRing, m1, m2, tailRing);
426
427  pSetCoeff0(m1, lc2);
428  pSetCoeff0(m2, lc1);  // and now, m1 * LT(p1) == m2 * LT(p2)
429
430  if (R != NULL)
431  {
[51e69e]432    if (Pair->i_r1 == -1)
433    {
434      l1 = pLength(p1) - 1;
435    }
436    else
437    {
438      l1 = (R[Pair->i_r1])->GetpLength() - 1;
439    }
440    if (Pair->i_r2 == -1)
441    {
442      l2 = pLength(p2) - 1;
443    }
444    else
445    {
446      l2 = (R[Pair->i_r2])->GetpLength() - 1;
447    }
[35aab3]448  }
449
450  // get m2 * a2
451  if (spNoether != NULL)
452  {
453    l2 = -1;
[abe5c8]454    a2 = tailRing->p_Procs->pp_Mult_mm_Noether(a2, m2, spNoether, l2, tailRing);
[35aab3]455    assume(l2 == pLength(a2));
456  }
457  else
[abe5c8]458    a2 = tailRing->p_Procs->pp_Mult_mm(a2, m2, tailRing);
[009d80]459#ifdef HAVE_RINGS
[93ebe1]460  if (!(rField_is_Domain(currRing))) l2 = pLength(a2);
[cea6f3]461#endif
462
[f224d85]463  Pair->SetLmTail(m2, a2, l2, use_buckets, tailRing);
[35aab3]464
465  // get m2*a2 - m1*a1
466  Pair->Tail_Minus_mm_Mult_qq(m1, a1, l1, spNoether);
467
468  // Clean-up time
469  Pair->LmDeleteAndIter();
470  p_LmDelete(m1, tailRing);
471
472  if (co != 0)
473  {
474    if (co==1)
475    {
476      p_SetCompP(p1,0, currRing, tailRing);
477    }
478    else
479    {
480      p_SetCompP(p2,0, currRing, tailRing);
481    }
482  }
[9f5fca]483
484  // the following is commented out: shrinking
485#ifdef HAVE_SHIFTBBA_NONEXISTENT
486  if (currRing->isLPring)
487  {
488    // assume? h->p in currRing
489    Pair->GetP();
490    poly qq = p_Shrink(Pair->p, currRing->isLPring, currRing);
491    Pair->Clear(); // does the right things
[a9c298]492    Pair->p = qq;
[9f5fca]493    Pair->t_p = NULL;
494    Pair->SetShortExpVector();
495  }
496#endif
497
[35aab3]498}
499
500int ksReducePolyTail(LObject* PR, TObject* PW, poly Current, poly spNoether)
501{
502  BOOLEAN ret;
503  number coef;
504  poly Lp =     PR->GetLmCurrRing();
505  poly Save =   PW->GetLmCurrRing();
506
[d101b1]507  assume(kTest_L(PR));
508  assume(kTest_T(PW));
[35aab3]509  pAssume(pIsMonomOf(Lp, Current));
510
511  assume(Lp != NULL && Current != NULL && pNext(Current) != NULL);
512  assume(PR->bucket == NULL);
513
514  LObject Red(pNext(Current), PR->tailRing);
515  TObject With(PW, Lp == Save);
516
517  pAssume(!pHaveCommonMonoms(Red.p, With.p));
518  ret = ksReducePoly(&Red, &With, spNoether, &coef);
519
520  if (!ret)
521  {
522    if (! n_IsOne(coef, currRing))
523    {
524      pNext(Current) = NULL;
525      if (Current == PR->p && PR->t_p != NULL)
526        pNext(PR->t_p) = NULL;
527      PR->Mult_nn(coef);
528    }
529
530    n_Delete(&coef, currRing);
531    pNext(Current) = Red.GetLmTailRing();
532    if (Current == PR->p && PR->t_p != NULL)
533      pNext(PR->t_p) = pNext(Current);
534  }
535
536  if (Lp == Save)
537    With.Delete();
[9f5fca]538
539  // the following is commented out: shrinking
540#ifdef HAVE_SHIFTBBA_NONEXISTENT
541  if (currRing->isLPring)
542  {
543    // assume? h->p in currRing
544    PR->GetP();
545    poly qq = p_Shrink(PR->p, currRing->isLPring, currRing);
546    PR->Clear(); // does the right things
[a9c298]547    PR->p = qq;
[9f5fca]548    PR->t_p = NULL;
549    PR->SetShortExpVector();
550  }
551#endif
552
[35aab3]553  return ret;
554}
555
556/***************************************************************
557 *
558 * Auxillary Routines
559 *
560 *
561 ***************************************************************/
562
563/*2
564* creates the leading term of the S-polynomial of p1 and p2
565* do not destroy p1 and p2
566* remarks:
567*   1. the coefficient is 0 (nNew)
[f92547]568*   1. a) in the case of coefficient ring, the coefficient is calculated
[35aab3]569*   2. pNext is undefined
570*/
571//static void bbb() { int i=0; }
572poly ksCreateShortSpoly(poly p1, poly p2, ring tailRing)
573{
574  poly a1 = pNext(p1), a2 = pNext(p2);
[0b5e3d]575  long c1=p_GetComp(p1, currRing),c2=p_GetComp(p2, currRing);
576  long c;
[35aab3]577  poly m1,m2;
[a539ad]578  number t1 = NULL,t2 = NULL;
[35aab3]579  int cm,i;
580  BOOLEAN equal;
581
[009d80]582#ifdef HAVE_RINGS
[93ebe1]583  BOOLEAN is_Ring=rField_is_Ring(currRing);
[f92547]584  number lc1 = pGetCoeff(p1), lc2 = pGetCoeff(p2);
[93ebe1]585  if (is_Ring)
[f92547]586  {
[073e96]587    ksCheckCoeff(&lc1, &lc2, currRing->cf); // gcd and zero divisors
[f92547]588    if (a1 != NULL) t2 = nMult(pGetCoeff(a1),lc2);
589    if (a2 != NULL) t1 = nMult(pGetCoeff(a2),lc1);
590    while (a1 != NULL && nIsZero(t2))
591    {
592      pIter(a1);
[a539ad]593      nDelete(&t2);
[f92547]594      if (a1 != NULL) t2 = nMult(pGetCoeff(a1),lc2);
595    }
596    while (a2 != NULL && nIsZero(t1))
597    {
598      pIter(a2);
[a539ad]599      nDelete(&t1);
[f92547]600      if (a2 != NULL) t1 = nMult(pGetCoeff(a2),lc1);
601    }
602  }
603#endif
604
[35aab3]605  if (a1==NULL)
606  {
607    if(a2!=NULL)
608    {
609      m2=p_Init(currRing);
610x2:
[1f637e]611      for (i = (currRing->N); i; i--)
[35aab3]612      {
613        c = p_GetExpDiff(p1, p2,i, currRing);
614        if (c>0)
615        {
616          p_SetExp(m2,i,(c+p_GetExp(a2,i,tailRing)),currRing);
617        }
618        else
619        {
620          p_SetExp(m2,i,p_GetExp(a2,i,tailRing),currRing);
621        }
622      }
623      if ((c1==c2)||(c2!=0))
624      {
625        p_SetComp(m2,p_GetComp(a2,tailRing), currRing);
626      }
627      else
628      {
629        p_SetComp(m2,c1,currRing);
630      }
631      p_Setm(m2, currRing);
[009d80]632#ifdef HAVE_RINGS
[93ebe1]633      if (is_Ring)
[a539ad]634      {
635          nDelete(&lc1);
636          nDelete(&lc2);
637          nDelete(&t2);
[bac8611]638          pSetCoeff0(m2, t1);
[a539ad]639      }
[f92547]640      else
641#endif
642        nNew(&(pGetCoeff(m2)));
[35aab3]643      return m2;
644    }
645    else
[a539ad]646    {
647#ifdef HAVE_RINGS
[725ef18]648      if (is_Ring)
649      {
650        nDelete(&lc1);
651        nDelete(&lc2);
652        nDelete(&t1);
653        nDelete(&t2);
654      }
[a539ad]655#endif
[35aab3]656      return NULL;
[a539ad]657    }
[35aab3]658  }
659  if (a2==NULL)
660  {
661    m1=p_Init(currRing);
662x1:
[1f637e]663    for (i = (currRing->N); i; i--)
[35aab3]664    {
665      c = p_GetExpDiff(p2, p1,i,currRing);
666      if (c>0)
667      {
668        p_SetExp(m1,i,(c+p_GetExp(a1,i, tailRing)),currRing);
669      }
670      else
671      {
672        p_SetExp(m1,i,p_GetExp(a1,i, tailRing), currRing);
673      }
674    }
675    if ((c1==c2)||(c1!=0))
676    {
677      p_SetComp(m1,p_GetComp(a1,tailRing),currRing);
678    }
679    else
680    {
681      p_SetComp(m1,c2,currRing);
682    }
683    p_Setm(m1, currRing);
[009d80]684#ifdef HAVE_RINGS
[93ebe1]685    if (is_Ring)
[a539ad]686    {
687      pSetCoeff0(m1, t2);
688      nDelete(&lc1);
689      nDelete(&lc2);
690      nDelete(&t1);
691    }
[f92547]692    else
693#endif
694      nNew(&(pGetCoeff(m1)));
[35aab3]695    return m1;
696  }
697  m1 = p_Init(currRing);
698  m2 = p_Init(currRing);
[725ef18]699  loop
[35aab3]700  {
[1f637e]701    for (i = (currRing->N); i; i--)
[35aab3]702    {
703      c = p_GetExpDiff(p1, p2,i,currRing);
704      if (c > 0)
705      {
706        p_SetExp(m2,i,(c+p_GetExp(a2,i,tailRing)), currRing);
707        p_SetExp(m1,i,p_GetExp(a1,i, tailRing), currRing);
708      }
709      else
710      {
711        p_SetExp(m1,i,(p_GetExp(a1,i,tailRing)-c), currRing);
712        p_SetExp(m2,i,p_GetExp(a2,i, tailRing), currRing);
713      }
714    }
715    if(c1==c2)
716    {
717      p_SetComp(m1,p_GetComp(a1, tailRing), currRing);
718      p_SetComp(m2,p_GetComp(a2, tailRing), currRing);
719    }
720    else
721    {
722      if(c1!=0)
723      {
724        p_SetComp(m1,p_GetComp(a1, tailRing), currRing);
725        p_SetComp(m2,c1, currRing);
726      }
727      else
728      {
729        p_SetComp(m2,p_GetComp(a2, tailRing), currRing);
730        p_SetComp(m1,c2, currRing);
731      }
732    }
733    p_Setm(m1,currRing);
734    p_Setm(m2,currRing);
735    cm = p_LmCmp(m1, m2,currRing);
736    if (cm!=0)
737    {
738      if(cm==1)
739      {
740        p_LmFree(m2,currRing);
[009d80]741#ifdef HAVE_RINGS
[93ebe1]742        if (is_Ring)
[a539ad]743        {
[bac8611]744          pSetCoeff0(m1, t2);
[a539ad]745          nDelete(&lc1);
746          nDelete(&lc2);
747          nDelete(&t1);
748        }
[e6cbed]749        else
750#endif
751          nNew(&(pGetCoeff(m1)));
[35aab3]752        return m1;
753      }
754      else
755      {
756        p_LmFree(m1,currRing);
[009d80]757#ifdef HAVE_RINGS
[93ebe1]758        if (is_Ring)
[a539ad]759        {
760          pSetCoeff0(m2, t1);
761          nDelete(&lc1);
762          nDelete(&lc2);
763          nDelete(&t2);
764        }
[e6cbed]765        else
766#endif
767          nNew(&(pGetCoeff(m2)));
[35aab3]768        return m2;
769      }
770    }
[009d80]771#ifdef HAVE_RINGS
[93ebe1]772    if (is_Ring)
[f92547]773    {
[a539ad]774      equal = nEqual(t1,t2);
[f92547]775    }
776    else
777#endif
778    {
779      t1 = nMult(pGetCoeff(a2),pGetCoeff(p1));
780      t2 = nMult(pGetCoeff(a1),pGetCoeff(p2));
781      equal = nEqual(t1,t2);
782      nDelete(&t2);
783      nDelete(&t1);
784    }
[35aab3]785    if (!equal)
786    {
787      p_LmFree(m2,currRing);
[009d80]788#ifdef HAVE_RINGS
[93ebe1]789      if (is_Ring)
[a539ad]790      {
791          pSetCoeff0(m1, nSub(t1, t2));
792          nDelete(&lc1);
793          nDelete(&lc2);
794          nDelete(&t1);
795          nDelete(&t2);
796      }
[f92547]797      else
798#endif
799        nNew(&(pGetCoeff(m1)));
[35aab3]800      return m1;
801    }
802    pIter(a1);
803    pIter(a2);
[009d80]804#ifdef HAVE_RINGS
[93ebe1]805    if (is_Ring)
[f92547]806    {
[a539ad]807      if (a2 != NULL)
808      {
809        nDelete(&t1);
810        t1 = nMult(pGetCoeff(a2),lc1);
811      }
812      if (a1 != NULL)
813      {
814        nDelete(&t2);
815        t2 = nMult(pGetCoeff(a1),lc2);
816      }
[93ebe1]817      while ((a1 != NULL) && nIsZero(t2))
[f92547]818      {
819        pIter(a1);
[a539ad]820        if (a1 != NULL)
821        {
822          nDelete(&t2);
823          t2 = nMult(pGetCoeff(a1),lc2);
824        }
[f92547]825      }
[93ebe1]826      while ((a2 != NULL) && nIsZero(t1))
[f92547]827      {
828        pIter(a2);
[a539ad]829        if (a2 != NULL)
830        {
831          nDelete(&t1);
832          t1 = nMult(pGetCoeff(a2),lc1);
833        }
[f92547]834      }
835    }
836#endif
[35aab3]837    if (a2==NULL)
838    {
839      p_LmFree(m2,currRing);
840      if (a1==NULL)
841      {
[a539ad]842#ifdef HAVE_RINGS
[93ebe1]843        if (is_Ring)
[a539ad]844        {
845          nDelete(&lc1);
846          nDelete(&lc2);
847          nDelete(&t1);
848          nDelete(&t2);
849        }
850#endif
[35aab3]851        p_LmFree(m1,currRing);
852        return NULL;
853      }
854      goto x1;
855    }
856    if (a1==NULL)
857    {
858      p_LmFree(m1,currRing);
859      goto x2;
860    }
861  }
862}
Note: See TracBrowser for help on using the repository browser.