source: git/kernel/polys1.cc @ cc4d094

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