source: git/kernel/polys.cc @ 68f7027

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