source: git/kernel/polys.cc @ 994445

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