source: git/kernel/polys.cc @ 5dad8b3

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