source: git/kernel/polys.cc @ 9b10a76

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