source: git/Singular/polys.cc @ 5ecf042

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