source: git/polys/polys1.cc @ 5c39a9

spielwiese
Last change on this file since 5c39a9 was cd246b, checked in by Hans Schoenemann <hannes@…>, 13 years ago
utils for syzygies
  • Property mode set to 100644
File size: 25.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id$ */
5
6/*
7* ABSTRACT - all basic methods to manipulate polynomials:
8* independent of representation
9*/
10
11/* includes */
12#include <string.h>
13#include <kernel/mod2.h>
14#include <kernel/options.h>
15#include <kernel/numbers.h>
16#include <kernel/ffields.h>
17#include <omalloc/omalloc.h>
18#include <kernel/febase.h>
19#include <kernel/weight.h>
20#include <kernel/intvec.h>
21#include <kernel/longalg.h>
22#include <kernel/longtrans.h>
23#include <kernel/ring.h>
24#include <kernel/ideals.h>
25#include <kernel/polys.h>
26//#include "ipid.h"
27#ifdef HAVE_FACTORY
28#include <kernel/clapsing.h>
29#endif
30
31#ifdef HAVE_RATGRING
32#include <kernel/ratgring.h>
33#endif
34
35/*-------- several access procedures to monomials -------------------- */
36/*
37* the module weights for std
38*/
39static pFDegProc pOldFDeg;
40static pLDegProc pOldLDeg;
41static intvec * pModW;
42static BOOLEAN pOldLexOrder;
43
44static long pModDeg(poly p, ring r = currRing)
45{
46  long d=pOldFDeg(p, r);
47  int c=p_GetComp(p, r);
48  if ((c>0) && (pModW->range(c-1))) d+= (*pModW)[c-1];
49  return d;
50  //return pOldFDeg(p, r)+(*pModW)[p_GetComp(p, r)-1];
51}
52
53void pSetModDeg(intvec *w)
54{
55  if (w!=NULL)
56  {
57    pModW = w;
58    pOldFDeg = pFDeg;
59    pOldLDeg = pLDeg;
60    pOldLexOrder = pLexOrder;
61    pSetDegProcs(pModDeg);
62    pLexOrder = TRUE;
63  }
64  else
65  {
66    pModW = NULL;
67    pRestoreDegProcs(pOldFDeg, pOldLDeg);
68    pLexOrder = pOldLexOrder;
69  }
70}
71
72
73/*3
74*  create binomial coef.
75*/
76static number* pnBin(int exp)
77{
78  int e, i, h;
79  number x, y, *bin=NULL;
80
81  x = nInit(exp);
82  if (nIsZero(x))
83  {
84    nDelete(&x);
85    return bin;
86  }
87  h = (exp >> 1) + 1;
88  bin = (number *)omAlloc0(h*sizeof(number));
89  bin[1] = x;
90  if (exp < 4)
91    return bin;
92  i = exp - 1;
93  for (e=2; e<h; e++)
94  {
95      x = nInit(i);
96      i--;
97      y = nMult(x,bin[e-1]);
98      nDelete(&x);
99      x = nInit(e);
100      bin[e] = nIntDiv(y,x);
101      nDelete(&x);
102      nDelete(&y);
103  }
104  return bin;
105}
106
107static void pnFreeBin(number *bin, int exp)
108{
109  int e, h = (exp >> 1) + 1;
110
111  if (bin[1] != NULL)
112  {
113    for (e=1; e<h; e++)
114      nDelete(&(bin[e]));
115  }
116  omFreeSize((ADDRESS)bin, h*sizeof(number));
117}
118
119int pMaxCompProc(poly p)
120{
121  return pMaxComp(p);
122}
123
124/*2
125* handle memory request for sets of polynomials (ideals)
126* l is the length of *p, increment is the difference (may be negative)
127*/
128void pEnlargeSet(polyset *p, int l, int increment)
129{
130  polyset h;
131
132  h=(polyset)omReallocSize((poly*)*p,l*sizeof(poly),(l+increment)*sizeof(poly));
133  if (increment>0)
134  {
135    //for (i=l; i<l+increment; i++)
136    //  h[i]=NULL;
137    memset(&(h[l]),0,increment*sizeof(poly));
138  }
139  *p=h;
140}
141
142number pInitContent(poly ph);
143number pInitContent_a(poly ph);
144
145void p_Content(poly ph, const ring r)
146{
147#ifdef HAVE_RINGS
148  if (rField_is_Ring(r))
149  {
150    if (ph!=NULL)
151    {
152      number k = nGetUnit(pGetCoeff(ph));
153      if (!nGreaterZero(pGetCoeff(ph))) k = nNeg(k); // in-place negation
154      if (!nIsOne(k))
155      {
156        number tmpNumber = k;
157        k = nInvers(k);
158        nDelete(&tmpNumber);
159        poly h = pNext(ph);
160        p_Mult_nn(ph,k,currRing);
161        pNormalize(ph);
162      }
163      nDelete(&k);
164    }
165    return;
166  }
167#endif
168  number h,d;
169  poly p;
170
171  //  if(TEST_OPT_CONTENTSB) return;
172  if(pNext(ph)==NULL)
173  {
174    pSetCoeff(ph,nInit(1));
175  }
176  else
177  {
178    nNormalize(pGetCoeff(ph));
179    if(!nGreaterZero(pGetCoeff(ph))) ph = pNeg(ph);
180    if (rField_is_Q())
181    {
182      h=pInitContent(ph);
183      p=ph;
184    }
185    else if ((rField_is_Extension(r))
186    && ((rPar(r)>1)||(r->minpoly==NULL)))
187    {
188      h=pInitContent_a(ph);
189      p=ph;
190    }
191    else
192    {
193      h=nCopy(pGetCoeff(ph));
194      p = pNext(ph);
195    }
196    while (p!=NULL)
197    {
198      nNormalize(pGetCoeff(p));
199      d=nGcd(h,pGetCoeff(p),r);
200      nDelete(&h);
201      h = d;
202      if(nIsOne(h))
203      {
204        break;
205      }
206      pIter(p);
207    }
208    p = ph;
209    //number tmp;
210    if(!nIsOne(h))
211    {
212      while (p!=NULL)
213      {
214        //d = nDiv(pGetCoeff(p),h);
215        //tmp = nIntDiv(pGetCoeff(p),h);
216        //if (!nEqual(d,tmp))
217        //{
218        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
219        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
220        //  nWrite(tmp);Print(StringAppendS("\n"));
221        //}
222        //nDelete(&tmp);
223        if (rField_is_Zp_a(currRing) || rField_is_Q_a(currRing))
224          d = nDiv(pGetCoeff(p),h);
225        else
226          d = nIntDiv(pGetCoeff(p),h);
227        pSetCoeff(p,d);
228        pIter(p);
229      }
230    }
231    nDelete(&h);
232#ifdef HAVE_FACTORY
233    if ( (nGetChar() == 1) || (nGetChar() < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
234    {
235      singclap_divide_content(ph);
236      if(!nGreaterZero(pGetCoeff(ph))) ph = pNeg(ph);
237    }
238#endif
239    if (rField_is_Q_a(r))
240    {
241      number hzz = nlInit(1, r);
242      h = nlInit(1, r);
243      p=ph;
244      while (p!=NULL)
245      { // each monom: coeff in Q_a
246        lnumber c_n_n=(lnumber)pGetCoeff(p);
247        napoly c_n=c_n_n->z;
248        while (c_n!=NULL)
249        { // each monom: coeff in Q
250          d=nlLcm(hzz,pGetCoeff(c_n),r->algring);
251          n_Delete(&hzz,r->algring);
252          hzz=d;
253          pIter(c_n);
254        }
255        c_n=c_n_n->n;
256        while (c_n!=NULL)
257        { // each monom: coeff in Q
258          d=nlLcm(h,pGetCoeff(c_n),r->algring);
259          n_Delete(&h,r->algring);
260          h=d;
261          pIter(c_n);
262        }
263        pIter(p);
264      }
265      /* hzz contains the 1/lcm of all denominators in c_n_n->z*/
266      /* h contains the 1/lcm of all denominators in c_n_n->n*/
267      number htmp=nlInvers(h);
268      number hzztmp=nlInvers(hzz);
269      number hh=nlMult(hzz,h);
270      nlDelete(&hzz,r->algring);
271      nlDelete(&h,r->algring);
272      number hg=nlGcd(hzztmp,htmp,r->algring);
273      nlDelete(&hzztmp,r->algring);
274      nlDelete(&htmp,r->algring);
275      h=nlMult(hh,hg);
276      nlDelete(&hg,r->algring);
277      nlDelete(&hh,r->algring);
278      nlNormalize(h);
279      if(!nlIsOne(h))
280      {
281        p=ph;
282        while (p!=NULL)
283        { // each monom: coeff in Q_a
284          lnumber c_n_n=(lnumber)pGetCoeff(p);
285          napoly c_n=c_n_n->z;
286          while (c_n!=NULL)
287          { // each monom: coeff in Q
288            d=nlMult(h,pGetCoeff(c_n));
289            nlNormalize(d);
290            nlDelete(&pGetCoeff(c_n),r->algring);
291            pGetCoeff(c_n)=d;
292            pIter(c_n);
293          }
294          c_n=c_n_n->n;
295          while (c_n!=NULL)
296          { // each monom: coeff in Q
297            d=nlMult(h,pGetCoeff(c_n));
298            nlNormalize(d);
299            nlDelete(&pGetCoeff(c_n),r->algring);
300            pGetCoeff(c_n)=d;
301            pIter(c_n);
302          }
303          pIter(p);
304        }
305      }
306      nlDelete(&h,r->algring);
307    }
308  }
309}
310
311void pSimpleContent(poly ph,int smax)
312{
313  //if(TEST_OPT_CONTENTSB) return;
314  if (ph==NULL) return;
315  if (pNext(ph)==NULL)
316  {
317    pSetCoeff(ph,nInit(1));
318    return;
319  }
320  if ((pNext(pNext(ph))==NULL)||(!rField_is_Q()))
321  {
322    return;
323  }
324  number d=pInitContent(ph);
325  if (nlSize(d)<=smax)
326  {
327    //if (TEST_OPT_PROT) PrintS("G");
328    return;
329  }
330  poly p=ph;
331  number h=d;
332  if (smax==1) smax=2;
333  while (p!=NULL)
334  {
335#if 0
336    d=nlGcd(h,pGetCoeff(p),currRing);
337    nlDelete(&h,currRing);
338    h = d;
339#else
340    nlInpGcd(h,pGetCoeff(p),currRing);
341#endif
342    if(nlSize(h)<smax)
343    {
344      //if (TEST_OPT_PROT) PrintS("g");
345      return;
346    }
347    pIter(p);
348  }
349  p = ph;
350  if (!nlGreaterZero(pGetCoeff(p))) h=nlNeg(h);
351  if(nlIsOne(h)) return;
352  //if (TEST_OPT_PROT) PrintS("c");
353  //
354  number inv=nlInvers(h);
355  p_Mult_nn(p,inv,currRing);
356  pNormalize(p);
357  //while (p!=NULL)
358  //{
359#if 1
360  //  d = nlIntDiv(pGetCoeff(p),h);
361  //  pSetCoeff(p,d);
362#else
363  //  nlInpIntDiv(pGetCoeff(p),h,currRing);
364#endif
365  //  pIter(p);
366  //}
367  nlDelete(&inv,currRing);
368  nlDelete(&h,currRing);
369}
370
371number pInitContent(poly ph)
372// only for coefficients in Q
373#if 0
374{
375  //assume(!TEST_OPT_CONTENTSB);
376  assume(ph!=NULL);
377  assume(pNext(ph)!=NULL);
378  assume(rField_is_Q());
379  if (pNext(pNext(ph))==NULL)
380  {
381    return nlGetNom(pGetCoeff(pNext(ph)),currRing);
382  }
383  poly p=ph;
384  number n1=nlGetNom(pGetCoeff(p),currRing);
385  pIter(p);
386  number n2=nlGetNom(pGetCoeff(p),currRing);
387  pIter(p);
388  number d;
389  number t;
390  loop
391  {
392    nlNormalize(pGetCoeff(p));
393    t=nlGetNom(pGetCoeff(p),currRing);
394    if (nlGreaterZero(t))
395      d=nlAdd(n1,t);
396    else
397      d=nlSub(n1,t);
398    nlDelete(&t,currRing);
399    nlDelete(&n1,currRing);
400    n1=d;
401    pIter(p);
402    if (p==NULL) break;
403    nlNormalize(pGetCoeff(p));
404    t=nlGetNom(pGetCoeff(p),currRing);
405    if (nlGreaterZero(t))
406      d=nlAdd(n2,t);
407    else
408      d=nlSub(n2,t);
409    nlDelete(&t,currRing);
410    nlDelete(&n2,currRing);
411    n2=d;
412    pIter(p);
413    if (p==NULL) break;
414  }
415  d=nlGcd(n1,n2,currRing);
416  nlDelete(&n1,currRing);
417  nlDelete(&n2,currRing);
418  return d;
419}
420#else
421{
422  number d=pGetCoeff(ph);
423  if(SR_HDL(d)&SR_INT) return d;
424  int s=mpz_size1(d->z);
425  int s2=-1;
426  number d2;
427  loop
428  {
429    pIter(ph);
430    if(ph==NULL)
431    {
432      if (s2==-1) return nlCopy(d);
433      break;
434    }
435    if (SR_HDL(pGetCoeff(ph))&SR_INT)
436    {
437      s2=s;
438      d2=d;
439      s=0;
440      d=pGetCoeff(ph);
441      if (s2==0) break;
442    }
443    else
444    if (mpz_size1((pGetCoeff(ph)->z))<=s)
445    {
446      s2=s;
447      d2=d;
448      d=pGetCoeff(ph);
449      s=mpz_size1(d->z);
450    }
451  }
452  return nlGcd(d,d2,currRing);
453}
454#endif
455
456number pInitContent_a(poly ph)
457// only for coefficients in K(a) anf K(a,...)
458{
459  number d=pGetCoeff(ph);
460  int s=naParDeg(d);
461  if (s /* naParDeg(d)*/ <=1) return naCopy(d);
462  int s2=-1;
463  number d2;
464  int ss;
465  loop
466  {
467    pIter(ph);
468    if(ph==NULL)
469    {
470      if (s2==-1) return naCopy(d);
471      break;
472    }
473    if ((ss=naParDeg(pGetCoeff(ph)))<s)
474    {
475      s2=s;
476      d2=d;
477      s=ss;
478      d=pGetCoeff(ph);
479      if (s2<=1) break;
480    }
481  }
482  return naGcd(d,d2,currRing);
483}
484
485
486//void pContent(poly ph)
487//{
488//  number h,d;
489//  poly p;
490//
491//  p = ph;
492//  if(pNext(p)==NULL)
493//  {
494//    pSetCoeff(p,nInit(1));
495//  }
496//  else
497//  {
498//#ifdef PDEBUG
499//    if (!pTest(p)) return;
500//#endif
501//    nNormalize(pGetCoeff(p));
502//    if(!nGreaterZero(pGetCoeff(ph)))
503//    {
504//      ph = pNeg(ph);
505//      nNormalize(pGetCoeff(p));
506//    }
507//    h=pGetCoeff(p);
508//    pIter(p);
509//    while (p!=NULL)
510//    {
511//      nNormalize(pGetCoeff(p));
512//      if (nGreater(h,pGetCoeff(p))) h=pGetCoeff(p);
513//      pIter(p);
514//    }
515//    h=nCopy(h);
516//    p=ph;
517//    while (p!=NULL)
518//    {
519//      d=nGcd(h,pGetCoeff(p));
520//      nDelete(&h);
521//      h = d;
522//      if(nIsOne(h))
523//      {
524//        break;
525//      }
526//      pIter(p);
527//    }
528//    p = ph;
529//    //number tmp;
530//    if(!nIsOne(h))
531//    {
532//      while (p!=NULL)
533//      {
534//        d = nIntDiv(pGetCoeff(p),h);
535//        pSetCoeff(p,d);
536//        pIter(p);
537//      }
538//    }
539//    nDelete(&h);
540//#ifdef HAVE_FACTORY
541//    if ( (nGetChar() == 1) || (nGetChar() < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
542//    {
543//      pTest(ph);
544//      singclap_divide_content(ph);
545//      pTest(ph);
546//    }
547//#endif
548//  }
549//}
550#if 0
551void p_Content(poly ph, ring r)
552{
553  number h,d;
554  poly p;
555
556  if(pNext(ph)==NULL)
557  {
558    pSetCoeff(ph,n_Init(1,r));
559  }
560  else
561  {
562    n_Normalize(pGetCoeff(ph),r);
563    if(!n_GreaterZero(pGetCoeff(ph),r)) ph = p_Neg(ph,r);
564    h=n_Copy(pGetCoeff(ph),r);
565    p = pNext(ph);
566    while (p!=NULL)
567    {
568      n_Normalize(pGetCoeff(p),r);
569      d=n_Gcd(h,pGetCoeff(p),r);
570      n_Delete(&h,r);
571      h = d;
572      if(n_IsOne(h,r))
573      {
574        break;
575      }
576      pIter(p);
577    }
578    p = ph;
579    //number tmp;
580    if(!n_IsOne(h,r))
581    {
582      while (p!=NULL)
583      {
584        //d = nDiv(pGetCoeff(p),h);
585        //tmp = nIntDiv(pGetCoeff(p),h);
586        //if (!nEqual(d,tmp))
587        //{
588        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
589        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
590        //  nWrite(tmp);Print(StringAppendS("\n"));
591        //}
592        //nDelete(&tmp);
593        d = n_IntDiv(pGetCoeff(p),h,r);
594        p_SetCoeff(p,d,r);
595        pIter(p);
596      }
597    }
598    n_Delete(&h,r);
599#ifdef HAVE_FACTORY
600    //if ( (n_GetChar(r) == 1) || (n_GetChar(r) < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
601    //{
602    //  singclap_divide_content(ph);
603    //  if(!n_GreaterZero(pGetCoeff(ph),r)) ph = p_Neg(ph,r);
604    //}
605#endif
606  }
607}
608#endif
609
610poly p_Cleardenom(poly ph, const ring r)
611{
612  poly start=ph;
613  number d, h;
614  poly p;
615
616#ifdef HAVE_RINGS
617  if (rField_is_Ring(r))
618  {
619    p_Content(ph,r);
620    return start;
621  }
622#endif
623  if (rField_is_Zp(r) && TEST_OPT_INTSTRATEGY) return start;
624  p = ph;
625  if(pNext(p)==NULL)
626  {
627    /*
628    if (TEST_OPT_CONTENTSB)
629    {
630      number n=nGetDenom(pGetCoeff(p));
631      if (!nIsOne(n))
632      {
633        number nn=nMult(pGetCoeff(p),n);
634        nNormalize(nn);
635        pSetCoeff(p,nn);
636      }
637      nDelete(&n);
638    }
639    else
640    */
641      pSetCoeff(p,nInit(1));
642  }
643  else
644  {
645    h = nInit(1);
646    while (p!=NULL)
647    {
648      nNormalize(pGetCoeff(p));
649      d=nLcm(h,pGetCoeff(p),currRing);
650      nDelete(&h);
651      h=d;
652      pIter(p);
653    }
654    /* contains the 1/lcm of all denominators */
655    if(!nIsOne(h))
656    {
657      p = ph;
658      while (p!=NULL)
659      {
660        /* should be:
661        * number hh;
662        * nGetDenom(p->coef,&hh);
663        * nMult(&h,&hh,&d);
664        * nNormalize(d);
665        * nDelete(&hh);
666        * nMult(d,p->coef,&hh);
667        * nDelete(&d);
668        * nDelete(&(p->coef));
669        * p->coef =hh;
670        */
671        d=nMult(h,pGetCoeff(p));
672        nNormalize(d);
673        pSetCoeff(p,d);
674        pIter(p);
675      }
676      nDelete(&h);
677      if (nGetChar()==1)
678      {
679        loop
680        {
681          h = nInit(1);
682          p=ph;
683          while (p!=NULL)
684          {
685            d=nLcm(h,pGetCoeff(p),currRing);
686            nDelete(&h);
687            h=d;
688            pIter(p);
689          }
690          /* contains the 1/lcm of all denominators */
691          if(!nIsOne(h))
692          {
693            p = ph;
694            while (p!=NULL)
695            {
696              /* should be:
697              * number hh;
698              * nGetDenom(p->coef,&hh);
699              * nMult(&h,&hh,&d);
700              * nNormalize(d);
701              * nDelete(&hh);
702              * nMult(d,p->coef,&hh);
703              * nDelete(&d);
704              * nDelete(&(p->coef));
705              * p->coef =hh;
706              */
707              d=nMult(h,pGetCoeff(p));
708              nNormalize(d);
709              pSetCoeff(p,d);
710              pIter(p);
711            }
712            nDelete(&h);
713          }
714          else
715          {
716            nDelete(&h);
717            break;
718          }
719        }
720      }
721    }
722    if (h!=NULL) nDelete(&h);
723 
724    p_Content(ph,r);
725#ifdef HAVE_RATGRING
726    if (rIsRatGRing(r))
727    {
728      /* quick unit detection in the rational case is done in gr_nc_bba */
729      pContentRat(ph);
730      start=ph;
731    }
732#endif
733  }
734  return start;
735}
736
737void p_Cleardenom_n(poly ph,const ring r,number &c)
738{
739  number d, h;
740  poly p;
741
742  p = ph;
743  if(pNext(p)==NULL)
744  {
745    c=nInvers(pGetCoeff(p));
746    pSetCoeff(p,nInit(1));
747  }
748  else
749  {
750    h = nInit(1);
751    while (p!=NULL)
752    {
753      nNormalize(pGetCoeff(p));
754      d=nLcm(h,pGetCoeff(p),r);
755      nDelete(&h);
756      h=d;
757      pIter(p);
758    }
759    c=h;
760    /* contains the 1/lcm of all denominators */
761    if(!nIsOne(h))
762    {
763      p = ph;
764      while (p!=NULL)
765      {
766        /* should be:
767        * number hh;
768        * nGetDenom(p->coef,&hh);
769        * nMult(&h,&hh,&d);
770        * nNormalize(d);
771        * nDelete(&hh);
772        * nMult(d,p->coef,&hh);
773        * nDelete(&d);
774        * nDelete(&(p->coef));
775        * p->coef =hh;
776        */
777        d=nMult(h,pGetCoeff(p));
778        nNormalize(d);
779        pSetCoeff(p,d);
780        pIter(p);
781      }
782      if (nGetChar()==1)
783      {
784        loop
785        {
786          h = nInit(1);
787          p=ph;
788          while (p!=NULL)
789          {
790            d=nLcm(h,pGetCoeff(p),r);
791            nDelete(&h);
792            h=d;
793            pIter(p);
794          }
795          /* contains the 1/lcm of all denominators */
796          if(!nIsOne(h))
797          {
798            p = ph;
799            while (p!=NULL)
800            {
801              /* should be:
802              * number hh;
803              * nGetDenom(p->coef,&hh);
804              * nMult(&h,&hh,&d);
805              * nNormalize(d);
806              * nDelete(&hh);
807              * nMult(d,p->coef,&hh);
808              * nDelete(&d);
809              * nDelete(&(p->coef));
810              * p->coef =hh;
811              */
812              d=nMult(h,pGetCoeff(p));
813              nNormalize(d);
814              pSetCoeff(p,d);
815              pIter(p);
816            }
817            number t=nMult(c,h);
818            nDelete(&c);
819            c=t;
820          }
821          else
822          {
823            break;
824          }
825          nDelete(&h);
826        }
827      }
828    }
829  }
830}
831
832number p_GetAllDenom(poly ph, const ring r)
833{
834  number d=n_Init(1,r);
835  poly p = ph;
836
837  while (p!=NULL)
838  {
839    number h=n_GetDenom(pGetCoeff(p),r);
840    if (!n_IsOne(h,r))
841    {
842      number dd=n_Mult(d,h,r);
843      n_Delete(&d,r);
844      d=dd;
845    }
846    n_Delete(&h,r);
847    pIter(p);
848  }
849  return d;
850}
851
852/*2
853*tests if p is homogeneous with respect to the actual weigths
854*/
855BOOLEAN pIsHomogeneous (poly p)
856{
857  poly qp=p;
858  int o;
859
860  if ((p == NULL) || (pNext(p) == NULL)) return TRUE;
861  pFDegProc d;
862  if (pLexOrder && (currRing->order[0]==ringorder_lp))
863    d=p_Totaldegree;
864  else 
865    d=pFDeg;
866  o = d(p,currRing);
867  do
868  {
869    if (d(qp,currRing) != o) return FALSE;
870    pIter(qp);
871  }
872  while (qp != NULL);
873  return TRUE;
874}
875
876/*2
877*returns a re-ordered copy of a polynomial, with permutation of the variables
878*/
879poly pPermPoly (poly p, int * perm, const ring oldRing, nMapFunc nMap,
880   int *par_perm, int OldPar)
881{
882  int OldpVariables = oldRing->N;
883  poly result = NULL;
884  poly result_last = NULL;
885  poly aq=NULL; /* the map coefficient */
886  poly qq; /* the mapped monomial */
887
888  while (p != NULL)
889  {
890    if ((OldPar==0)||(rField_is_GF(oldRing)))
891    {
892      qq = pInit();
893      number n=nMap(pGetCoeff(p));
894      if ((currRing->minpoly!=NULL)
895      && ((rField_is_Zp_a()) || (rField_is_Q_a())))
896      {
897        nNormalize(n);
898      }
899      pGetCoeff(qq)=n;
900    // coef may be zero:  pTest(qq);
901    }
902    else
903    {
904      qq=pOne();
905      aq=napPermNumber(pGetCoeff(p),par_perm,OldPar, oldRing);
906      if ((aq!=NULL) && (currRing->minpoly!=NULL)
907      && ((rField_is_Zp_a()) || (rField_is_Q_a())))
908      {
909        pNormalize(aq);
910      }
911      pTest(aq);
912      if (aq==NULL)
913        pSetCoeff(qq,nInit(0));
914    }
915    if (rRing_has_Comp(currRing)) pSetComp(qq, p_GetComp(p,oldRing));
916    if (nIsZero(pGetCoeff(qq)))
917    {
918      pLmDelete(&qq);
919    }
920    else
921    {
922      int i;
923      int mapped_to_par=0;
924      for(i=1; i<=OldpVariables; i++)
925      {
926        int e=p_GetExp(p,i,oldRing);
927        if (e!=0)
928        {
929          if (perm==NULL)
930          {
931            pSetExp(qq,i, e);
932          }
933          else if (perm[i]>0)
934            pAddExp(qq,perm[i], e/*p_GetExp( p,i,oldRing)*/);
935          else if (perm[i]<0)
936          {
937            if (rField_is_GF())
938            {
939              number c=pGetCoeff(qq);
940              number ee=nfPar(1);
941              number eee;nfPower(ee,e,&eee); //nfDelete(ee,currRing);
942              ee=nfMult(c,eee);
943              //nfDelete(c,currRing);nfDelete(eee,currRing);
944              pSetCoeff0(qq,ee);
945            }
946            else
947            {
948              lnumber c=(lnumber)pGetCoeff(qq);
949              if (c->z->next==NULL)
950                napAddExp(c->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/);
951              else /* more difficult: we have really to multiply: */
952              {
953                lnumber mmc=(lnumber)naInit(1,currRing);
954                napSetExp(mmc->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/);
955                napSetm(mmc->z);
956                pGetCoeff(qq)=naMult((number)c,(number)mmc);
957                nDelete((number *)&c);
958                nDelete((number *)&mmc); 
959              }
960              mapped_to_par=1;
961            }
962          }
963          else
964          {
965            /* this variable maps to 0 !*/
966            pLmDelete(&qq);
967            break;
968          }
969        }
970      }
971      if (mapped_to_par
972      && (currRing->minpoly!=NULL))
973      {
974        number n=pGetCoeff(qq);
975        nNormalize(n);
976        pGetCoeff(qq)=n;
977      }
978    }
979    pIter(p);
980#if 1
981    if (qq!=NULL)
982    {
983      pSetm(qq);
984      pTest(aq);
985      pTest(qq);
986      if (aq!=NULL) qq=pMult(aq,qq);
987      aq = qq;
988      while (pNext(aq) != NULL) pIter(aq);
989      if (result_last==NULL)
990      {
991        result=qq;
992      }
993      else
994      {
995        pNext(result_last)=qq;
996      }
997      result_last=aq;
998      aq = NULL;
999    }
1000    else if (aq!=NULL)
1001    {
1002      pDelete(&aq);
1003    }
1004  }
1005  result=pSortAdd(result);
1006#else
1007  //  if (qq!=NULL)
1008  //  {
1009  //    pSetm(qq);
1010  //    pTest(qq);
1011  //    pTest(aq);
1012  //    if (aq!=NULL) qq=pMult(aq,qq);
1013  //    aq = qq;
1014  //    while (pNext(aq) != NULL) pIter(aq);
1015  //    pNext(aq) = result;
1016  //    aq = NULL;
1017  //    result = qq;
1018  //  }
1019  //  else if (aq!=NULL)
1020  //  {
1021  //    pDelete(&aq);
1022  //  }
1023  //}
1024  //p = result;
1025  //result = NULL;
1026  //while (p != NULL)
1027  //{
1028  //  qq = p;
1029  //  pIter(p);
1030  //  qq->next = NULL;
1031  //  result = pAdd(result, qq);
1032  //}
1033#endif
1034  pTest(result);
1035  return result;
1036}
1037
1038poly ppJet(poly p, int m)
1039{
1040  poly r=NULL;
1041  poly t=NULL;
1042
1043  while (p!=NULL)
1044  {
1045    if (p_Totaldegree(p,currRing)<=m)
1046    {
1047      if (r==NULL)
1048        r=pHead(p);
1049      else
1050      if (t==NULL)
1051      {
1052        pNext(r)=pHead(p);
1053        t=pNext(r);
1054      }
1055      else
1056      {
1057        pNext(t)=pHead(p);
1058        pIter(t);
1059      }
1060    }
1061    pIter(p);
1062  }
1063  return r;
1064}
1065
1066poly pJet(poly p, int m)
1067{
1068  poly t=NULL;
1069
1070  while((p!=NULL) && (p_Totaldegree(p,currRing)>m)) pLmDelete(&p);
1071  if (p==NULL) return NULL;
1072  poly r=p;
1073  while (pNext(p)!=NULL)
1074  {
1075    if (p_Totaldegree(pNext(p),currRing)>m)
1076    {
1077      pLmDelete(&pNext(p));
1078    }
1079    else
1080      pIter(p);
1081  }
1082  return r;
1083}
1084
1085poly ppJetW(poly p, int m, short *w)
1086{
1087  poly r=NULL;
1088  poly t=NULL;
1089  while (p!=NULL)
1090  {
1091    if (totaldegreeWecart_IV(p,currRing,w)<=m)
1092    {
1093      if (r==NULL)
1094        r=pHead(p);
1095      else
1096      if (t==NULL)
1097      {
1098        pNext(r)=pHead(p);
1099        t=pNext(r);
1100      }
1101      else
1102      {
1103        pNext(t)=pHead(p);
1104        pIter(t);
1105      }
1106    }
1107    pIter(p);
1108  }
1109  return r;
1110}
1111
1112poly pJetW(poly p, int m, short *w)
1113{
1114  while((p!=NULL) && (totaldegreeWecart_IV(p,currRing,w)>m)) pLmDelete(&p);
1115  if (p==NULL) return NULL;
1116  poly r=p;
1117  while (pNext(p)!=NULL)
1118  {
1119    if (totaldegreeWecart_IV(pNext(p),currRing,w)>m)
1120    {
1121      pLmDelete(&pNext(p));
1122    }
1123    else
1124      pIter(p);
1125  }
1126  return r;
1127}
1128
1129int pMinDeg(poly p,intvec *w)
1130{
1131  if(p==NULL)
1132    return -1;
1133  int d=-1;
1134  while(p!=NULL)
1135  {
1136    int d0=0;
1137    for(int j=0;j<pVariables;j++)
1138      if(w==NULL||j>=w->length())
1139        d0+=pGetExp(p,j+1);
1140      else
1141        d0+=(*w)[j]*pGetExp(p,j+1);
1142    if(d0<d||d==-1)
1143      d=d0;
1144    pIter(p);
1145  }
1146  return d;
1147}
1148
1149poly pSeries(int n,poly p,poly u, intvec *w)
1150{
1151  short *ww=iv2array(w);
1152  if(p!=NULL)
1153  {
1154    if(u==NULL)
1155      p=pJetW(p,n,ww);
1156    else
1157      p=pJetW(pMult(p,pInvers(n-pMinDeg(p,w),u,w)),n,ww);
1158  }
1159  omFreeSize((ADDRESS)ww,(pVariables+1)*sizeof(short));
1160  return p;
1161}
1162
1163poly pInvers(int n,poly u,intvec *w)
1164{
1165  short *ww=iv2array(w);
1166  if(n<0)
1167    return NULL;
1168  number u0=nInvers(pGetCoeff(u));
1169  poly v=pNSet(u0);
1170  if(n==0)
1171    return v;
1172  poly u1=pJetW(pSub(pOne(),pMult_nn(u,u0)),n,ww);
1173  if(u1==NULL)
1174    return v;
1175  poly v1=pMult_nn(pCopy(u1),u0);
1176  v=pAdd(v,pCopy(v1));
1177  for(int i=n/pMinDeg(u1,w);i>1;i--)
1178  {
1179    v1=pJetW(pMult(v1,pCopy(u1)),n,ww);
1180    v=pAdd(v,pCopy(v1));
1181  }
1182  pDelete(&u1);
1183  pDelete(&v1);
1184  omFreeSize((ADDRESS)ww,(pVariables+1)*sizeof(short));
1185  return v;
1186}
1187
1188long pDegW(poly p, const short *w)
1189{
1190  long r=-LONG_MAX;
1191
1192  while (p!=NULL)
1193  {
1194    long t=totaldegreeWecart_IV(p,currRing,w);
1195    if (t>r) r=t;
1196    pIter(p);
1197  }
1198  return r;
1199}
1200
1201/*-----------type conversions ----------------------------*/
1202#if 0
1203/*2
1204* input: a set of polys (len elements: p[0]..p[len-1])
1205* output: a vector
1206* p will not be changed
1207*/
1208poly  pPolys2Vec(polyset p, int len)
1209{
1210  poly v=NULL;
1211  poly h;
1212  int i;
1213
1214  for (i=len-1; i>=0; i--)
1215  {
1216    if (p[i])
1217    {
1218      h=pCopy(p[i]);
1219      pSetCompP(h,i+1);
1220      v=pAdd(v,h);
1221    }
1222  }
1223 return v;
1224}
1225#endif
1226
1227/*2
1228* convert a vector to a set of polys,
1229* allocates the polyset, (entries 0..(*len)-1)
1230* the vector will not be changed
1231*/
1232void  pVec2Polys(poly v, polyset *p, int *len)
1233{
1234  poly h;
1235  int k;
1236
1237  *len=pMaxComp(v);
1238  if (*len==0) *len=1;
1239  *p=(polyset)omAlloc0((*len)*sizeof(poly));
1240  while (v!=NULL)
1241  {
1242    h=pHead(v);
1243    k=pGetComp(h);
1244    pSetComp(h,0);
1245    (*p)[k-1]=pAdd((*p)[k-1],h);
1246    pIter(v);
1247  }
1248}
1249
1250int p_Var(poly m,const ring r)
1251{
1252  if (m==NULL) return 0;
1253  if (pNext(m)!=NULL) return 0;
1254  int i,e=0;
1255  for (i=r->N; i>0; i--)
1256  {
1257    int exp=p_GetExp(m,i,r);
1258    if (exp==1)
1259    {
1260      if (e==0) e=i;
1261      else return 0;
1262    }
1263    else if (exp!=0)
1264    {
1265      return 0;
1266    }
1267  }
1268  return e;
1269}
1270
1271/*2
1272* returns TRUE if p1 = p2
1273*/
1274BOOLEAN p_EqualPolys(poly p1,poly p2, const ring r)
1275{
1276  while ((p1 != NULL) && (p2 != NULL))
1277  {
1278    if (! p_LmEqual(p1, p2,r))
1279      return FALSE;
1280    if (! n_Equal(p_GetCoeff(p1,r), p_GetCoeff(p2,r),r ))
1281      return FALSE;
1282    pIter(p1);
1283    pIter(p2);
1284  }
1285  return (p1==p2);
1286}
1287
1288/*2
1289*returns TRUE if p1 is a skalar multiple of p2
1290*assume p1 != NULL and p2 != NULL
1291*/
1292BOOLEAN pComparePolys(poly p1,poly p2)
1293{
1294  number n,nn;
1295  pAssume(p1 != NULL && p2 != NULL);
1296
1297  if (!pLmEqual(p1,p2)) //compare leading mons
1298      return FALSE;
1299  if ((pNext(p1)==NULL) && (pNext(p2)!=NULL))
1300     return FALSE;
1301  if ((pNext(p2)==NULL) && (pNext(p1)!=NULL))
1302     return FALSE;
1303  if (pLength(p1) != pLength(p2))
1304    return FALSE;
1305#ifdef HAVE_RINGS
1306  if (rField_is_Ring(currRing))
1307  {
1308    if (!nDivBy(pGetCoeff(p1), pGetCoeff(p2))) return FALSE;
1309  }
1310#endif
1311  n=nDiv(pGetCoeff(p1),pGetCoeff(p2));
1312  while ((p1 != NULL) /*&& (p2 != NULL)*/)
1313  {
1314    if ( ! pLmEqual(p1, p2))
1315    {
1316        nDelete(&n);
1317        return FALSE;
1318    }
1319    if (!nEqual(pGetCoeff(p1),nn=nMult(pGetCoeff(p2),n)))
1320    {
1321      nDelete(&n);
1322      nDelete(&nn);
1323      return FALSE;
1324    }
1325    nDelete(&nn);
1326    pIter(p1);
1327    pIter(p2);
1328  }
1329  nDelete(&n);
1330  return TRUE;
1331}
Note: See TracBrowser for help on using the repository browser.