source: git/kernel/polys.cc @ b529d9

jengelh-datetimespielwiese
Last change on this file since b529d9 was b529d9, checked in by Hans Schönemann <hannes@…>, 16 years ago
*hannes: p_Read git-svn-id: file:///usr/local/Singular/svn/trunk@10228 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 18.9 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: polys.cc,v 1.23 2007-07-23 13:58:56 Singular 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    p_Setm(rc,r);
249  }
250  return s;
251}
252
253poly pmInit(char *st, BOOLEAN &ok)
254{
255  poly p;
256  char *s=p_Read(st,p,currRing);
257  if (*s!='\0')
258  {
259    if ((s!=st)&&isdigit(st[0]))
260    {
261      errorreported=TRUE;
262    }
263    ok=FALSE;
264    pDelete(&p);
265    return NULL;
266  }
267  ok=!errorreported;
268  return p;
269}
270
271/*2
272*make p homogeneous by multiplying the monomials by powers of x_varnum
273*assume: deg(var(varnum))==1
274*/
275poly pHomogen (poly p, int varnum)
276{
277  poly q=NULL, qn;
278  int  o,ii;
279  sBucket_pt bp;
280
281  if (p!=NULL)
282  {
283    if ((varnum < 1) || (varnum > pVariables))
284    {
285      return NULL;
286    }
287    o=pWTotaldegree(p);
288    q=pNext(p);
289    while (q != NULL)
290    {
291      ii=pWTotaldegree(q);
292      if (ii>o) o=ii;
293      pIter(q);
294    }
295    q = pCopy(p);
296    bp = sBucketCreate(currRing);
297    while (q != NULL)
298    {
299      ii = o-pWTotaldegree(q);
300      if (ii!=0)
301      {
302        pAddExp(q,varnum, (Exponent_t)ii);
303        pSetm(q);
304      }
305      qn = pNext(q);
306      pNext(q) = NULL;
307      sBucket_Add_p(bp, q, 1);
308      q = qn;
309    }
310    sBucketDestroyAdd(bp, &q, &ii);
311  }
312  return q;
313}
314
315/*2
316*replaces the maximal powers of the leading monomial of p2 in p1 by
317*the same powers of n, utility for dehomogenization
318*/
319poly pDehomogen (poly p1,poly p2,number n)
320{
321  polyset P;
322  int     SizeOfSet=5;
323  int     i;
324  poly    p;
325  number  nn;
326
327  P = (polyset)omAlloc0(5*sizeof(poly));
328  //for (i=0; i<5; i++)
329  //{
330  //  P[i] = NULL;
331  //}
332  pCancelPolyByMonom(p1,p2,&P,&SizeOfSet);
333  p = P[0];
334  //P[0] = NULL ;// for safety, may be removed later
335  for (i=1; i<SizeOfSet; i++)
336  {
337    if (P[i] != NULL)
338    {
339      nPower(n,i,&nn);
340      pMult_nn(P[i],nn);
341      p = pAdd(p,P[i]);
342      //P[i] =NULL; // for safety, may be removed later
343      nDelete(&nn);
344    }
345  }
346  omFreeSize((ADDRESS)P,SizeOfSet*sizeof(poly));
347  return p;
348}
349
350/*4
351*Returns the exponent of the maximal power of the leading monomial of
352*p2 in that of p1
353*/
354static int pGetMaxPower (poly p1,poly p2)
355{
356  int     i,k,res = 32000; /*a very large integer*/
357
358  if (p1 == NULL) return 0;
359  for (i=1; i<=pVariables; i++)
360  {
361    if ( pGetExp(p2,i) != 0)
362    {
363      k =  pGetExp(p1,i) /  pGetExp(p2,i);
364      if (k < res) res = k;
365    }
366  }
367  return res;
368}
369
370/*2
371*Returns as i-th entry of P the coefficient of the (i-1) power of
372*the leading monomial of p2 in p1
373*/
374void pCancelPolyByMonom (poly p1,poly p2,polyset * P,int * SizeOfSet)
375{
376  int   maxPow;
377  poly  p,qp,Coeff;
378
379  if (*P == NULL)
380  {
381    *P = (polyset) omAlloc(5*sizeof(poly));
382    *SizeOfSet = 5;
383  }
384  p = pCopy(p1);
385  while (p != NULL)
386  {
387    qp = p->next;
388    p->next = NULL;
389    maxPow = pGetMaxPower(p,p2);
390    Coeff = pDivByMonom(p,p2);
391    if (maxPow > *SizeOfSet)
392    {
393      pEnlargeSet(P,*SizeOfSet,maxPow+1-*SizeOfSet);
394      *SizeOfSet = maxPow+1;
395    }
396    (*P)[maxPow] = pAdd((*P)[maxPow],Coeff);
397    pDelete(&p);
398    p = qp;
399  }
400}
401
402/*2
403*returns the leading monomial of p1 divided by the maximal power of that
404*of p2
405*/
406poly pDivByMonom (poly p1,poly p2)
407{
408  int     k, i;
409
410  if (p1 == NULL) return NULL;
411  k = pGetMaxPower(p1,p2);
412  if (k == 0)
413    return pHead(p1);
414  else
415  {
416    number n;
417    poly p = pInit();
418
419    p->next = NULL;
420    for (i=1; i<=pVariables; i++)
421    {
422       pSetExp(p,i, pGetExp(p1,i)-k* pGetExp(p2,i));
423    }
424    nPower(p2->coef,k,&n);
425    pSetCoeff0(p,nDiv(p1->coef,n));
426    nDelete(&n);
427    pSetm(p);
428    return p;
429  }
430}
431/*----------utilities for syzygies--------------*/
432poly pTakeOutComp(poly * p, int k)
433{
434  poly q = *p,qq=NULL,result = NULL;
435
436  if (q==NULL) return NULL;
437  if (pGetComp(q)==k)
438  {
439    result = q;
440    do
441    {
442      pSetComp(q,0);
443      pSetmComp(q);
444      qq = q;
445      pIter(q);
446    }
447    while ((q!=NULL) && (pGetComp(q)==k));
448    *p = q;
449    pNext(qq) = NULL;
450  }
451  if (q==NULL) return result;
452  if (pGetComp(q) > k)
453  {
454    pDecrComp(q);
455    pSetmComp(q);
456  }
457  poly pNext_q;
458  while ((pNext_q=pNext(q))!=NULL)
459  {
460    if (pGetComp(pNext_q)==k)
461    {
462      if (result==NULL)
463      {
464        result = pNext_q;
465        qq = result;
466      }
467      else
468      {
469        pNext(qq) = pNext_q;
470        pIter(qq);
471      }
472      pNext(q) = pNext(pNext_q);
473      pNext(qq) =NULL;
474      pSetComp(qq,0);
475      pSetmComp(qq);
476    }
477    else
478    {
479      /*pIter(q);*/ q=pNext_q;
480      if (pGetComp(q) > k)
481      {
482        pDecrComp(q);
483        pSetmComp(q);
484      }
485    }
486  }
487  return result;
488}
489
490// Splits *p into two polys: *q which consists of all monoms with
491// component == comp and *p of all other monoms *lq == pLength(*q)
492void pTakeOutComp(poly *r_p, Exponent_t comp, poly *r_q, int *lq)
493{
494  spolyrec pp, qq;
495  poly p, q, p_prev;
496  int l = 0;
497
498#ifdef HAVE_ASSUME
499  int lp = pLength(*r_p);
500#endif
501
502  pNext(&pp) = *r_p;
503  p = *r_p;
504  p_prev = &pp;
505  q = &qq;
506
507  while(p != NULL)
508  {
509    while (pGetComp(p) == comp)
510    {
511      pNext(q) = p;
512      pIter(q);
513      pSetComp(p, 0);
514      pSetmComp(p);
515      pIter(p);
516      l++;
517      if (p == NULL)
518      {
519        pNext(p_prev) = NULL;
520        goto Finish;
521      }
522    }
523    pNext(p_prev) = p;
524    p_prev = p;
525    pIter(p);
526  }
527
528  Finish:
529  pNext(q) = NULL;
530  *r_p = pNext(&pp);
531  *r_q = pNext(&qq);
532  *lq = l;
533#ifdef HAVE_ASSUME
534  assume(pLength(*r_p) + pLength(*r_q) == lp);
535#endif
536  pTest(*r_p);
537  pTest(*r_q);
538}
539
540void pDecrOrdTakeOutComp(poly *r_p, Exponent_t comp, Order_t order,
541                         poly *r_q, int *lq)
542{
543  spolyrec pp, qq;
544  poly p, q, p_prev;
545  int l = 0;
546
547  pNext(&pp) = *r_p;
548  p = *r_p;
549  p_prev = &pp;
550  q = &qq;
551
552#ifdef HAVE_ASSUME
553  if (p != NULL)
554  {
555    while (pNext(p) != NULL)
556    {
557      assume(pGetOrder(p) >= pGetOrder(pNext(p)));
558      pIter(p);
559    }
560  }
561  p = *r_p;
562#endif
563
564  while (p != NULL && pGetOrder(p) > order) pIter(p);
565
566  while(p != NULL && pGetOrder(p) == order)
567  {
568    while (pGetComp(p) == comp)
569    {
570      pNext(q) = p;
571      pIter(q);
572      pIter(p);
573      pSetComp(p, 0);
574      pSetmComp(p);
575      l++;
576      if (p == NULL || pGetOrder(p) != order)
577      {
578        pNext(p_prev) = p;
579        goto Finish;
580      }
581    }
582    pNext(p_prev) = p;
583    p_prev = p;
584    pIter(p);
585  }
586
587  Finish:
588  pNext(q) = NULL;
589  *r_p = pNext(&pp);
590  *r_q = pNext(&qq);
591  *lq = l;
592}
593
594#if 1
595poly pTakeOutComp1(poly * p, int k)
596{
597  poly q = *p;
598
599  if (q==NULL) return NULL;
600
601  poly qq=NULL,result = NULL;
602
603  if (pGetComp(q)==k)
604  {
605    result = q; /* *p */
606    while ((q!=NULL) && (pGetComp(q)==k))
607    {
608      pSetComp(q,0);
609      pSetmComp(q);
610      qq = q;
611      pIter(q);
612    }
613    *p = q;
614    pNext(qq) = NULL;
615  }
616  if (q==NULL) return result;
617//  if (pGetComp(q) > k) pGetComp(q)--;
618  while (pNext(q)!=NULL)
619  {
620    if (pGetComp(pNext(q))==k)
621    {
622      if (result==NULL)
623      {
624        result = pNext(q);
625        qq = result;
626      }
627      else
628      {
629        pNext(qq) = pNext(q);
630        pIter(qq);
631      }
632      pNext(q) = pNext(pNext(q));
633      pNext(qq) =NULL;
634      pSetComp(qq,0);
635      pSetmComp(qq);
636    }
637    else
638    {
639      pIter(q);
640//      if (pGetComp(q) > k) pGetComp(q)--;
641    }
642  }
643  return result;
644}
645#endif
646
647void pDeleteComp(poly * p,int k)
648{
649  poly q;
650
651  while ((*p!=NULL) && (pGetComp(*p)==k)) pDeleteLm(p);
652  if (*p==NULL) return;
653  q = *p;
654  if (pGetComp(q)>k)
655  {
656    pDecrComp(q);
657    pSetmComp(q);
658  }
659  while (pNext(q)!=NULL)
660  {
661    if (pGetComp(pNext(q))==k)
662      pDeleteLm(&(pNext(q)));
663    else
664    {
665      pIter(q);
666      if (pGetComp(q)>k)
667      {
668        pDecrComp(q);
669        pSetmComp(q);
670      }
671    }
672  }
673}
674/*----------end of utilities for syzygies--------------*/
675
676/*2
677* pair has no common factor ? or is no polynomial
678*/
679BOOLEAN pHasNotCF(poly p1, poly p2)
680{
681
682  if (!TEST_OPT_IDLIFT)
683  {
684    if (pGetComp(p1) > 0 || pGetComp(p2) > 0)
685      return FALSE;
686  }
687  int i = 1;
688  loop
689  {
690    if ((pGetExp(p1, i) > 0) && (pGetExp(p2, i) > 0))   return FALSE;
691    if (i == pVariables)                                return TRUE;
692    i++;
693  }
694}
695
696/*2
697*divides p1 by its leading coefficient
698*/
699void pNorm(poly p1)
700{
701  poly h;
702  number k, c;
703#ifdef HAVE_RINGS
704  if (rField_is_Ring(currRing))
705  {
706    if ((p1!=NULL) && rField_has_Units(currRing))
707    {
708      k = nGetUnit(pGetCoeff(p1));
709      if (!nIsOne(k))
710      {
711        c = nDiv(pGetCoeff(p1), k);
712        nDelete(&pGetCoeff(p1));
713        pSetCoeff0(p1, c);
714        h = pNext(p1);
715        while (h != NULL)
716        {
717          c = nDiv(pGetCoeff(h), k);
718          nDelete(&pGetCoeff(h));
719          pSetCoeff0(h, c);
720          pIter(h);
721        }
722      }
723      nDelete(&k);
724    }
725    return;
726  }
727  else
728#endif
729  if (p1!=NULL)
730  {
731    if (pNext(p1)==NULL)
732    {
733      pSetCoeff(p1,nInit(1));
734      return;
735    }
736    if (!nIsOne(pGetCoeff(p1)))
737    {
738      nNormalize(pGetCoeff(p1));
739      k = pGetCoeff(p1);
740      c = nInit(1);
741      pSetCoeff0(p1,c);
742      h = pNext(p1);
743      while (h!=NULL)
744      {
745        c=nDiv(pGetCoeff(h),k);
746        if (!nIsOne(c)) nNormalize(c);
747        pSetCoeff(h,c);
748        pIter(h);
749      }
750      nDelete(&k);
751    }
752    else
753    {
754      if (nNormalize != nDummy2)
755      {
756        h = pNext(p1);
757        while (h!=NULL)
758        {
759          nNormalize(pGetCoeff(h));
760          pIter(h);
761        }
762      }
763    }
764  }
765}
766
767/*2
768*normalize all coefficients
769*/
770void p_Normalize(poly p, ring r)
771{
772  if (rField_has_simple_inverse(r)) return; /* Z/p, GF(p,n), R, long R/C */
773  while (p!=NULL)
774  {
775    if (currRing==r) {nTest(pGetCoeff(p));}
776    n_Normalize(pGetCoeff(p),r);
777    pIter(p);
778  }
779}
780
781// splits p into polys with Exp(n) == 0 and Exp(n) != 0
782// Poly with Exp(n) != 0 is reversed
783static void pSplitAndReversePoly(poly p, int n, poly *non_zero, poly *zero)
784{
785  if (p == NULL)
786  {
787    *non_zero = NULL;
788    *zero = NULL;
789    return;
790  }
791  spolyrec sz;
792  poly z, n_z, next;
793  z = &sz;
794  n_z = NULL;
795
796  while(p != NULL)
797  {
798    next = pNext(p);
799    if (pGetExp(p, n) == 0)
800    {
801      pNext(z) = p;
802      pIter(z);
803    }
804    else
805    {
806      pNext(p) = n_z;
807      n_z = p;
808    }
809    p = next;
810  }
811  pNext(z) = NULL;
812  *zero = pNext(&sz);
813  *non_zero = n_z;
814  return;
815}
816
817/*3
818* substitute the n-th variable by 1 in p
819* destroy p
820*/
821static poly pSubst1 (poly p,int n)
822{
823  poly qq=NULL, result = NULL;
824  poly zero=NULL, non_zero=NULL;
825
826  // reverse, so that add is likely to be linear
827  pSplitAndReversePoly(p, n, &non_zero, &zero);
828
829  while (non_zero != NULL)
830  {
831    assume(pGetExp(non_zero, n) != 0);
832    qq = non_zero;
833    pIter(non_zero);
834    qq->next = NULL;
835    pSetExp(qq,n,0);
836    pSetm(qq);
837    result = pAdd(result,qq);
838  }
839  p = pAdd(result, zero);
840  pTest(p);
841  return p;
842}
843
844/*3
845* substitute the n-th variable by number e in p
846* destroy p
847*/
848static poly pSubst2 (poly p,int n, number e)
849{
850  assume( ! nIsZero(e) );
851  poly qq,result = NULL;
852  number nn, nm;
853  poly zero, non_zero;
854
855  // reverse, so that add is likely to be linear
856  pSplitAndReversePoly(p, n, &non_zero, &zero);
857
858  while (non_zero != NULL)
859  {
860    assume(pGetExp(non_zero, n) != 0);
861    qq = non_zero;
862    pIter(non_zero);
863    qq->next = NULL;
864    nPower(e, pGetExp(qq, n), &nn);
865    nm = nMult(nn, pGetCoeff(qq));
866    pSetCoeff(qq, nm);
867    nDelete(&nn);
868    pSetExp(qq, n, 0);
869    pSetm(qq);
870    result = pAdd(result,qq);
871  }
872  p = pAdd(result, zero);
873  pTest(p);
874  return p;
875}
876
877
878/* delete monoms whose n-th exponent is different from zero */
879poly pSubst0(poly p, int n)
880{
881  spolyrec res;
882  poly h = &res;
883  pNext(h) = p;
884
885  while (pNext(h)!=NULL)
886  {
887    if (pGetExp(pNext(h),n)!=0)
888    {
889      pDeleteLm(&pNext(h));
890    }
891    else
892    {
893      pIter(h);
894    }
895  }
896  pTest(pNext(&res));
897  return pNext(&res);
898}
899
900/*2
901* substitute the n-th variable by e in p
902* destroy p
903*/
904poly pSubst(poly p, int n, poly e)
905{
906  if (e == NULL) return pSubst0(p, n);
907
908  if (pIsConstant(e))
909  {
910    if (nIsOne(pGetCoeff(e))) return pSubst1(p,n);
911    else return pSubst2(p, n, pGetCoeff(e));
912  }
913
914#ifdef HAVE_PLURAL
915  if (rIsPluralRing(currRing))
916  {
917    return nc_pSubst(p,n,e);
918  }
919#endif
920
921  int exponent,i;
922  poly h, res, m;
923  int *me,*ee;
924  number nu,nu1;
925
926  me=(int *)omAlloc((pVariables+1)*sizeof(int));
927  ee=(int *)omAlloc((pVariables+1)*sizeof(int));
928  if (e!=NULL) pGetExpV(e,ee);
929  res=NULL;
930  h=p;
931  while (h!=NULL)
932  {
933    if ((e!=NULL) || (pGetExp(h,n)==0))
934    {
935      m=pHead(h);
936      pGetExpV(m,me);
937      exponent=me[n];
938      me[n]=0;
939      for(i=pVariables;i>0;i--)
940        me[i]+=exponent*ee[i];
941      pSetExpV(m,me);
942      if (e!=NULL)
943      {
944        nPower(pGetCoeff(e),exponent,&nu);
945        nu1=nMult(pGetCoeff(m),nu);
946        nDelete(&nu);
947        pSetCoeff(m,nu1);
948      }
949      res=pAdd(res,m);
950    }
951    pDeleteLm(&h);
952  }
953  omFreeSize((ADDRESS)me,(pVariables+1)*sizeof(int));
954  omFreeSize((ADDRESS)ee,(pVariables+1)*sizeof(int));
955  return res;
956}
957
958/* Returns TRUE if
959     * LM(p) | LM(lcm)
960     * LC(p) | LC(lcm) only if ring
961     * Exists i, j:
962         * LE(p, i)  != LE(lcm, i)
963         * LE(p1, i) != LE(lcm, i)   ==> LCM(p1, p) != lcm
964         * LE(p, j)  != LE(lcm, j)
965         * LE(p2, j) != LE(lcm, j)   ==> LCM(p2, p) != lcm
966*/
967BOOLEAN pCompareChain (poly p,poly p1,poly p2,poly lcm)
968{
969  int k, j;
970
971  if (lcm==NULL) return FALSE;
972
973  for (j=pVariables; j; j--)
974    if ( pGetExp(p,j) >  pGetExp(lcm,j)) return FALSE;
975  if ( pGetComp(p) !=  pGetComp(lcm)) return FALSE;
976  for (j=pVariables; j; j--)
977  {
978    if (pGetExp(p1,j)!=pGetExp(lcm,j))
979    {
980      if (pGetExp(p,j)!=pGetExp(lcm,j))
981      {
982        for (k=pVariables; k>j; k--)
983        {
984          if ((pGetExp(p,k)!=pGetExp(lcm,k))
985          && (pGetExp(p2,k)!=pGetExp(lcm,k)))
986            return TRUE;
987        }
988        for (k=j-1; k; k--)
989        {
990          if ((pGetExp(p,k)!=pGetExp(lcm,k))
991          && (pGetExp(p2,k)!=pGetExp(lcm,k)))
992            return TRUE;
993        }
994        return FALSE;
995      }
996    }
997    else if (pGetExp(p2,j)!=pGetExp(lcm,j))
998    {
999      if (pGetExp(p,j)!=pGetExp(lcm,j))
1000      {
1001        for (k=pVariables; k>j; k--)
1002        {
1003          if ((pGetExp(p,k)!=pGetExp(lcm,k))
1004          && (pGetExp(p1,k)!=pGetExp(lcm,k)))
1005            return TRUE;
1006        }
1007        for (k=j-1; k!=0 ; k--)
1008        {
1009          if ((pGetExp(p,k)!=pGetExp(lcm,k))
1010          && (pGetExp(p1,k)!=pGetExp(lcm,k)))
1011            return TRUE;
1012        }
1013        return FALSE;
1014      }
1015    }
1016  }
1017  return FALSE;
1018}
Note: See TracBrowser for help on using the repository browser.