source: git/Singular/polys1.cc @ 50cbdc

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