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

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