source: git/kernel/polys1.cc @ 8391d8

spielwiese
Last change on this file since 8391d8 was 8391d8, checked in by Hans Schönemann <hannes@…>, 15 years ago
*hannes: n_Init is now ring indep. git-svn-id: file:///usr/local/Singular/svn/trunk@12128 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 35.6 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: polys1.cc,v 1.41 2009-09-24 16:37:42 Singular Exp $ */
5
6/*
7* ABSTRACT - all basic methods to manipulate polynomials:
8* independent of representation
9*/
10
11/* includes */
12#include <string.h>
13#include "mod2.h"
14#include "structs.h"
15#include "numbers.h"
16#include "ffields.h"
17#include "omalloc.h"
18#include "febase.h"
19#include "weight.h"
20#include "intvec.h"
21#include "longalg.h"
22#include "ring.h"
23#include "ideals.h"
24#include "polys.h"
25//#include "ipid.h"
26#ifdef HAVE_FACTORY
27#include "clapsing.h"
28#endif
29
30#ifdef HAVE_RATGRING
31#include "ratgring.h"
32#endif
33
34/*-------- several access procedures to monomials -------------------- */
35/*
36* the module weights for std
37*/
38static pFDegProc pOldFDeg;
39static pLDegProc pOldLDeg;
40static intvec * pModW;
41static BOOLEAN pOldLexOrder;
42
43static long pModDeg(poly p, ring r = currRing)
44{
45  long d=pOldFDeg(p, r);
46  int c=p_GetComp(p, r);
47  if ((c>0) && (pModW->range(c-1))) d+= (*pModW)[c-1];
48  return d;
49  //return pOldFDeg(p, r)+(*pModW)[p_GetComp(p, r)-1];
50}
51
52void pSetModDeg(intvec *w)
53{
54  if (w!=NULL)
55  {
56    pModW = w;
57    pOldFDeg = pFDeg;
58    pOldLDeg = pLDeg;
59    pOldLexOrder = pLexOrder;
60    pSetDegProcs(pModDeg);
61    pLexOrder = TRUE;
62  }
63  else
64  {
65    pModW = NULL;
66    pRestoreDegProcs(pOldFDeg, pOldLDeg);
67    pLexOrder = pOldLexOrder;
68  }
69}
70
71
72/*2
73* subtract p2 from p1, p1 and p2 are destroyed
74* do not put attention on speed: the procedure is only used in the interpreter
75*/
76poly pSub(poly p1, poly p2)
77{
78  return pAdd(p1, pNeg(p2));
79}
80
81/*3
82*  create binomial coef.
83*/
84static number* pnBin(int exp)
85{
86  int e, i, h;
87  number x, y, *bin=NULL;
88
89  x = nInit(exp);
90  if (nIsZero(x))
91  {
92    nDelete(&x);
93    return bin;
94  }
95  h = (exp >> 1) + 1;
96  bin = (number *)omAlloc0(h*sizeof(number));
97  bin[1] = x;
98  if (exp < 4)
99    return bin;
100  i = exp - 1;
101  for (e=2; e<h; e++)
102  {
103      x = nInit(i);
104      i--;
105      y = nMult(x,bin[e-1]);
106      nDelete(&x);
107      x = nInit(e);
108      bin[e] = nIntDiv(y,x);
109      nDelete(&x);
110      nDelete(&y);
111  }
112  return bin;
113}
114
115static void pnFreeBin(number *bin, int exp)
116{
117  int e, h = (exp >> 1) + 1;
118
119  if (bin[1] != NULL)
120  {
121    for (e=1; e<h; e++)
122      nDelete(&(bin[e]));
123  }
124  omFreeSize((ADDRESS)bin, h*sizeof(number));
125}
126
127/*3
128* compute for a monomial m
129* the power m^exp, exp > 1
130* destroys p
131*/
132static poly pMonPower(poly p, int exp)
133{
134  int i;
135
136  if(!nIsOne(pGetCoeff(p)))
137  {
138    number x, y;
139    y = pGetCoeff(p);
140    nPower(y,exp,&x);
141    nDelete(&y);
142    pSetCoeff0(p,x);
143  }
144  for (i=pVariables; i!=0; i--)
145  {
146    pMultExp(p,i, exp);
147  }
148  pSetm(p);
149  return p;
150}
151
152/*3
153* compute for monomials p*q
154* destroys p, keeps q
155*/
156static void pMonMult(poly p, poly q)
157{
158  number x, y;
159  int i;
160
161  y = pGetCoeff(p);
162  x = nMult(y,pGetCoeff(q));
163  nDelete(&y);
164  pSetCoeff0(p,x);
165  //for (i=pVariables; i!=0; i--)
166  //{
167  //  pAddExp(p,i, pGetExp(q,i));
168  //}
169  //p->Order += q->Order;
170  pExpVectorAdd(p,q);
171}
172
173/*3
174* compute for monomials p*q
175* keeps p, q
176*/
177static poly pMonMultC(poly p, poly q)
178{
179  number x;
180  int i;
181  poly r = pInit();
182
183  x = nMult(pGetCoeff(p),pGetCoeff(q));
184  pSetCoeff0(r,x);
185  pExpVectorSum(r,p, q);
186  return r;
187}
188
189/*
190*  compute for a poly p = head+tail, tail is monomial
191*          (head + tail)^exp, exp > 1
192*          with binomial coef.
193*/
194static poly pTwoMonPower(poly p, int exp)
195{
196  int eh, e;
197  long al;
198  poly *a;
199  poly tail, b, res, h;
200  number x;
201  number *bin = pnBin(exp);
202
203  tail = pNext(p);
204  if (bin == NULL)
205  {
206    pMonPower(p,exp);
207    pMonPower(tail,exp);
208#ifdef PDEBUG
209    pTest(p);
210#endif
211    return p;
212  }
213  eh = exp >> 1;
214  al = (exp + 1) * sizeof(poly);
215  a = (poly *)omAlloc(al);
216  a[1] = p;
217  for (e=1; e<exp; e++)
218  {
219    a[e+1] = pMonMultC(a[e],p);
220  }
221  res = a[exp];
222  b = pHead(tail);
223  for (e=exp-1; e>eh; e--)
224  {
225    h = a[e];
226    x = nMult(bin[exp-e],pGetCoeff(h));
227    pSetCoeff(h,x);
228    pMonMult(h,b);
229    res = pNext(res) = h;
230    pMonMult(b,tail);
231  }
232  for (e=eh; e!=0; e--)
233  {
234    h = a[e];
235    x = nMult(bin[e],pGetCoeff(h));
236    pSetCoeff(h,x);
237    pMonMult(h,b);
238    res = pNext(res) = h;
239    pMonMult(b,tail);
240  }
241  pDeleteLm(&tail);
242  pNext(res) = b;
243  pNext(b) = NULL;
244  res = a[exp];
245  omFreeSize((ADDRESS)a, al);
246  pnFreeBin(bin, exp);
247//  tail=res;
248// while((tail!=NULL)&&(pNext(tail)!=NULL))
249// {
250//   if(nIsZero(pGetCoeff(pNext(tail))))
251//   {
252//     pDeleteLm(&pNext(tail));
253//   }
254//   else
255//     pIter(tail);
256// }
257#ifdef PDEBUG
258  pTest(res);
259#endif
260  return res;
261}
262
263static poly pPow(poly p, int i)
264{
265  poly rc = pCopy(p);
266  i -= 2;
267  do
268  {
269    rc = pMult(rc,pCopy(p));
270    pNormalize(rc);
271    i--;
272  }
273  while (i != 0);
274  return pMult(rc,p);
275}
276
277/*2
278* returns the i-th power of p
279* p will be destroyed
280*/
281poly pPower(poly p, int i)
282{
283  poly rc=NULL;
284
285  if (i==0)
286  {
287    pDelete(&p);
288    return pOne();
289  }
290
291  if(p!=NULL)
292  {
293    if ( (i > 0) && ((unsigned long ) i > (currRing->bitmask)))
294    {
295      Werror("exponent %d is too large, max. is %ld",i,currRing->bitmask);
296      return NULL;
297    }
298    switch (i)
299    {
300// cannot happen, see above
301//      case 0:
302//      {
303//        rc=pOne();
304//        pDelete(&p);
305//        break;
306//      }
307      case 1:
308        rc=p;
309        break;
310      case 2:
311        rc=pMult(pCopy(p),p);
312        break;
313      default:
314        if (i < 0)
315        {
316          pDelete(&p);
317          return NULL;
318        }
319        else
320        {
321#ifdef HAVE_PLURAL
322          if (rIsPluralRing(currRing)) /* in the NC case nothing helps :-( */
323          {
324            int j=i;
325            rc = pCopy(p);
326            while (j>1)
327            {
328              rc = pMult(pCopy(p),rc);
329              j--;
330            }
331            pDelete(&p);
332            return rc;
333          }
334#endif
335          rc = pNext(p);
336          if (rc == NULL)
337            return pMonPower(p,i);
338          /* else: binom ?*/
339          int char_p=rChar(currRing);
340          if ((pNext(rc) != NULL)
341#ifdef HAVE_RINGS
342             || rField_is_Ring(currRing)
343#endif
344             )
345            return pPow(p,i);
346          if ((char_p==0) || (i<=char_p))
347            return pTwoMonPower(p,i);
348          poly p_p=pTwoMonPower(pCopy(p),char_p);
349          return pMult(pPower(p,i-char_p),p_p);
350        }
351      /*end default:*/
352    }
353  }
354  return rc;
355}
356
357/*2
358* returns the partial differentiate of a by the k-th variable
359* does not destroy the input
360*/
361poly pDiff(poly a, int k)
362{
363  poly res, f, last;
364  number t;
365
366  last = res = NULL;
367  while (a!=NULL)
368  {
369    if (pGetExp(a,k)!=0)
370    {
371      f = pLmInit(a);
372      t = nInit(pGetExp(a,k));
373      pSetCoeff0(f,nMult(t,pGetCoeff(a)));
374      nDelete(&t);
375      if (nIsZero(pGetCoeff(f)))
376        pDeleteLm(&f);
377      else
378      {
379        pDecrExp(f,k);
380        pSetm(f);
381        if (res==NULL)
382        {
383          res=last=f;
384        }
385        else
386        {
387          pNext(last)=f;
388          last=f;
389        }
390      }
391    }
392    pIter(a);
393  }
394  return res;
395}
396
397static poly pDiffOpM(poly a, poly b,BOOLEAN multiply)
398{
399  int i,j,s;
400  number n,h,hh;
401  poly p=pOne();
402  n=nMult(pGetCoeff(a),pGetCoeff(b));
403  for(i=pVariables;i>0;i--)
404  {
405    s=pGetExp(b,i);
406    if (s<pGetExp(a,i))
407    {
408      nDelete(&n);
409      pDeleteLm(&p);
410      return NULL;
411    }
412    if (multiply)
413    {
414      for(j=pGetExp(a,i); j>0;j--)
415      {
416        h = nInit(s);
417        hh=nMult(n,h);
418        nDelete(&h);
419        nDelete(&n);
420        n=hh;
421        s--;
422      }
423      pSetExp(p,i,s);
424    }
425    else
426    {
427      pSetExp(p,i,s-pGetExp(a,i));
428    }
429  }
430  pSetm(p);
431  /*if (multiply)*/ pSetCoeff(p,n);
432  return p;
433}
434
435poly pDiffOp(poly a, poly b,BOOLEAN multiply)
436{
437  poly result=NULL;
438  poly h;
439  for(;a!=NULL;pIter(a))
440  {
441    for(h=b;h!=NULL;pIter(h))
442    {
443      result=pAdd(result,pDiffOpM(a,h,multiply));
444    }
445  }
446  return result;
447}
448
449
450void pSplit(poly p, poly *h)
451{
452  *h=pNext(p);
453  pNext(p)=NULL;
454}
455
456
457
458int pMaxCompProc(poly p)
459{
460  return pMaxComp(p);
461}
462
463/*2
464* handle memory request for sets of polynomials (ideals)
465* l is the length of *p, increment is the difference (may be negative)
466*/
467void pEnlargeSet(polyset *p, int l, int increment)
468{
469  int i;
470  polyset h;
471
472  h=(polyset)omReallocSize((poly*)*p,l*sizeof(poly),(l+increment)*sizeof(poly));
473  if (increment>0)
474  {
475    //for (i=l; i<l+increment; i++)
476    //  h[i]=NULL;
477    memset(&(h[l]),0,increment*sizeof(poly));
478  }
479  *p=h;
480}
481
482number pInitContent(poly ph);
483number pInitContent_a(poly ph);
484
485void pContent(poly ph)
486{
487#ifdef HAVE_RINGS
488  if (rField_is_Ring(currRing))
489  {
490    if ((ph!=NULL) && rField_has_Units(currRing))
491    {
492      number k = nGetUnit(pGetCoeff(ph));
493      if (!nIsOne(k))
494      {
495        number tmpGMP = k;
496        k = nInvers(k);
497        nDelete(&tmpGMP);
498        poly h = pNext(ph);
499        pSetCoeff(ph, nMult(pGetCoeff(ph), k));
500        while (h != NULL)
501        {
502          pSetCoeff(h, nMult(pGetCoeff(h), k));
503          pIter(h);
504        }
505      }
506      nDelete(&k);
507    }
508    return;
509  }
510#endif
511  number h,d;
512  poly p;
513
514  if(TEST_OPT_CONTENTSB) return;
515  if(pNext(ph)==NULL)
516  {
517    pSetCoeff(ph,nInit(1));
518  }
519  else
520  {
521    nNormalize(pGetCoeff(ph));
522    if(!nGreaterZero(pGetCoeff(ph))) ph = pNeg(ph);
523    if (rField_is_Q())
524    {
525      h=pInitContent(ph);
526      p=ph;
527    }
528    else if ((rField_is_Extension())
529    && ((rPar(currRing)>1)||(currRing->minpoly==NULL)))
530    {
531      h=pInitContent_a(ph);
532      p=ph;
533    }
534    else
535    {
536      h=nCopy(pGetCoeff(ph));
537      p = pNext(ph);
538    }
539    while (p!=NULL)
540    {
541      nNormalize(pGetCoeff(p));
542      d=nGcd(h,pGetCoeff(p),currRing);
543      nDelete(&h);
544      h = d;
545      if(nIsOne(h))
546      {
547        break;
548      }
549      pIter(p);
550    }
551    p = ph;
552    //number tmp;
553    if(!nIsOne(h))
554    {
555      while (p!=NULL)
556      {
557        //d = nDiv(pGetCoeff(p),h);
558        //tmp = nIntDiv(pGetCoeff(p),h);
559        //if (!nEqual(d,tmp))
560        //{
561        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
562        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
563        //  nWrite(tmp);Print(StringAppendS("\n"));
564        //}
565        //nDelete(&tmp);
566        d = nIntDiv(pGetCoeff(p),h);
567        pSetCoeff(p,d);
568        pIter(p);
569      }
570    }
571    nDelete(&h);
572#ifdef HAVE_FACTORY
573    if ( (nGetChar() == 1) || (nGetChar() < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
574    {
575      singclap_divide_content(ph);
576      if(!nGreaterZero(pGetCoeff(ph))) ph = pNeg(ph);
577    }
578#endif
579    if (rField_is_Q_a())
580    {
581      number hzz = nlInit(1, currRing);
582      h = nlInit(1, currRing);
583      p=ph;
584      while (p!=NULL)
585      { // each monom: coeff in Q_a
586        lnumber c_n_n=(lnumber)pGetCoeff(p);
587        napoly c_n=c_n_n->z;
588        while (c_n!=NULL)
589        { // each monom: coeff in Q
590          d=nlLcm(hzz,pGetCoeff(c_n),currRing->algring);
591          n_Delete(&hzz,currRing->algring);
592          hzz=d;
593          pIter(c_n);
594        }
595        c_n=c_n_n->n;
596        while (c_n!=NULL)
597        { // each monom: coeff in Q
598          d=nlLcm(h,pGetCoeff(c_n),currRing->algring);
599          n_Delete(&h,currRing->algring);
600          h=d;
601          pIter(c_n);
602        }
603        pIter(p);
604      }
605      /* hzz contains the 1/lcm of all denominators in c_n_n->z*/
606      /* h contains the 1/lcm of all denominators in c_n_n->n*/
607      number htmp=nlInvers(h);
608      number hzztmp=nlInvers(hzz);
609      number hh=nlMult(hzz,h);
610      nlDelete(&hzz,currRing->algring);
611      nlDelete(&h,currRing->algring);
612      number hg=nlGcd(hzztmp,htmp,currRing->algring);
613      nlDelete(&hzztmp,currRing->algring);
614      nlDelete(&htmp,currRing->algring);
615      h=nlMult(hh,hg);
616      nlDelete(&hg,currRing->algring);
617      nlDelete(&hh,currRing->algring);
618      nlNormalize(h);
619      if(!nlIsOne(h))
620      {
621        p=ph;
622        while (p!=NULL)
623        { // each monom: coeff in Q_a
624          lnumber c_n_n=(lnumber)pGetCoeff(p);
625          napoly c_n=c_n_n->z;
626          while (c_n!=NULL)
627          { // each monom: coeff in Q
628            d=nlMult(h,pGetCoeff(c_n));
629            nlNormalize(d);
630            nlDelete(&pGetCoeff(c_n),currRing->algring);
631            pGetCoeff(c_n)=d;
632            pIter(c_n);
633          }
634          c_n=c_n_n->n;
635          while (c_n!=NULL)
636          { // each monom: coeff in Q
637            d=nlMult(h,pGetCoeff(c_n));
638            nlNormalize(d);
639            nlDelete(&pGetCoeff(c_n),currRing->algring);
640            pGetCoeff(c_n)=d;
641            pIter(c_n);
642          }
643          pIter(p);
644        }
645      }
646      nlDelete(&h,currRing->algring);
647    }
648  }
649}
650void pSimpleContent(poly ph,int smax)
651{
652  if(TEST_OPT_CONTENTSB) return;
653  if (ph==NULL) return;
654  if (pNext(ph)==NULL)
655  {
656    pSetCoeff(ph,nInit(1));
657    return;
658  }
659  if ((pNext(pNext(ph))==NULL)||(!rField_is_Q()))
660  {
661    return;
662  }
663  number d=pInitContent(ph);
664  if (nlSize(d)<=smax)
665  {
666    //if (TEST_OPT_PROT) PrintS("G");
667    return;
668  }
669  poly p=ph;
670  number h=d;
671  if (smax==1) smax=2;
672  while (p!=NULL)
673  {
674#if 0
675    d=nlGcd(h,pGetCoeff(p),currRing);
676    nlDelete(&h,currRing);
677    h = d;
678#else
679    nlInpGcd(h,pGetCoeff(p),currRing);
680#endif
681    if(nlSize(h)<smax)
682    {
683      //if (TEST_OPT_PROT) PrintS("g");
684      return;
685    }
686    pIter(p);
687  }
688  p = ph;
689  if (!nlGreaterZero(pGetCoeff(p))) h=nlNeg(h);
690  if(nlIsOne(h)) return;
691  //if (TEST_OPT_PROT) PrintS("c");
692  while (p!=NULL)
693  {
694#if 1
695    d = nlIntDiv(pGetCoeff(p),h);
696    pSetCoeff(p,d);
697#else
698    nlInpIntDiv(pGetCoeff(p),h,currRing);
699#endif
700    pIter(p);
701  }
702  nlDelete(&h,currRing);
703}
704
705number pInitContent(poly ph)
706// only for coefficients in Q
707#if 0
708{
709  assume(!TEST_OPT_CONTENTSB);
710  assume(ph!=NULL);
711  assume(pNext(ph)!=NULL);
712  assume(rField_is_Q());
713  if (pNext(pNext(ph))==NULL)
714  {
715    return nlGetNom(pGetCoeff(pNext(ph)),currRing);
716  }
717  poly p=ph;
718  number n1=nlGetNom(pGetCoeff(p),currRing);
719  pIter(p);
720  number n2=nlGetNom(pGetCoeff(p),currRing);
721  pIter(p);
722  number d;
723  number t;
724  loop
725  {
726    nlNormalize(pGetCoeff(p));
727    t=nlGetNom(pGetCoeff(p),currRing);
728    if (nlGreaterZero(t))
729      d=nlAdd(n1,t);
730    else
731      d=nlSub(n1,t);
732    nlDelete(&t,currRing);
733    nlDelete(&n1,currRing);
734    n1=d;
735    pIter(p);
736    if (p==NULL) break;
737    nlNormalize(pGetCoeff(p));
738    t=nlGetNom(pGetCoeff(p),currRing);
739    if (nlGreaterZero(t))
740      d=nlAdd(n2,t);
741    else
742      d=nlSub(n2,t);
743    nlDelete(&t,currRing);
744    nlDelete(&n2,currRing);
745    n2=d;
746    pIter(p);
747    if (p==NULL) break;
748  }
749  d=nlGcd(n1,n2,currRing);
750  nlDelete(&n1,currRing);
751  nlDelete(&n2,currRing);
752  return d;
753}
754#else
755{
756  number d=pGetCoeff(ph);
757  if(SR_HDL(d)&SR_INT) return d;
758  int s=mpz_size1(&d->z);
759  int s2=-1;
760  number d2;
761  loop
762  {
763    pIter(ph);
764    if(ph==NULL)
765    {
766      if (s2==-1) return nlCopy(d);
767      break;
768    }
769    if (SR_HDL(pGetCoeff(ph))&SR_INT)
770    {
771      s2=s;
772      d2=d;
773      s=0;
774      d=pGetCoeff(ph);
775      if (s2==0) break;
776    }
777    else
778    if (mpz_size1(&(pGetCoeff(ph)->z))<=s)
779    {
780      s2=s;
781      d2=d;
782      d=pGetCoeff(ph);
783      s=mpz_size1(&d->z);
784    }
785  }
786  return nlGcd(d,d2,currRing);
787}
788#endif
789
790number pInitContent_a(poly ph)
791// only for coefficients in K(a) anf K(a,...)
792{
793  number d=pGetCoeff(ph);
794  int s=naParDeg(d);
795  if (s /* naParDeg(d)*/ <=1) return naCopy(d);
796  int s2=-1;
797  number d2;
798  int ss;
799  loop
800  {
801    pIter(ph);
802    if(ph==NULL)
803    {
804      if (s2==-1) return naCopy(d);
805      break;
806    }
807    if ((ss=naParDeg(pGetCoeff(ph)))<s)
808    {
809      s2=s;
810      d2=d;
811      s=ss;
812      d=pGetCoeff(ph);
813      if (s2<=1) break;
814    }
815  }
816  return naGcd(d,d2,currRing);
817}
818
819
820//void pContent(poly ph)
821//{
822//  number h,d;
823//  poly p;
824//
825//  p = ph;
826//  if(pNext(p)==NULL)
827//  {
828//    pSetCoeff(p,nInit(1));
829//  }
830//  else
831//  {
832//#ifdef PDEBUG
833//    if (!pTest(p)) return;
834//#endif
835//    nNormalize(pGetCoeff(p));
836//    if(!nGreaterZero(pGetCoeff(ph)))
837//    {
838//      ph = pNeg(ph);
839//      nNormalize(pGetCoeff(p));
840//    }
841//    h=pGetCoeff(p);
842//    pIter(p);
843//    while (p!=NULL)
844//    {
845//      nNormalize(pGetCoeff(p));
846//      if (nGreater(h,pGetCoeff(p))) h=pGetCoeff(p);
847//      pIter(p);
848//    }
849//    h=nCopy(h);
850//    p=ph;
851//    while (p!=NULL)
852//    {
853//      d=nGcd(h,pGetCoeff(p));
854//      nDelete(&h);
855//      h = d;
856//      if(nIsOne(h))
857//      {
858//        break;
859//      }
860//      pIter(p);
861//    }
862//    p = ph;
863//    //number tmp;
864//    if(!nIsOne(h))
865//    {
866//      while (p!=NULL)
867//      {
868//        d = nIntDiv(pGetCoeff(p),h);
869//        pSetCoeff(p,d);
870//        pIter(p);
871//      }
872//    }
873//    nDelete(&h);
874//#ifdef HAVE_FACTORY
875//    if ( (nGetChar() == 1) || (nGetChar() < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
876//    {
877//      pTest(ph);
878//      singclap_divide_content(ph);
879//      pTest(ph);
880//    }
881//#endif
882//  }
883//}
884#if 0
885void p_Content(poly ph, ring r)
886{
887  number h,d;
888  poly p;
889
890  if(pNext(ph)==NULL)
891  {
892    pSetCoeff(ph,n_Init(1,r));
893  }
894  else
895  {
896    n_Normalize(pGetCoeff(ph),r);
897    if(!n_GreaterZero(pGetCoeff(ph),r)) ph = p_Neg(ph,r);
898    h=n_Copy(pGetCoeff(ph),r);
899    p = pNext(ph);
900    while (p!=NULL)
901    {
902      n_Normalize(pGetCoeff(p),r);
903      d=n_Gcd(h,pGetCoeff(p),r);
904      n_Delete(&h,r);
905      h = d;
906      if(n_IsOne(h,r))
907      {
908        break;
909      }
910      pIter(p);
911    }
912    p = ph;
913    //number tmp;
914    if(!n_IsOne(h,r))
915    {
916      while (p!=NULL)
917      {
918        //d = nDiv(pGetCoeff(p),h);
919        //tmp = nIntDiv(pGetCoeff(p),h);
920        //if (!nEqual(d,tmp))
921        //{
922        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
923        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
924        //  nWrite(tmp);Print(StringAppendS("\n"));
925        //}
926        //nDelete(&tmp);
927        d = n_IntDiv(pGetCoeff(p),h,r);
928        p_SetCoeff(p,d,r);
929        pIter(p);
930      }
931    }
932    n_Delete(&h,r);
933#ifdef HAVE_FACTORY
934    //if ( (n_GetChar(r) == 1) || (n_GetChar(r) < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
935    //{
936    //  singclap_divide_content(ph);
937    //  if(!n_GreaterZero(pGetCoeff(ph),r)) ph = p_Neg(ph,r);
938    //}
939#endif
940  }
941}
942#endif
943
944poly pCleardenom(poly ph)
945{
946  poly start=ph;
947  number d, h;
948  poly p;
949
950#ifdef HAVE_RINGS
951  if (rField_is_Ring(currRing))
952  {
953    pContent(ph);
954    return start;
955  }
956#endif
957  if (rField_is_Zp() && TEST_OPT_INTSTRATEGY) return start;
958  p = ph;
959  if(pNext(p)==NULL)
960  {
961    if (TEST_OPT_CONTENTSB)
962    {
963      number n=nGetDenom(pGetCoeff(p));
964      if (!nIsOne(n))
965      {
966        number nn=nMult(pGetCoeff(p),n);
967        nNormalize(nn);
968        pSetCoeff(p,nn);
969      }
970      nDelete(&n);
971    }
972    else
973      pSetCoeff(p,nInit(1));
974  }
975  else
976  {
977    h = nInit(1);
978    while (p!=NULL)
979    {
980      nNormalize(pGetCoeff(p));
981      d=nLcm(h,pGetCoeff(p),currRing);
982      nDelete(&h);
983      h=d;
984      pIter(p);
985    }
986    /* contains the 1/lcm of all denominators */
987    if(!nIsOne(h))
988    {
989      p = ph;
990      while (p!=NULL)
991      {
992        /* should be:
993        * number hh;
994        * nGetDenom(p->coef,&hh);
995        * nMult(&h,&hh,&d);
996        * nNormalize(d);
997        * nDelete(&hh);
998        * nMult(d,p->coef,&hh);
999        * nDelete(&d);
1000        * nDelete(&(p->coef));
1001        * p->coef =hh;
1002        */
1003        d=nMult(h,pGetCoeff(p));
1004        nNormalize(d);
1005        pSetCoeff(p,d);
1006        pIter(p);
1007      }
1008      nDelete(&h);
1009      if (nGetChar()==1)
1010      {
1011        loop
1012        {
1013          h = nInit(1);
1014          p=ph;
1015          while (p!=NULL)
1016          {
1017            d=nLcm(h,pGetCoeff(p),currRing);
1018            nDelete(&h);
1019            h=d;
1020            pIter(p);
1021          }
1022          /* contains the 1/lcm of all denominators */
1023          if(!nIsOne(h))
1024          {
1025            p = ph;
1026            while (p!=NULL)
1027            {
1028              /* should be:
1029              * number hh;
1030              * nGetDenom(p->coef,&hh);
1031              * nMult(&h,&hh,&d);
1032              * nNormalize(d);
1033              * nDelete(&hh);
1034              * nMult(d,p->coef,&hh);
1035              * nDelete(&d);
1036              * nDelete(&(p->coef));
1037              * p->coef =hh;
1038              */
1039              d=nMult(h,pGetCoeff(p));
1040              nNormalize(d);
1041              pSetCoeff(p,d);
1042              pIter(p);
1043            }
1044            nDelete(&h);
1045          }
1046          else
1047          {
1048            nDelete(&h);
1049            break;
1050          }
1051        }
1052      }
1053    }
1054    if (h!=NULL) nDelete(&h);
1055 
1056    pContent(ph);
1057#ifdef HAVE_RATGRING
1058    if (rIsRatGRing(currRing))
1059    {
1060      /* quick unit detection in the rational case is done in gr_nc_bba */
1061      pContentRat(ph);
1062      start=ph;
1063    }
1064#endif
1065  }
1066  return start;
1067}
1068
1069void pCleardenom_n(poly ph,number &c)
1070{
1071  number d, h;
1072  poly p;
1073
1074  p = ph;
1075  if(pNext(p)==NULL)
1076  {
1077    c=nInvers(pGetCoeff(p));
1078    pSetCoeff(p,nInit(1));
1079  }
1080  else
1081  {
1082    h = nInit(1);
1083    while (p!=NULL)
1084    {
1085      nNormalize(pGetCoeff(p));
1086      d=nLcm(h,pGetCoeff(p),currRing);
1087      nDelete(&h);
1088      h=d;
1089      pIter(p);
1090    }
1091    c=h;
1092    /* contains the 1/lcm of all denominators */
1093    if(!nIsOne(h))
1094    {
1095      p = ph;
1096      while (p!=NULL)
1097      {
1098        /* should be:
1099        * number hh;
1100        * nGetDenom(p->coef,&hh);
1101        * nMult(&h,&hh,&d);
1102        * nNormalize(d);
1103        * nDelete(&hh);
1104        * nMult(d,p->coef,&hh);
1105        * nDelete(&d);
1106        * nDelete(&(p->coef));
1107        * p->coef =hh;
1108        */
1109        d=nMult(h,pGetCoeff(p));
1110        nNormalize(d);
1111        pSetCoeff(p,d);
1112        pIter(p);
1113      }
1114      if (nGetChar()==1)
1115      {
1116        loop
1117        {
1118          h = nInit(1);
1119          p=ph;
1120          while (p!=NULL)
1121          {
1122            d=nLcm(h,pGetCoeff(p),currRing);
1123            nDelete(&h);
1124            h=d;
1125            pIter(p);
1126          }
1127          /* contains the 1/lcm of all denominators */
1128          if(!nIsOne(h))
1129          {
1130            p = ph;
1131            while (p!=NULL)
1132            {
1133              /* should be:
1134              * number hh;
1135              * nGetDenom(p->coef,&hh);
1136              * nMult(&h,&hh,&d);
1137              * nNormalize(d);
1138              * nDelete(&hh);
1139              * nMult(d,p->coef,&hh);
1140              * nDelete(&d);
1141              * nDelete(&(p->coef));
1142              * p->coef =hh;
1143              */
1144              d=nMult(h,pGetCoeff(p));
1145              nNormalize(d);
1146              pSetCoeff(p,d);
1147              pIter(p);
1148            }
1149            number t=nMult(c,h);
1150            nDelete(&c);
1151            c=t;
1152          }
1153          else
1154          {
1155            break;
1156          }
1157          nDelete(&h);
1158        }
1159      }
1160    }
1161  }
1162}
1163
1164/*2
1165*tests if p is homogeneous with respect to the actual weigths
1166*/
1167BOOLEAN pIsHomogeneous (poly p)
1168{
1169  poly qp=p;
1170  int o;
1171
1172  if ((p == NULL) || (pNext(p) == NULL)) return TRUE;
1173  pFDegProc d;
1174  if (pLexOrder && (currRing->order[0]==ringorder_lp))
1175    d=pTotaldegree;
1176  else 
1177    d=pFDeg;
1178  o = d(p,currRing);
1179  do
1180  {
1181    if (d(qp,currRing) != o) return FALSE;
1182    pIter(qp);
1183  }
1184  while (qp != NULL);
1185  return TRUE;
1186}
1187
1188// orders monoms of poly using merge sort (ususally faster than
1189// insertion sort). ASSUMES that pSetm was performed on monoms
1190poly pOrdPolyMerge(poly p)
1191{
1192  poly qq,pp,result=NULL;
1193
1194  if (p == NULL) return NULL;
1195
1196  loop
1197  {
1198    qq = p;
1199    loop
1200    {
1201      if (pNext(p) == NULL)
1202      {
1203        result=pAdd(result, qq);
1204        pTest(result);
1205        return result;
1206      }
1207      if (pLmCmp(p,pNext(p)) != 1)
1208      {
1209        pp = p;
1210        pIter(p);
1211        pNext(pp) = NULL;
1212        result = pAdd(result, qq);
1213        break;
1214      }
1215      pIter(p);
1216    }
1217  }
1218}
1219
1220// orders monoms of poly using insertion sort, performs pSetm on each monom
1221poly pOrdPolyInsertSetm(poly p)
1222{
1223  poly qq,result = NULL;
1224
1225#if 0
1226  while (p != NULL)
1227  {
1228    qq = p;
1229    pIter(p);
1230    qq->next = NULL;
1231    pSetm(qq);
1232    result = pAdd(result,qq);
1233    pTest(result);
1234  }
1235#else
1236  while (p != NULL)
1237  {
1238    qq = p;
1239    pIter(p);
1240    qq->next = result;
1241    result = qq;
1242    pSetm(qq);
1243  }
1244  p = result;
1245  result = NULL;
1246  while (p != NULL)
1247  {
1248    qq = p;
1249    pIter(p);
1250    qq->next = NULL;
1251    result = pAdd(result, qq);
1252  }
1253  pTest(result);
1254#endif
1255  return result;
1256}
1257
1258/*2
1259*returns a re-ordered copy of a polynomial, with permutation of the variables
1260*/
1261poly pPermPoly (poly p, int * perm, const ring oldRing, nMapFunc nMap,
1262   int *par_perm, int OldPar)
1263{
1264  int OldpVariables = oldRing->N;
1265  poly result = NULL;
1266  poly result_last = NULL;
1267  poly aq=NULL; /* the map coefficient */
1268  poly qq; /* the mapped monomial */
1269
1270  while (p != NULL)
1271  {
1272    if ((OldPar==0)||(rField_is_GF(oldRing)))
1273    {
1274      qq = pInit();
1275      number n=nMap(pGetCoeff(p));
1276      if ((currRing->minpoly!=NULL)
1277      && ((rField_is_Zp_a()) || (rField_is_Q_a())))
1278      {
1279        nNormalize(n);
1280      }
1281      pGetCoeff(qq)=n;
1282    // coef may be zero:  pTest(qq);
1283    }
1284    else
1285    {
1286      qq=pOne();
1287      aq=naPermNumber(pGetCoeff(p),par_perm,OldPar, oldRing);
1288      if ((currRing->minpoly!=NULL)
1289      && ((rField_is_Zp_a()) || (rField_is_Q_a())))
1290      {
1291        poly tmp=aq;
1292        while (tmp!=NULL)
1293        {
1294          number n=pGetCoeff(tmp);
1295          nNormalize(n);
1296          pGetCoeff(tmp)=n;
1297          pIter(tmp);
1298        }
1299      }
1300      pTest(aq);
1301    }
1302    if (rRing_has_Comp(currRing)) pSetComp(qq, p_GetComp(p,oldRing));
1303    if (nIsZero(pGetCoeff(qq)))
1304    {
1305      pDeleteLm(&qq);
1306    }
1307    else
1308    {
1309      int i;
1310      int mapped_to_par=0;
1311      for(i=1; i<=OldpVariables; i++)
1312      {
1313        int e=p_GetExp(p,i,oldRing);
1314        if (e!=0)
1315        {
1316          if (perm==NULL)
1317          {
1318            pSetExp(qq,i, e);
1319          }
1320          else if (perm[i]>0)
1321            pAddExp(qq,perm[i], e/*p_GetExp( p,i,oldRing)*/);
1322          else if (perm[i]<0)
1323          {
1324            if (rField_is_GF())
1325            {
1326              number c=pGetCoeff(qq);
1327              number ee=nfPar(1);
1328              number eee;nfPower(ee,e,&eee); //nfDelete(ee,currRing);
1329              ee=nfMult(c,eee);
1330              //nfDelete(c,currRing);nfDelete(eee,currRing);
1331              pSetCoeff0(qq,ee);
1332            }
1333            else
1334            {
1335              lnumber c=(lnumber)pGetCoeff(qq);
1336              if (c->z->next==NULL)
1337                napAddExp(c->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/);
1338              else /* more difficult: we have really to multiply: */
1339              {
1340                lnumber mmc=(lnumber)naInit(1,currRing);
1341                napSetExp(mmc->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/);
1342                napSetm(mmc->z);
1343                pGetCoeff(qq)=naMult((number)c,(number)mmc);
1344                nDelete((number *)&c);
1345                nDelete((number *)&mmc); 
1346              }
1347              mapped_to_par=1;
1348            }
1349          }
1350          else
1351          {
1352            /* this variable maps to 0 !*/
1353            pDeleteLm(&qq);
1354            break;
1355          }
1356        }
1357      }
1358      if (mapped_to_par
1359      && (currRing->minpoly!=NULL))
1360      {
1361        number n=pGetCoeff(qq);
1362        nNormalize(n);
1363        pGetCoeff(qq)=n;
1364      }
1365    }
1366    pIter(p);
1367#if 1
1368    if (qq!=NULL)
1369    {
1370      pSetm(qq);
1371      pTest(aq);
1372      pTest(qq);
1373      if (aq!=NULL) qq=pMult(aq,qq);
1374      aq = qq;
1375      while (pNext(aq) != NULL) pIter(aq);
1376      if (result_last==NULL)
1377      {
1378        result=qq;
1379      }
1380      else
1381      {
1382        pNext(result_last)=qq;
1383      }
1384      result_last=aq;
1385      aq = NULL;
1386    }
1387    else if (aq!=NULL)
1388    {
1389      pDelete(&aq);
1390    }
1391  }
1392  result=pSortAdd(result);
1393#else
1394  //  if (qq!=NULL)
1395  //  {
1396  //    pSetm(qq);
1397  //    pTest(qq);
1398  //    pTest(aq);
1399  //    if (aq!=NULL) qq=pMult(aq,qq);
1400  //    aq = qq;
1401  //    while (pNext(aq) != NULL) pIter(aq);
1402  //    pNext(aq) = result;
1403  //    aq = NULL;
1404  //    result = qq;
1405  //  }
1406  //  else if (aq!=NULL)
1407  //  {
1408  //    pDelete(&aq);
1409  //  }
1410  //}
1411  //p = result;
1412  //result = NULL;
1413  //while (p != NULL)
1414  //{
1415  //  qq = p;
1416  //  pIter(p);
1417  //  qq->next = NULL;
1418  //  result = pAdd(result, qq);
1419  //}
1420#endif
1421  pTest(result);
1422  return result;
1423}
1424
1425#if 0
1426/*2
1427*returns a re-ordered copy of a polynomial, with permutation of the variables
1428*/
1429poly p_PermPoly (poly p, int * perm, ring oldRing,
1430   int *par_perm, int OldPar, ring newRing)
1431{
1432  int OldpVariables = oldRing->N;
1433  poly result = NULL;
1434  poly result_last = NULL;
1435  poly aq=NULL; /* the map coefficient */
1436  poly qq; /* the mapped monomial */
1437
1438  while (p != NULL)
1439  {
1440    if (OldPar==0)
1441    {
1442      qq = pInit();
1443      number n=newRing->cf->nMap(pGetCoeff(p));
1444      if ((newRing->minpoly!=NULL)
1445      && ((rField_is_Zp_a(newRing)) || (rField_is_Q_a(newRing))))
1446      {
1447        newRing->cf->nNormalize(n);
1448      }
1449      pGetCoeff(qq)=n;
1450    // coef may be zero:  pTest(qq);
1451    }
1452    else
1453    {
1454      qq=p_ISet(1, newRing);
1455      aq=naPermNumber(pGetCoeff(p),par_perm,OldPar, oldRing);
1456      if ((newRing->minpoly!=NULL)
1457      && ((rField_is_Zp_a(newRing)) || (rField_is_Q_a(newRing))))
1458      {
1459        poly tmp=aq;
1460        while (tmp!=NULL)
1461        {
1462          number n=pGetCoeff(tmp);
1463          newRing->cf->nNormalize(n);
1464          pGetCoeff(tmp)=n;
1465          pIter(tmp);
1466        }
1467      }
1468      //pTest(aq);
1469    }
1470    p_SetComp(qq, p_GetComp(p,oldRing), newRing);
1471    if (newRing->cf->nIsZero(pGetCoeff(qq)))
1472    {
1473      p_DeleteLm(&qq, newRing);
1474    }
1475    else
1476    {
1477      int i;
1478      int mapped_to_par=0;
1479      for(i=1; i<=OldpVariables; i++)
1480      {
1481        int e=p_GetExp(p,i,oldRing);
1482        if (e!=0)
1483        {
1484          if (perm==NULL)
1485          {
1486            p_SetExp(qq,i, e, newRing);
1487          }
1488          else if (perm[i]>0)
1489            p_AddExp(qq,perm[i], e/*p_GetExp( p,i,oldRing)*/, newRing);
1490          else if (perm[i]<0)
1491          {
1492            lnumber c=(lnumber)pGetCoeff(qq);
1493            napAddExp(c->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/);
1494            mapped_to_par=1;
1495          }
1496          else
1497          {
1498            /* this variable maps to 0 !*/
1499            p_DeleteLm(&qq, newRing);
1500            break;
1501          }
1502        }
1503      }
1504      if (mapped_to_par
1505      && (newRing->minpoly!=NULL))
1506      {
1507        number n=pGetCoeff(qq);
1508        newRing->cf->nNormalize(n);
1509        pGetCoeff(qq)=n;
1510      }
1511    }
1512    pIter(p);
1513    if (qq!=NULL)
1514    {
1515      p_Setm(qq, newRing);
1516      //pTest(aq);
1517      //pTest(qq);
1518      if (aq!=NULL) qq=pMult(aq,qq);
1519      aq = qq;
1520      while (pNext(aq) != NULL) pIter(aq);
1521      if (result_last==NULL)
1522      {
1523        result=qq;
1524      }
1525      else
1526      {
1527        pNext(result_last)=qq;
1528      }
1529      result_last=aq;
1530      aq = NULL;
1531    }
1532    else if (aq!=NULL)
1533    {
1534      p_Delete(&aq, newRing);
1535    }
1536  }
1537  result=pOrdPolyMerge(result);
1538  //pTest(result);
1539  return result;
1540}
1541#endif
1542
1543poly ppJet(poly p, int m)
1544{
1545  poly r=NULL;
1546  poly t=NULL;
1547
1548  while (p!=NULL)
1549  {
1550    if (pTotaldegree(p)<=m)
1551    {
1552      if (r==NULL)
1553        r=pHead(p);
1554      else
1555      if (t==NULL)
1556      {
1557        pNext(r)=pHead(p);
1558        t=pNext(r);
1559      }
1560      else
1561      {
1562        pNext(t)=pHead(p);
1563        pIter(t);
1564      }
1565    }
1566    pIter(p);
1567  }
1568  return r;
1569}
1570
1571poly pJet(poly p, int m)
1572{
1573  poly t=NULL;
1574
1575  while((p!=NULL) && (pTotaldegree(p)>m)) pLmDelete(&p);
1576  if (p==NULL) return NULL;
1577  poly r=p;
1578  while (pNext(p)!=NULL)
1579  {
1580    if (pTotaldegree(pNext(p))>m)
1581    {
1582      pLmDelete(&pNext(p));
1583    }
1584    else
1585      pIter(p);
1586  }
1587  return r;
1588}
1589
1590poly ppJetW(poly p, int m, short *w)
1591{
1592  poly r=NULL;
1593  poly t=NULL;
1594  while (p!=NULL)
1595  {
1596    if (totaldegreeWecart_IV(p,currRing,w)<=m)
1597    {
1598      if (r==NULL)
1599        r=pHead(p);
1600      else
1601      if (t==NULL)
1602      {
1603        pNext(r)=pHead(p);
1604        t=pNext(r);
1605      }
1606      else
1607      {
1608        pNext(t)=pHead(p);
1609        pIter(t);
1610      }
1611    }
1612    pIter(p);
1613  }
1614  return r;
1615}
1616
1617poly pJetW(poly p, int m, short *w)
1618{
1619  poly t=NULL;
1620  while((p!=NULL) && (totaldegreeWecart_IV(p,currRing,w)>m)) pLmDelete(&p);
1621  if (p==NULL) return NULL;
1622  poly r=p;
1623  while (pNext(p)!=NULL)
1624  {
1625    if (totaldegreeWecart_IV(pNext(p),currRing,w)>m)
1626    {
1627      pLmDelete(&pNext(p));
1628    }
1629    else
1630      pIter(p);
1631  }
1632  return r;
1633}
1634
1635int pMinDeg(poly p,intvec *w)
1636{
1637  if(p==NULL)
1638    return -1;
1639  int d=-1;
1640  while(p!=NULL)
1641  {
1642    int d0=0;
1643    for(int j=0;j<pVariables;j++)
1644      if(w==NULL||j>=w->length())
1645        d0+=pGetExp(p,j+1);
1646      else
1647        d0+=(*w)[j]*pGetExp(p,j+1);
1648    if(d0<d||d==-1)
1649      d=d0;
1650    pIter(p);
1651  }
1652  return d;
1653}
1654
1655poly pSeries(int n,poly p,poly u, intvec *w)
1656{
1657  short *ww=iv2array(w);
1658  if(p!=NULL)
1659  {
1660    if(u==NULL)
1661      p=pJetW(p,n,ww);
1662    else
1663      p=pJetW(pMult(p,pInvers(n-pMinDeg(p,w),u,w)),n,ww);
1664  }
1665  omFreeSize((ADDRESS)ww,(pVariables+1)*sizeof(short));
1666  return p;
1667}
1668
1669poly pInvers(int n,poly u,intvec *w)
1670{
1671  short *ww=iv2array(w);
1672  if(n<0)
1673    return NULL;
1674  number u0=nInvers(pGetCoeff(u));
1675  poly v=pNSet(u0);
1676  if(n==0)
1677    return v;
1678  poly u1=pJetW(pSub(pOne(),pMult_nn(u,u0)),n,ww);
1679  if(u1==NULL)
1680    return v;
1681  poly v1=pMult_nn(pCopy(u1),u0);
1682  v=pAdd(v,pCopy(v1));
1683  for(int i=n/pMinDeg(u1,w);i>1;i--)
1684  {
1685    v1=pJetW(pMult(v1,pCopy(u1)),n,ww);
1686    v=pAdd(v,pCopy(v1));
1687  }
1688  pDelete(&u1);
1689  pDelete(&v1);
1690  omFreeSize((ADDRESS)ww,(pVariables+1)*sizeof(short));
1691  return v;
1692}
1693
1694long pDegW(poly p, const short *w)
1695{
1696  long r=-LONG_MAX;
1697
1698  while (p!=NULL)
1699  {
1700    long t=totaldegreeWecart_IV(p,currRing,w);
1701    if (t>r) r=t;
1702    pIter(p);
1703  }
1704  return r;
1705}
1706
1707/*-----------type conversions ----------------------------*/
1708/*2
1709* input: a set of polys (len elements: p[0]..p[len-1])
1710* output: a vector
1711* p will not be changed
1712*/
1713poly  pPolys2Vec(polyset p, int len)
1714{
1715  poly v=NULL;
1716  poly h;
1717  int i;
1718
1719  for (i=len-1; i>=0; i--)
1720  {
1721    if (p[i])
1722    {
1723      h=pCopy(p[i]);
1724      pSetCompP(h,i+1);
1725      v=pAdd(v,h);
1726    }
1727  }
1728 return v;
1729}
1730
1731/*2
1732* convert a vector to a set of polys,
1733* allocates the polyset, (entries 0..(*len)-1)
1734* the vector will not be changed
1735*/
1736void  pVec2Polys(poly v, polyset *p, int *len)
1737{
1738  poly h;
1739  int k;
1740
1741  *len=pMaxComp(v);
1742  if (*len==0) *len=1;
1743  *p=(polyset)omAlloc0((*len)*sizeof(poly));
1744  while (v!=NULL)
1745  {
1746    h=pHead(v);
1747    k=pGetComp(h);
1748    pSetComp(h,0);
1749    (*p)[k-1]=pAdd((*p)[k-1],h);
1750    pIter(v);
1751  }
1752}
1753
1754int p_Var(poly m,const ring r)
1755{
1756  if (m==NULL) return 0;
1757  if (pNext(m)!=NULL) return 0;
1758  int i,e=0;
1759  for (i=r->N; i>0; i--)
1760  {
1761    if (p_GetExp(m,i,r)==1)
1762    {
1763      if (e==0) e=i;
1764      else return 0;
1765    }
1766  }
1767  return e;
1768}
1769
1770/*----------utilities for syzygies--------------*/
1771//BOOLEAN   pVectorHasUnitM(poly p, int * k)
1772//{
1773//  while (p!=NULL)
1774//  {
1775//    if (pLmIsConstantComp(p))
1776//    {
1777//      *k = pGetComp(p);
1778//      return TRUE;
1779//    }
1780//    else pIter(p);
1781//  }
1782//  return FALSE;
1783//}
1784
1785BOOLEAN   pVectorHasUnitB(poly p, int * k)
1786{
1787  poly q=p,qq;
1788  int i;
1789
1790  while (q!=NULL)
1791  {
1792    if (pLmIsConstantComp(q))
1793    {
1794      i = pGetComp(q);
1795      qq = p;
1796      while ((qq != q) && (pGetComp(qq) != i)) pIter(qq);
1797      if (qq == q)
1798      {
1799        *k = i;
1800        return TRUE;
1801      }
1802      else
1803        pIter(q);
1804    }
1805    else pIter(q);
1806  }
1807  return FALSE;
1808}
1809
1810void   pVectorHasUnit(poly p, int * k, int * len)
1811{
1812  poly q=p,qq;
1813  int i,j=0;
1814
1815  *len = 0;
1816  while (q!=NULL)
1817  {
1818    if (pLmIsConstantComp(q))
1819    {
1820      i = pGetComp(q);
1821      qq = p;
1822      while ((qq != q) && (pGetComp(qq) != i)) pIter(qq);
1823      if (qq == q)
1824      {
1825       j = 0;
1826       while (qq!=NULL)
1827       {
1828         if (pGetComp(qq)==i) j++;
1829        pIter(qq);
1830       }
1831       if ((*len == 0) || (j<*len))
1832       {
1833         *len = j;
1834         *k = i;
1835       }
1836      }
1837    }
1838    pIter(q);
1839  }
1840}
1841
1842/*2
1843* returns TRUE if p1 = p2
1844*/
1845BOOLEAN p_EqualPolys(poly p1,poly p2, const ring r)
1846{
1847  while ((p1 != NULL) && (p2 != NULL))
1848  {
1849    if (! p_LmEqual(p1, p2,r))
1850      return FALSE;
1851    if (! n_Equal(p_GetCoeff(p1,r), p_GetCoeff(p2,r),r ))
1852      return FALSE;
1853    pIter(p1);
1854    pIter(p2);
1855  }
1856  return (p1==p2);
1857}
1858
1859/*2
1860*returns TRUE if p1 is a skalar multiple of p2
1861*assume p1 != NULL and p2 != NULL
1862*/
1863BOOLEAN pComparePolys(poly p1,poly p2)
1864{
1865  number n,nn;
1866  int i;
1867  pAssume(p1 != NULL && p2 != NULL);
1868
1869  if (!pLmEqual(p1,p2)) //compare leading mons
1870      return FALSE;
1871  if ((pNext(p1)==NULL) && (pNext(p2)!=NULL))
1872     return FALSE;
1873  if ((pNext(p2)==NULL) && (pNext(p1)!=NULL))
1874     return FALSE;
1875  if (pLength(p1) != pLength(p2))
1876    return FALSE;
1877  n=nDiv(pGetCoeff(p1),pGetCoeff(p2));
1878  while ((p1 != NULL) /*&& (p2 != NULL)*/)
1879  {
1880    if ( ! pLmEqual(p1, p2))
1881    {
1882        nDelete(&n);
1883        return FALSE;
1884    }
1885    if (!nEqual(pGetCoeff(p1),nn=nMult(pGetCoeff(p2),n)))
1886    {
1887      nDelete(&n);
1888      nDelete(&nn);
1889      return FALSE;
1890    }
1891    nDelete(&nn);
1892    pIter(p1);
1893    pIter(p2);
1894  }
1895  nDelete(&n);
1896  return TRUE;
1897}
Note: See TracBrowser for help on using the repository browser.