source: git/polys/polys.cc @ a98f56

spielwiese
Last change on this file since a98f56 was a98f56, checked in by Hans Schoenemann <hannes@…>, 14 years ago
selection of operations on polys
  • Property mode set to 100644
File size: 19.4 KB
RevLine 
[35aab3]1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
[341696]4/* $Id$ */
[35aab3]5
6/*
7* ABSTRACT - all basic methods to manipulate polynomials
8*/
9
10/* includes */
11#include <stdio.h>
12#include <string.h>
13#include <ctype.h>
[599326]14#include <kernel/mod2.h>
15#include <kernel/options.h>
[b1dfaf]16#include <omalloc/omalloc.h>
[599326]17#include <kernel/febase.h>
18#include <kernel/numbers.h>
19#include <kernel/polys.h>
20#include <kernel/ring.h>
21#include <kernel/sbuckets.h>
[35aab3]22
[68349d]23#ifdef HAVE_PLURAL
[599326]24#include <kernel/gring.h>
25#include <kernel/sca.h>
[68349d]26#endif
27
[35aab3]28/* ----------- global variables, set by pSetGlobals --------------------- */
29/* computes length and maximal degree of a POLYnomial */
30pLDegProc pLDeg;
31/* computes the degree of the initial term, used for std */
32pFDegProc pFDeg;
33/* the monomial ordering of the head monomials a and b */
34/* returns -1 if a comes before b, 0 if a=b, 1 otherwise */
35
36int pVariables;     // number of variables
37
38/* 1 for polynomial ring, -1 otherwise */
39int     pOrdSgn;
40// it is of type int, not BOOLEAN because it is also in ip
41/* TRUE if the monomial ordering is not compatible with pFDeg */
42BOOLEAN pLexOrder;
43
44/* ----------- global variables, set by procedures from hecke/kstd1 ----- */
45/* the highest monomial below pHEdge */
46poly      ppNoether = NULL;
47
48/* -------------------------------------------------------- */
49/*2
50* change all global variables to fit the description of the new ring
51*/
52
53
[8c5988]54void pSetGlobals(const ring r, BOOLEAN complete)
[35aab3]55{
56  if (ppNoether!=NULL) pDelete(&ppNoether);
57  pVariables = r->N;
58  pOrdSgn = r->OrdSgn;
59  pFDeg=r->pFDeg;
60  pLDeg=r->pLDeg;
61  pLexOrder=r->LexOrder;
62
63  if (complete)
64  {
65    test &= ~ TEST_RINGDEP_OPTS;
66    test |= r->options;
67  }
68}
69
70// resets the pFDeg and pLDeg: if pLDeg is not given, it is
71// set to currRing->pLDegOrig, i.e. to the respective LDegProc which
72// only uses pFDeg (and not pDeg, or pTotalDegree, etc)
73void pSetDegProcs(pFDegProc new_FDeg, pLDegProc new_lDeg)
74{
75  assume(new_FDeg != NULL);
76  pFDeg = new_FDeg;
77  currRing->pFDeg = new_FDeg;
78
79  if (new_lDeg == NULL)
80    new_lDeg = currRing->pLDegOrig;
81
82  pLDeg = new_lDeg;
83  currRing->pLDeg = new_lDeg;
84}
85
86
87// restores pFDeg and pLDeg:
88extern void pRestoreDegProcs(pFDegProc old_FDeg, pLDegProc old_lDeg)
89{
90  assume(old_FDeg != NULL && old_lDeg != NULL);
91  pFDeg = old_FDeg;
92  currRing->pFDeg = old_FDeg;
93  pLDeg = old_lDeg;
94  currRing->pLDeg = old_lDeg;
95}
96
97/*2
98* assumes that the head term of b is a multiple of the head term of a
99* and return the multiplicant *m
[a8b44d]100* Frank's observation: If LM(b) = LM(a)*m, then we may actually set
101* negative(!) exponents in the below loop. I suspect that the correct
102* comment should be "assumes that LM(a) = LM(b)*m, for some monomial m..."
[35aab3]103*/
104poly pDivide(poly a, poly b)
105{
[f6c50d]106  assume((pGetComp(a)==pGetComp(b)) || (pGetComp(b)==0));
[35aab3]107  int i;
108  poly result = pInit();
109
110  for(i=(int)pVariables; i; i--)
111    pSetExp(result,i, pGetExp(a,i)- pGetExp(b,i));
112  pSetComp(result, pGetComp(a) - pGetComp(b));
113  pSetm(result);
114  return result;
115}
116
[206e158]117#ifdef HAVE_RINGS   //TODO Oliver
[8251cc]118#define pDiv_nn(p, n)              p_Div_nn(p, n, currRing)
119
120poly p_Div_nn(poly p, const number n, const ring r)
121{
122  pAssume(!n_IsZero(n,r));
123  p_Test(p, r);
124
125  poly q = p;
126  while (p != NULL)
127  {
128    number nc = pGetCoeff(p);
129    pSetCoeff0(p, n_Div(nc, n, r));
130    n_Delete(&nc, r);
131    pIter(p);
132  }
133  p_Test(q, r);
134  return q;
135}
136#endif
137
[a8b44d]138#ifdef HAVE_RINGS
139/* TRUE iff LT(f) | LT(g) */
140BOOLEAN pDivisibleByRingCase(poly f, poly g)
141{
142  int exponent;
143  for(int i = (int)pVariables; i; i--)
144  {
145    exponent = pGetExp(g, i) - pGetExp(f, i);
146    if (exponent < 0) return FALSE;
147  }
148  return nDivBy(pGetCoeff(g), pGetCoeff(f));
149}
150#endif
151
[35aab3]152/*2
153* divides a by the monomial b, ignores monomials which are not divisible
[2b17ec]154* assumes that b is not NULL, destroys b
[35aab3]155*/
156poly pDivideM(poly a, poly b)
157{
[2b17ec]158  if (a==NULL) { pDelete(&b); return NULL; }
[35aab3]159  poly result=a;
160  poly prev=NULL;
161  int i;
[009d80]162#ifdef HAVE_RINGS
163  number inv=pGetCoeff(b);
[8251cc]164#else
[35aab3]165  number inv=nInvers(pGetCoeff(b));
[8251cc]166#endif
[35aab3]167
168  while (a!=NULL)
169  {
170    if (pDivisibleBy(b,a))
171    {
[f6c50d]172      assume((pGetComp(a)==pGetComp(b)) || (pGetComp(b)==0));
[35aab3]173      for(i=(int)pVariables; i; i--)
174         pSubExp(a,i, pGetExp(b,i));
175      pSubComp(a, pGetComp(b));
176      pSetm(a);
177      prev=a;
178      pIter(a);
179    }
180    else
181    {
182      if (prev==NULL)
183      {
[fb82895]184        pLmDelete(&result);
[35aab3]185        a=result;
186      }
187      else
188      {
[fb82895]189        pLmDelete(&pNext(prev));
[35aab3]190        a=pNext(prev);
191      }
192    }
193  }
[009d80]194#ifdef HAVE_RINGS
[b547dc]195  if (nIsUnit(inv))
196  {
[ec1744b]197    inv = nInvers(inv);
[b547dc]198    pMult_nn(result,inv);
199    nDelete(&inv);
200  }
201  else
202  {
203    pDiv_nn(result,inv);
204  }
[009d80]205#else
[35aab3]206  pMult_nn(result,inv);
207  nDelete(&inv);
[b1f3b55]208#endif
[35aab3]209  pDelete(&b);
210  return result;
211}
212
213/*2
214* returns the LCM of the head terms of a and b in *m
215*/
216void pLcm(poly a, poly b, poly m)
217{
218  int i;
219  for (i=pVariables; i; i--)
220  {
221    pSetExp(m,i, si_max( pGetExp(a,i), pGetExp(b,i)));
222  }
223  pSetComp(m, si_max(pGetComp(a), pGetComp(b)));
224  /* Don't do a pSetm here, otherwise hres/lres chockes */
225}
226
227/*2
228* convert monomial given as string to poly, e.g. 1x3y5z
229*/
[107986]230const char * p_Read(const char *st, poly &rc, const ring r)
[35aab3]231{
232  if (r==NULL) { rc=NULL;return st;}
233  int i,j;
234  rc = p_Init(r);
[85e68dd]235  const char *s = r->cf->nRead(st,&(rc->coef));
[35aab3]236  if (s==st)
237  /* i.e. it does not start with a coeff: test if it is a ringvar*/
238  {
239    j = r_IsRingVar(s,r);
240    if (j >= 0)
241    {
242      p_IncrExp(rc,1+j,r);
243      while (*s!='\0') s++;
244      goto done;
245    }
246  }
247  while (*s!='\0')
248  {
249    char ss[2];
250    ss[0] = *s++;
251    ss[1] = '\0';
252    j = r_IsRingVar(ss,r);
253    if (j >= 0)
254    {
[85e68dd]255      const char *s_save=s;
[35aab3]256      s = eati(s,&i);
[ded4ee]257      if (((unsigned long)i) >  r->bitmask)
258      {
[9b10a76]259        // exponent to large: it is not a monomial
[beef52]260        p_LmDelete(&rc,r);
[ded4ee]261        return s_save;
262      }
[0b5e3d]263      p_AddExp(rc,1+j, (long)i, r);
[35aab3]264    }
265    else
266    {
[b529d9]267      // 1st char of is not a varname
[beef52]268      p_LmDelete(&rc,r);
[35aab3]269      s--;
270      return s;
271    }
272  }
273done:
[beef52]274  if (r->cf->nIsZero(pGetCoeff(rc))) p_LmDelete(&rc,r);
[35aab3]275  else
276  {
[5d7a3b]277#ifdef HAVE_PLURAL
[9b10a76]278    // in super-commutative ring
279    // squares of anti-commutative variables are zeroes!
280    if(rIsSCA(r))
281    {
282      const unsigned int iFirstAltVar = scaFirstAltVar(r);
283      const unsigned int iLastAltVar  = scaLastAltVar(r);
284
285      assume(rc != NULL);
286
287      for(unsigned int k = iFirstAltVar; k <= iLastAltVar; k++)
288        if( p_GetExp(rc, k, r) > 1 )
289        {
[beef52]290          p_LmDelete(&rc, r);
[9b10a76]291          goto finish;
292        }
[5d7a3b]293    }
294#endif
[35aab3]295    p_Setm(rc,r);
296  }
[5dad8b3]297finish:
[35aab3]298  return s;
299}
300
[690e21e]301BOOLEAN _p_Test(poly p, ring r, int level);
[85e68dd]302poly pmInit(const char *st, BOOLEAN &ok)
[35aab3]303{
304  poly p;
[85e68dd]305  const char *s=p_Read(st,p,currRing);
[35aab3]306  if (*s!='\0')
307  {
308    if ((s!=st)&&isdigit(st[0]))
309    {
310      errorreported=TRUE;
311    }
312    ok=FALSE;
313    pDelete(&p);
314    return NULL;
315  }
[690e21e]316  #ifdef PDEBUG
317  _p_Test(p,currRing,PDEBUG);
318  #endif
[35aab3]319  ok=!errorreported;
320  return p;
321}
322
323/*2
324*make p homogeneous by multiplying the monomials by powers of x_varnum
[5ef9d3]325*assume: deg(var(varnum))==1
[35aab3]326*/
327poly pHomogen (poly p, int varnum)
328{
[37318d]329  pFDegProc deg;
330  if (pLexOrder && (currRing->order[0]==ringorder_lp))
[99bdcf]331    deg=p_Totaldegree;
[37318d]332  else
333    deg=pFDeg;
334
[35aab3]335  poly q=NULL, qn;
336  int  o,ii;
337  sBucket_pt bp;
338
339  if (p!=NULL)
340  {
341    if ((varnum < 1) || (varnum > pVariables))
342    {
343      return NULL;
344    }
[37318d]345    o=deg(p,currRing);
[35aab3]346    q=pNext(p);
347    while (q != NULL)
348    {
[37318d]349      ii=deg(q,currRing);
[35aab3]350      if (ii>o) o=ii;
351      pIter(q);
352    }
353    q = pCopy(p);
354    bp = sBucketCreate(currRing);
355    while (q != NULL)
356    {
[37318d]357      ii = o-deg(q,currRing);
[35aab3]358      if (ii!=0)
359      {
[0b5e3d]360        pAddExp(q,varnum, (long)ii);
[35aab3]361        pSetm(q);
362      }
363      qn = pNext(q);
364      pNext(q) = NULL;
365      sBucket_Add_p(bp, q, 1);
366      q = qn;
367    }
368    sBucketDestroyAdd(bp, &q, &ii);
369  }
370  return q;
371}
372
373/*----------utilities for syzygies--------------*/
374poly pTakeOutComp(poly * p, int k)
375{
376  poly q = *p,qq=NULL,result = NULL;
377
378  if (q==NULL) return NULL;
[2b87ac9]379  BOOLEAN use_setmcomp=rOrd_SetCompRequiresSetm(currRing);
[35aab3]380  if (pGetComp(q)==k)
381  {
382    result = q;
[0ef842]383    do
[35aab3]384    {
385      pSetComp(q,0);
[2b87ac9]386      if (use_setmcomp) pSetmComp(q);
[35aab3]387      qq = q;
388      pIter(q);
389    }
[0ef842]390    while ((q!=NULL) && (pGetComp(q)==k));
[35aab3]391    *p = q;
392    pNext(qq) = NULL;
393  }
394  if (q==NULL) return result;
395  if (pGetComp(q) > k)
396  {
[959263]397    pSubComp(q,1);
[2b87ac9]398    if (use_setmcomp) pSetmComp(q);
[35aab3]399  }
400  poly pNext_q;
401  while ((pNext_q=pNext(q))!=NULL)
402  {
403    if (pGetComp(pNext_q)==k)
404    {
405      if (result==NULL)
406      {
407        result = pNext_q;
408        qq = result;
409      }
410      else
411      {
412        pNext(qq) = pNext_q;
413        pIter(qq);
414      }
415      pNext(q) = pNext(pNext_q);
416      pNext(qq) =NULL;
417      pSetComp(qq,0);
[2b87ac9]418      if (use_setmcomp) pSetmComp(qq);
[35aab3]419    }
420    else
421    {
422      /*pIter(q);*/ q=pNext_q;
423      if (pGetComp(q) > k)
424      {
[959263]425        pSubComp(q,1);
[2b87ac9]426        if (use_setmcomp) pSetmComp(q);
[35aab3]427      }
428    }
429  }
430  return result;
431}
432
433// Splits *p into two polys: *q which consists of all monoms with
434// component == comp and *p of all other monoms *lq == pLength(*q)
[0b5e3d]435void pTakeOutComp(poly *r_p, long comp, poly *r_q, int *lq)
[35aab3]436{
437  spolyrec pp, qq;
438  poly p, q, p_prev;
439  int l = 0;
440
441#ifdef HAVE_ASSUME
442  int lp = pLength(*r_p);
443#endif
444
445  pNext(&pp) = *r_p;
446  p = *r_p;
447  p_prev = &pp;
448  q = &qq;
449
450  while(p != NULL)
451  {
452    while (pGetComp(p) == comp)
453    {
454      pNext(q) = p;
455      pIter(q);
456      pSetComp(p, 0);
457      pSetmComp(p);
458      pIter(p);
459      l++;
460      if (p == NULL)
461      {
462        pNext(p_prev) = NULL;
463        goto Finish;
464      }
465    }
466    pNext(p_prev) = p;
467    p_prev = p;
468    pIter(p);
469  }
470
471  Finish:
472  pNext(q) = NULL;
473  *r_p = pNext(&pp);
474  *r_q = pNext(&qq);
475  *lq = l;
476#ifdef HAVE_ASSUME
477  assume(pLength(*r_p) + pLength(*r_q) == lp);
478#endif
479  pTest(*r_p);
480  pTest(*r_q);
481}
482
483#if 1
484poly pTakeOutComp1(poly * p, int k)
485{
486  poly q = *p;
487
488  if (q==NULL) return NULL;
489
490  poly qq=NULL,result = NULL;
491
492  if (pGetComp(q)==k)
493  {
494    result = q; /* *p */
495    while ((q!=NULL) && (pGetComp(q)==k))
496    {
497      pSetComp(q,0);
498      pSetmComp(q);
499      qq = q;
500      pIter(q);
501    }
502    *p = q;
503    pNext(qq) = NULL;
504  }
505  if (q==NULL) return result;
506//  if (pGetComp(q) > k) pGetComp(q)--;
507  while (pNext(q)!=NULL)
508  {
509    if (pGetComp(pNext(q))==k)
510    {
511      if (result==NULL)
512      {
513        result = pNext(q);
514        qq = result;
515      }
516      else
517      {
518        pNext(qq) = pNext(q);
519        pIter(qq);
520      }
521      pNext(q) = pNext(pNext(q));
522      pNext(qq) =NULL;
523      pSetComp(qq,0);
524      pSetmComp(qq);
525    }
526    else
527    {
528      pIter(q);
529//      if (pGetComp(q) > k) pGetComp(q)--;
530    }
531  }
532  return result;
533}
534#endif
535
536void pDeleteComp(poly * p,int k)
537{
538  poly q;
539
[beef52]540  while ((*p!=NULL) && (pGetComp(*p)==k)) pLmDelete(p);
[35aab3]541  if (*p==NULL) return;
542  q = *p;
543  if (pGetComp(q)>k)
544  {
[959263]545    pSubComp(q,1);
[35aab3]546    pSetmComp(q);
547  }
548  while (pNext(q)!=NULL)
549  {
550    if (pGetComp(pNext(q))==k)
[beef52]551      pLmDelete(&(pNext(q)));
[35aab3]552    else
553    {
554      pIter(q);
555      if (pGetComp(q)>k)
556      {
[959263]557        pSubComp(q,1);
[35aab3]558        pSetmComp(q);
559      }
560    }
561  }
562}
563/*----------end of utilities for syzygies--------------*/
564
565/*2
566* pair has no common factor ? or is no polynomial
567*/
568BOOLEAN pHasNotCF(poly p1, poly p2)
569{
570
[1c35568]571  if (pGetComp(p1) > 0 || pGetComp(p2) > 0)
572    return FALSE;
[d2fb9b7]573  int i = pVariables;
[35aab3]574  loop
575  {
576    if ((pGetExp(p1, i) > 0) && (pGetExp(p2, i) > 0))   return FALSE;
[d2fb9b7]577    i--;
578    if (i == 0)                                         return TRUE;
[35aab3]579  }
580}
581
582/*2
[a8b44d]583* divides p1 by its leading coefficient if it is a unit
584* (this will always be true over fields; but not over coefficient rings)
[35aab3]585*/
586void pNorm(poly p1)
587{
[009d80]588#ifdef HAVE_RINGS
589  if (rField_is_Ring(currRing))
[585bbcb]590  {
[a8b44d]591    if (!nIsUnit(pGetCoeff(p1))) return;
[585bbcb]592  }
[f92547]593#endif
[35aab3]594  if (p1!=NULL)
595  {
[5e8fe91]596    if (pNext(p1)==NULL)
597    {
[98938c]598      pSetCoeff(p1,nInit(1));
[5e8fe91]599      return;
600    }
[521349]601    poly h;
[35aab3]602    if (!nIsOne(pGetCoeff(p1)))
603    {
[521349]604      number k, c;
[35aab3]605      nNormalize(pGetCoeff(p1));
[585bbcb]606      k = pGetCoeff(p1);
[35aab3]607      c = nInit(1);
608      pSetCoeff0(p1,c);
609      h = pNext(p1);
610      while (h!=NULL)
611      {
612        c=nDiv(pGetCoeff(h),k);
[7ba059]613        // no need to normalize: Z/p, R
614        // normalize already in nDiv: Q_a, Z/p_a
615        // remains: Q
616        if (rField_is_Q() && (!nIsOne(c))) nNormalize(c);
[35aab3]617        pSetCoeff(h,c);
618        pIter(h);
619      }
620      nDelete(&k);
621    }
622    else
623    {
624      if (nNormalize != nDummy2)
625      {
626        h = pNext(p1);
627        while (h!=NULL)
628        {
629          nNormalize(pGetCoeff(h));
630          pIter(h);
631        }
632      }
633    }
634  }
635}
636
637/*2
638*normalize all coefficients
639*/
[107986]640void p_Normalize(poly p,const ring r)
[35aab3]641{
642  if (rField_has_simple_inverse(r)) return; /* Z/p, GF(p,n), R, long R/C */
643  while (p!=NULL)
644  {
[47b2b2d]645#ifdef LDEBUG
[35aab3]646    if (currRing==r) {nTest(pGetCoeff(p));}
[47b2b2d]647#endif
[35aab3]648    n_Normalize(pGetCoeff(p),r);
649    pIter(p);
650  }
651}
652
653// splits p into polys with Exp(n) == 0 and Exp(n) != 0
654// Poly with Exp(n) != 0 is reversed
655static void pSplitAndReversePoly(poly p, int n, poly *non_zero, poly *zero)
656{
657  if (p == NULL)
658  {
659    *non_zero = NULL;
660    *zero = NULL;
661    return;
662  }
663  spolyrec sz;
664  poly z, n_z, next;
665  z = &sz;
666  n_z = NULL;
667
668  while(p != NULL)
669  {
670    next = pNext(p);
671    if (pGetExp(p, n) == 0)
672    {
673      pNext(z) = p;
674      pIter(z);
675    }
676    else
677    {
678      pNext(p) = n_z;
679      n_z = p;
680    }
681    p = next;
682  }
683  pNext(z) = NULL;
684  *zero = pNext(&sz);
685  *non_zero = n_z;
686  return;
687}
688
689/*3
690* substitute the n-th variable by 1 in p
691* destroy p
692*/
693static poly pSubst1 (poly p,int n)
694{
[788529d]695  poly qq=NULL, result = NULL;
696  poly zero=NULL, non_zero=NULL;
[35aab3]697
698  // reverse, so that add is likely to be linear
699  pSplitAndReversePoly(p, n, &non_zero, &zero);
700
701  while (non_zero != NULL)
702  {
703    assume(pGetExp(non_zero, n) != 0);
704    qq = non_zero;
705    pIter(non_zero);
706    qq->next = NULL;
707    pSetExp(qq,n,0);
708    pSetm(qq);
709    result = pAdd(result,qq);
710  }
711  p = pAdd(result, zero);
712  pTest(p);
713  return p;
714}
715
716/*3
717* substitute the n-th variable by number e in p
718* destroy p
719*/
720static poly pSubst2 (poly p,int n, number e)
721{
722  assume( ! nIsZero(e) );
723  poly qq,result = NULL;
724  number nn, nm;
725  poly zero, non_zero;
726
727  // reverse, so that add is likely to be linear
728  pSplitAndReversePoly(p, n, &non_zero, &zero);
729
730  while (non_zero != NULL)
731  {
732    assume(pGetExp(non_zero, n) != 0);
733    qq = non_zero;
734    pIter(non_zero);
735    qq->next = NULL;
736    nPower(e, pGetExp(qq, n), &nn);
737    nm = nMult(nn, pGetCoeff(qq));
[67dbdb]738#ifdef HAVE_RINGS
739    if (nIsZero(nm))
740    {
741      pLmFree(&qq);
742      nDelete(&nm);
743    }
744    else
745#endif
746    {
747      pSetCoeff(qq, nm);
748      pSetExp(qq, n, 0);
749      pSetm(qq);
750      result = pAdd(result,qq);
751    }
[35aab3]752    nDelete(&nn);
753  }
754  p = pAdd(result, zero);
755  pTest(p);
756  return p;
757}
758
759
760/* delete monoms whose n-th exponent is different from zero */
761poly pSubst0(poly p, int n)
762{
763  spolyrec res;
764  poly h = &res;
765  pNext(h) = p;
766
767  while (pNext(h)!=NULL)
768  {
769    if (pGetExp(pNext(h),n)!=0)
770    {
[beef52]771      pLmDelete(&pNext(h));
[35aab3]772    }
773    else
774    {
775      pIter(h);
776    }
777  }
778  pTest(pNext(&res));
779  return pNext(&res);
780}
781
782/*2
783* substitute the n-th variable by e in p
784* destroy p
785*/
786poly pSubst(poly p, int n, poly e)
787{
788  if (e == NULL) return pSubst0(p, n);
789
790  if (pIsConstant(e))
791  {
792    if (nIsOne(pGetCoeff(e))) return pSubst1(p,n);
793    else return pSubst2(p, n, pGetCoeff(e));
794  }
795
[68349d]796#ifdef HAVE_PLURAL
797  if (rIsPluralRing(currRing))
798  {
799    return nc_pSubst(p,n,e);
800  }
801#endif
802
[35aab3]803  int exponent,i;
804  poly h, res, m;
805  int *me,*ee;
806  number nu,nu1;
807
808  me=(int *)omAlloc((pVariables+1)*sizeof(int));
809  ee=(int *)omAlloc((pVariables+1)*sizeof(int));
810  if (e!=NULL) pGetExpV(e,ee);
811  res=NULL;
812  h=p;
813  while (h!=NULL)
814  {
815    if ((e!=NULL) || (pGetExp(h,n)==0))
816    {
817      m=pHead(h);
818      pGetExpV(m,me);
819      exponent=me[n];
820      me[n]=0;
821      for(i=pVariables;i>0;i--)
822        me[i]+=exponent*ee[i];
823      pSetExpV(m,me);
824      if (e!=NULL)
825      {
826        nPower(pGetCoeff(e),exponent,&nu);
827        nu1=nMult(pGetCoeff(m),nu);
828        nDelete(&nu);
829        pSetCoeff(m,nu1);
830      }
831      res=pAdd(res,m);
832    }
[beef52]833    pLmDelete(&h);
[35aab3]834  }
835  omFreeSize((ADDRESS)me,(pVariables+1)*sizeof(int));
836  omFreeSize((ADDRESS)ee,(pVariables+1)*sizeof(int));
837  return res;
838}
839
[a2466f]840/* Returns TRUE if
841     * LM(p) | LM(lcm)
842     * LC(p) | LC(lcm) only if ring
843     * Exists i, j:
844         * LE(p, i)  != LE(lcm, i)
845         * LE(p1, i) != LE(lcm, i)   ==> LCM(p1, p) != lcm
846         * LE(p, j)  != LE(lcm, j)
847         * LE(p2, j) != LE(lcm, j)   ==> LCM(p2, p) != lcm
848*/
[35aab3]849BOOLEAN pCompareChain (poly p,poly p1,poly p2,poly lcm)
850{
851  int k, j;
852
853  if (lcm==NULL) return FALSE;
854
855  for (j=pVariables; j; j--)
856    if ( pGetExp(p,j) >  pGetExp(lcm,j)) return FALSE;
857  if ( pGetComp(p) !=  pGetComp(lcm)) return FALSE;
858  for (j=pVariables; j; j--)
859  {
860    if (pGetExp(p1,j)!=pGetExp(lcm,j))
861    {
862      if (pGetExp(p,j)!=pGetExp(lcm,j))
863      {
864        for (k=pVariables; k>j; k--)
865        {
866          if ((pGetExp(p,k)!=pGetExp(lcm,k))
867          && (pGetExp(p2,k)!=pGetExp(lcm,k)))
868            return TRUE;
869        }
870        for (k=j-1; k; k--)
871        {
872          if ((pGetExp(p,k)!=pGetExp(lcm,k))
873          && (pGetExp(p2,k)!=pGetExp(lcm,k)))
874            return TRUE;
875        }
876        return FALSE;
877      }
878    }
879    else if (pGetExp(p2,j)!=pGetExp(lcm,j))
880    {
881      if (pGetExp(p,j)!=pGetExp(lcm,j))
882      {
883        for (k=pVariables; k>j; k--)
884        {
885          if ((pGetExp(p,k)!=pGetExp(lcm,k))
886          && (pGetExp(p1,k)!=pGetExp(lcm,k)))
887            return TRUE;
888        }
889        for (k=j-1; k!=0 ; k--)
890        {
891          if ((pGetExp(p,k)!=pGetExp(lcm,k))
892          && (pGetExp(p1,k)!=pGetExp(lcm,k)))
893            return TRUE;
894        }
895        return FALSE;
896      }
897    }
898  }
899  return FALSE;
900}
[27e750]901#ifdef HAVE_RATGRING
[107986]902BOOLEAN pCompareChainPart (poly p,poly p1,poly p2,poly lcm)
903{
904  int k, j;
905
906  if (lcm==NULL) return FALSE;
907
908  for (j=currRing->real_var_end; j>=currRing->real_var_start; j--)
909    if ( pGetExp(p,j) >  pGetExp(lcm,j)) return FALSE;
910  if ( pGetComp(p) !=  pGetComp(lcm)) return FALSE;
911  for (j=currRing->real_var_end; j>=currRing->real_var_start; j--)
912  {
913    if (pGetExp(p1,j)!=pGetExp(lcm,j))
914    {
915      if (pGetExp(p,j)!=pGetExp(lcm,j))
916      {
917        for (k=pVariables; k>j; k--)
918        for (k=currRing->real_var_end; k>j; k--)
919        {
920          if ((pGetExp(p,k)!=pGetExp(lcm,k))
921          && (pGetExp(p2,k)!=pGetExp(lcm,k)))
922            return TRUE;
923        }
924        for (k=j-1; k>=currRing->real_var_start; k--)
925        {
926          if ((pGetExp(p,k)!=pGetExp(lcm,k))
927          && (pGetExp(p2,k)!=pGetExp(lcm,k)))
928            return TRUE;
929        }
930        return FALSE;
931      }
932    }
933    else if (pGetExp(p2,j)!=pGetExp(lcm,j))
934    {
935      if (pGetExp(p,j)!=pGetExp(lcm,j))
936      {
937        for (k=currRing->real_var_end; k>j; k--)
938        {
939          if ((pGetExp(p,k)!=pGetExp(lcm,k))
940          && (pGetExp(p1,k)!=pGetExp(lcm,k)))
941            return TRUE;
942        }
943        for (k=j-1; k>=currRing->real_var_start; k--)
944        {
945          if ((pGetExp(p,k)!=pGetExp(lcm,k))
946          && (pGetExp(p1,k)!=pGetExp(lcm,k)))
947            return TRUE;
948        }
949        return FALSE;
950      }
951    }
952  }
953  return FALSE;
954}
[27e750]955#endif
[7ba059]956
957int pSize(poly p)
958{
959  int count = 0;
960  while ( p != NULL )
961  {
962    count+= nSize( pGetCoeff( p ) );
963    pIter( p );
964  }
965  return count;
966}
967
[48884f2]968/*2
969* returns the length of a (numbers of monomials)
970* respect syzComp
971*/
972poly pLast(poly a, int &l)
973{
974  if (a == NULL)
975  {
976    l = 0;
977    return NULL;
978  }
979  l = 1;
980  if (! rIsSyzIndexRing(currRing))
981  {
982    while (pNext(a)!=NULL)
983    {
984      pIter(a);
985      l++;
986    }
987  }
988  else
989  {
990    int curr_limit = rGetCurrSyzLimit(currRing);
991    poly pp = a;
992    while ((a=pNext(a))!=NULL)
993    {
994      if (pGetComp(a)<=curr_limit/*syzComp*/)
995        l++;
996      else break;
997      pp = a;
998    }
999    a=pp;
1000  }
1001  return a;
1002}
1003
Note: See TracBrowser for help on using the repository browser.