source: git/kernel/polys1.cc @ 5d59a14

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