source: git/Singular/polys1.cc @ ab26fe

spielwiese
Last change on this file since ab26fe was ab26fe, checked in by Hans Schönemann <hannes@…>, 23 years ago
*hannes: fixed pJet git-svn-id: file:///usr/local/Singular/svn/trunk@5211 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 25.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: polys1.cc,v 1.64 2001-02-08 13:46:36 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(pNext(ph)==NULL)
475  {
476    pSetCoeff(ph,nInit(1));
477  }
478  else
479  {
480    nNormalize(pGetCoeff(ph));
481    if(!nGreaterZero(pGetCoeff(ph))) ph = pNeg(ph);
482    h=nCopy(pGetCoeff(ph));
483    p = pNext(ph);
484    while (p!=NULL)
485    {
486      nNormalize(pGetCoeff(p));
487      d=nGcd(h,pGetCoeff(p),currRing);
488      nDelete(&h);
489      h = d;
490      if(nIsOne(h))
491      {
492        break;
493      }
494      pIter(p);
495    }
496    p = ph;
497    //number tmp;
498    if(!nIsOne(h))
499    {
500      while (p!=NULL)
501      {
502        //d = nDiv(pGetCoeff(p),h);
503        //tmp = nIntDiv(pGetCoeff(p),h);
504        //if (!nEqual(d,tmp))
505        //{
506        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
507        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
508        //  nWrite(tmp);Print(StringAppendS("\n"));
509        //}
510        //nDelete(&tmp);
511        d = nIntDiv(pGetCoeff(p),h);
512        pSetCoeff(p,d);
513        pIter(p);
514      }
515    }
516    nDelete(&h);
517#ifdef HAVE_FACTORY
518    if ( (nGetChar() == 1) || (nGetChar() < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
519    {
520      singclap_divide_content(ph);
521      if(!nGreaterZero(pGetCoeff(ph))) ph = pNeg(ph);
522    }
523#endif
524  }
525}
526
527//void pContent(poly ph)
528//{
529//  number h,d;
530//  poly p;
531//
532//  p = ph;
533//  if(pNext(p)==NULL)
534//  {
535//    pSetCoeff(p,nInit(1));
536//  }
537//  else
538//  {
539//#ifdef PDEBUG
540//    if (!pTest(p)) return;
541//#endif
542//    nNormalize(pGetCoeff(p));
543//    if(!nGreaterZero(pGetCoeff(ph)))
544//    {
545//      ph = pNeg(ph);
546//      nNormalize(pGetCoeff(p));
547//    }
548//    h=pGetCoeff(p);
549//    pIter(p);
550//    while (p!=NULL)
551//    {
552//      nNormalize(pGetCoeff(p));
553//      if (nGreater(h,pGetCoeff(p))) h=pGetCoeff(p);
554//      pIter(p);
555//    }
556//    h=nCopy(h);
557//    p=ph;
558//    while (p!=NULL)
559//    {
560//      d=nGcd(h,pGetCoeff(p));
561//      nDelete(&h);
562//      h = d;
563//      if(nIsOne(h))
564//      {
565//        break;
566//      }
567//      pIter(p);
568//    }
569//    p = ph;
570//    //number tmp;
571//    if(!nIsOne(h))
572//    {
573//      while (p!=NULL)
574//      {
575//        d = nIntDiv(pGetCoeff(p),h);
576//        pSetCoeff(p,d);
577//        pIter(p);
578//      }
579//    }
580//    nDelete(&h);
581//#ifdef HAVE_FACTORY
582//    if ( (nGetChar() == 1) || (nGetChar() < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
583//    {
584//      pTest(ph);
585//      singclap_divide_content(ph);
586//      pTest(ph);
587//    }
588//#endif
589//  }
590//}
591void p_Content(poly ph, ring r)
592{
593  number h,d;
594  poly p;
595
596  if(pNext(ph)==NULL)
597  {
598    pSetCoeff(ph,n_Init(1,r));
599  }
600  else
601  {
602    n_Normalize(pGetCoeff(ph),r);
603    if(!n_GreaterZero(pGetCoeff(ph),r)) ph = p_Neg(ph,r);
604    h=n_Copy(pGetCoeff(ph),r);
605    p = pNext(ph);
606    while (p!=NULL)
607    {
608      n_Normalize(pGetCoeff(p),r);
609      d=n_Gcd(h,pGetCoeff(p),r);
610      n_Delete(&h,r);
611      h = d;
612      if(n_IsOne(h,r))
613      {
614        break;
615      }
616      pIter(p);
617    }
618    p = ph;
619    //number tmp;
620    if(!n_IsOne(h,r))
621    {
622      while (p!=NULL)
623      {
624        //d = nDiv(pGetCoeff(p),h);
625        //tmp = nIntDiv(pGetCoeff(p),h);
626        //if (!nEqual(d,tmp))
627        //{
628        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
629        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
630        //  nWrite(tmp);Print(StringAppendS("\n"));
631        //}
632        //nDelete(&tmp);
633        d = n_IntDiv(pGetCoeff(p),h,r);
634        p_SetCoeff(p,d,r);
635        pIter(p);
636      }
637    }
638    n_Delete(&h,r);
639#ifdef HAVE_FACTORY
640    //if ( (nGetChar() == 1) || (nGetChar() < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
641    //{
642    //  singclap_divide_content(ph);
643    //  if(!nGreaterZero(pGetCoeff(ph))) ph = pNeg(ph);
644    //}
645#endif
646  }
647}
648
649void pCleardenom(poly ph)
650{
651  number d, h;
652  poly p;
653
654  p = ph;
655  if(pNext(p)==NULL)
656  {
657    pSetCoeff(p,nInit(1));
658  }
659  else
660  {
661    h = nInit(1);
662    while (p!=NULL)
663    {
664      nNormalize(pGetCoeff(p));
665      d=nLcm(h,pGetCoeff(p),currRing);
666      nDelete(&h);
667      h=d;
668      pIter(p);
669    }
670    /* contains the 1/lcm of all denominators */
671    if(!nIsOne(h))
672    {
673      p = ph;
674      while (p!=NULL)
675      {
676        /* should be:
677        * number hh;
678        * nGetDenom(p->coef,&hh);
679        * nMult(&h,&hh,&d);
680        * nNormalize(d);
681        * nDelete(&hh);
682        * nMult(d,p->coef,&hh);
683        * nDelete(&d);
684        * nDelete(&(p->coef));
685        * p->coef =hh;
686        */
687        d=nMult(h,pGetCoeff(p));
688        nNormalize(d);
689        pSetCoeff(p,d);
690        pIter(p);
691      }
692      nDelete(&h);
693      if (nGetChar()==1)
694      {
695        loop
696        {
697          h = nInit(1);
698          p=ph;
699          while (p!=NULL)
700          {
701            d=nLcm(h,pGetCoeff(p),currRing);
702            nDelete(&h);
703            h=d;
704            pIter(p);
705          }
706          /* contains the 1/lcm of all denominators */
707          if(!nIsOne(h))
708          {
709            p = ph;
710            while (p!=NULL)
711            {
712              /* should be:
713              * number hh;
714              * nGetDenom(p->coef,&hh);
715              * nMult(&h,&hh,&d);
716              * nNormalize(d);
717              * nDelete(&hh);
718              * nMult(d,p->coef,&hh);
719              * nDelete(&d);
720              * nDelete(&(p->coef));
721              * p->coef =hh;
722              */
723              d=nMult(h,pGetCoeff(p));
724              nNormalize(d);
725              pSetCoeff(p,d);
726              pIter(p);
727            }
728            nDelete(&h);
729          }
730          else
731          {
732            nDelete(&h);
733            break;
734          }
735        }
736      }
737    }
738    if (h!=NULL) nDelete(&h);
739    pContent(ph);
740  }
741}
742
743/*2
744*tests if p is homogeneous with respect to the actual weigths
745*/
746BOOLEAN pIsHomogeneous (poly p)
747{
748  poly qp=p;
749  int o;
750
751  if ((p == NULL) || (pNext(p) == NULL)) return TRUE;
752  pFDegProc d=(pLexOrder ? pTotaldegree : pFDeg );
753  o = d(p);
754  do
755  {
756    if (d(qp) != o) return FALSE;
757    pIter(qp);
758  }
759  while (qp != NULL);
760  return TRUE;
761}
762
763// orders monoms of poly using merge sort (ususally faster than
764// insertion sort). ASSUMES that pSetm was performed on monoms
765poly pOrdPolyMerge(poly p)
766{
767  poly qq,pp,result=NULL;
768
769  if (p == NULL) return NULL;
770
771  loop
772  {
773    qq = p;
774    loop
775    {
776      if (pNext(p) == NULL)
777      {
778        result=pAdd(result, qq);
779        pTest(result);
780        return result;
781      }
782      if (pLmCmp(p,pNext(p)) != 1)
783      {
784        pp = p;
785        pIter(p);
786        pNext(pp) = NULL;
787        result = pAdd(result, qq);
788        break;
789      }
790      pIter(p);
791    }
792  }
793}
794
795// orders monoms of poly using insertion sort, performs pSetm on each monom
796poly pOrdPolyInsertSetm(poly p)
797{
798  poly qq,result = NULL;
799
800#if 0
801  while (p != NULL)
802  {
803    qq = p;
804    pIter(p);
805    qq->next = NULL;
806    pSetm(qq);
807    result = pAdd(result,qq);
808    pTest(result);
809  }
810#else
811  while (p != NULL)
812  {
813    qq = p;
814    pIter(p);
815    qq->next = result;
816    result = qq;
817    pSetm(qq);
818  }
819  p = result;
820  result = NULL;
821  while (p != NULL)
822  {
823    qq = p;
824    pIter(p);
825    qq->next = NULL;
826    result = pAdd(result, qq);
827  }
828  pTest(result);
829#endif
830  return result;
831}
832
833/*2
834*returns a re-ordered copy of a polynomial, with permutation of the variables
835*/
836poly pPermPoly (poly p, int * perm, ring oldRing, nMapFunc nMap,
837   int *par_perm, int OldPar)
838{
839  int OldpVariables = oldRing->N;
840  poly result = NULL;
841  poly result_last = NULL;
842  poly aq=NULL; /* the map coefficient */
843  poly qq; /* the mapped monomial */
844
845  while (p != NULL)
846  {
847    if ((OldPar==0)||(rField_is_GF(oldRing)))
848    {
849      qq = pInit();
850      number n=nMap(pGetCoeff(p));
851      if ((currRing->minpoly!=NULL)
852      && ((rField_is_Zp_a()) || (rField_is_Q_a())))
853      {
854        nNormalize(n);
855      }
856      pGetCoeff(qq)=n;
857    // coef may be zero:  pTest(qq);
858    }
859    else
860    {
861      qq=pOne();
862      aq=naPermNumber(pGetCoeff(p),par_perm,OldPar, oldRing);
863      if ((currRing->minpoly!=NULL)
864      && ((rField_is_Zp_a()) || (rField_is_Q_a())))
865      {
866        poly tmp=aq;
867        while (tmp!=NULL)
868        {
869          number n=pGetCoeff(tmp);
870          nNormalize(n);
871          pGetCoeff(tmp)=n;
872          pIter(tmp);
873        }
874      }
875      pTest(aq);
876    }
877    pSetComp(qq, p_GetComp(p,oldRing));
878    if (nIsZero(pGetCoeff(qq)))
879    {
880      pDeleteLm(&qq);
881    }
882    else
883    {
884      int i;
885      int mapped_to_par=0;
886      for(i=1; i<=OldpVariables; i++)
887      {
888        int e=p_GetExp(p,i,oldRing);
889        if (e!=0)
890        {
891          if (perm==NULL)
892          {
893            pSetExp(qq,i, e);
894          }
895          else if (perm[i]>0)
896            pAddExp(qq,perm[i], e/*p_GetExp( p,i,oldRing)*/);
897          else if (perm[i]<0)
898          {
899            if (rField_is_GF())
900            {
901              number c=pGetCoeff(qq);
902              number ee=nfPar(1);
903              number eee;nfPower(ee,e,&eee); //nfDelete(ee,currRing);
904              ee=nfMult(c,eee);
905              //nfDelete(c,currRing);nfDelete(eee,currRing);
906              pSetCoeff0(qq,ee);
907            }
908            else
909            {
910              lnumber c=(lnumber)pGetCoeff(qq);
911              napAddExp(c->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/);
912              mapped_to_par=1;
913            }
914          }
915          else
916          {
917            /* this variable maps to 0 !*/
918            pDeleteLm(&qq);
919            break;
920          }
921        }
922      }
923      if (mapped_to_par
924      && (currRing->minpoly!=NULL))
925      {
926        number n=pGetCoeff(qq);
927        nNormalize(n);
928        pGetCoeff(qq)=n;
929      }
930    }
931    pIter(p);
932#if 1
933    if (qq!=NULL)
934    {
935      pSetm(qq);
936      pTest(aq);
937      pTest(qq);
938      if (aq!=NULL) qq=pMult(aq,qq);
939      aq = qq;
940      while (pNext(aq) != NULL) pIter(aq);
941      if (result_last==NULL)
942      {
943        result=qq;
944      }
945      else
946      {
947        pNext(result_last)=qq;
948      }
949      result_last=aq;
950      aq = NULL;
951    }
952    else if (aq!=NULL)
953    {
954      pDelete(&aq);
955    }
956  }
957  result=pSortAdd(result);
958#else
959  //  if (qq!=NULL)
960  //  {
961  //    pSetm(qq);
962  //    pTest(qq);
963  //    pTest(aq);
964  //    if (aq!=NULL) qq=pMult(aq,qq);
965  //    aq = qq;
966  //    while (pNext(aq) != NULL) pIter(aq);
967  //    pNext(aq) = result;
968  //    aq = NULL;
969  //    result = qq;
970  //  }
971  //  else if (aq!=NULL)
972  //  {
973  //    pDelete(&aq);
974  //  }
975  //}
976  //p = result;
977  //result = NULL;
978  //while (p != NULL)
979  //{
980  //  qq = p;
981  //  pIter(p);
982  //  qq->next = NULL;
983  //  result = pAdd(result, qq);
984  //}
985#endif
986  pTest(result);
987  return result;
988}
989
990#if 0
991/*2
992*returns a re-ordered copy of a polynomial, with permutation of the variables
993*/
994poly p_PermPoly (poly p, int * perm, ring oldRing,
995   int *par_perm, int OldPar, ring newRing)
996{
997  int OldpVariables = oldRing->N;
998  poly result = NULL;
999  poly result_last = NULL;
1000  poly aq=NULL; /* the map coefficient */
1001  poly qq; /* the mapped monomial */
1002
1003  while (p != NULL)
1004  {
1005    if (OldPar==0)
1006    {
1007      qq = pInit();
1008      number n=newRing->cf->nMap(pGetCoeff(p));
1009      if ((newRing->minpoly!=NULL)
1010      && ((rField_is_Zp_a(newRing)) || (rField_is_Q_a(newRing))))
1011      {
1012        newRing->cf->nNormalize(n);
1013      }
1014      pGetCoeff(qq)=n;
1015    // coef may be zero:  pTest(qq);
1016    }
1017    else
1018    {
1019      qq=p_ISet(1, newRing);
1020      aq=naPermNumber(pGetCoeff(p),par_perm,OldPar, oldRing);
1021      if ((newRing->minpoly!=NULL)
1022      && ((rField_is_Zp_a(newRing)) || (rField_is_Q_a(newRing))))
1023      {
1024        poly tmp=aq;
1025        while (tmp!=NULL)
1026        {
1027          number n=pGetCoeff(tmp);
1028          newRing->cf->nNormalize(n);
1029          pGetCoeff(tmp)=n;
1030          pIter(tmp);
1031        }
1032      }
1033      //pTest(aq);
1034    }
1035    p_SetComp(qq, p_GetComp(p,oldRing), newRing);
1036    if (newRing->cf->nIsZero(pGetCoeff(qq)))
1037    {
1038      p_DeleteLm(&qq, newRing);
1039    }
1040    else
1041    {
1042      int i;
1043      int mapped_to_par=0;
1044      for(i=1; i<=OldpVariables; i++)
1045      {
1046        int e=p_GetExp(p,i,oldRing);
1047        if (e!=0)
1048        {
1049          if (perm==NULL)
1050          {
1051            p_SetExp(qq,i, e, newRing);
1052          }
1053          else if (perm[i]>0)
1054            p_AddExp(qq,perm[i], e/*p_GetExp( p,i,oldRing)*/, newRing);
1055          else if (perm[i]<0)
1056          {
1057            lnumber c=(lnumber)pGetCoeff(qq);
1058            napAddExp(c->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/);
1059            mapped_to_par=1;
1060          }
1061          else
1062          {
1063            /* this variable maps to 0 !*/
1064            p_DeleteLm(&qq, newRing);
1065            break;
1066          }
1067        }
1068      }
1069      if (mapped_to_par
1070      && (newRing->minpoly!=NULL))
1071      {
1072        number n=pGetCoeff(qq);
1073        newRing->cf->nNormalize(n);
1074        pGetCoeff(qq)=n;
1075      }
1076    }
1077    pIter(p);
1078    if (qq!=NULL)
1079    {
1080      p_Setm(qq, newRing);
1081      //pTest(aq);
1082      //pTest(qq);
1083      if (aq!=NULL) qq=pMult(aq,qq);
1084      aq = qq;
1085      while (pNext(aq) != NULL) pIter(aq);
1086      if (result_last==NULL)
1087      {
1088        result=qq;
1089      }
1090      else
1091      {
1092        pNext(result_last)=qq;
1093      }
1094      result_last=aq;
1095      aq = NULL;
1096    }
1097    else if (aq!=NULL)
1098    {
1099      p_Delete(&aq, newRing);
1100    }
1101  }
1102  result=pOrdPolyMerge(result);
1103  //pTest(result);
1104  return result;
1105}
1106#endif
1107
1108poly ppJet(poly p, int m)
1109{
1110  poly r=NULL;
1111  poly t=NULL;
1112
1113  while (p!=NULL)
1114  {
1115    if (pTotaldegree(p)<=m)
1116    {
1117      if (r==NULL)
1118        r=pHead(p);
1119      else
1120      if (t==NULL)
1121      {
1122        pNext(r)=pHead(p);
1123        t=pNext(r);
1124      }
1125      else
1126      {
1127        pNext(t)=pHead(p);
1128        pIter(t);
1129      }
1130    }
1131    pIter(p);
1132  }
1133  return r;
1134}
1135
1136poly pJet(poly p, int m)
1137{
1138  poly t=NULL;
1139
1140  while((p!=NULL) && (pTotaldegree(p)>m)) pLmDelete(&p);
1141  if (p==NULL) return NULL;
1142  poly r=p;
1143  while (pNext(p)!=NULL)
1144  {
1145    if (pTotaldegree(pNext(p))>m)
1146    {
1147      pLmDelete(&pNext(p));
1148    }
1149    else
1150      pIter(p);
1151  }
1152  return r;
1153}
1154
1155poly ppJetW(poly p, int m, short *w)
1156{
1157  poly r=NULL;
1158  poly t=NULL;
1159  short *wsave=ecartWeights;
1160
1161  ecartWeights=w;
1162
1163  while (p!=NULL)
1164  {
1165    if (totaldegreeWecart(p)<=m)
1166    {
1167      if (r==NULL)
1168        r=pHead(p);
1169      else
1170      if (t==NULL)
1171      {
1172        pNext(r)=pHead(p);
1173        t=pNext(r);
1174      }
1175      else
1176      {
1177        pNext(t)=pHead(p);
1178        pIter(t);
1179      }
1180    }
1181    pIter(p);
1182  }
1183  ecartWeights=wsave;
1184  return r;
1185}
1186
1187poly pSeries(int n,poly p,poly u=NULL)
1188{
1189  if(p!=NULL)
1190  {
1191    if(u==NULL)
1192      p=pJet(p,n);
1193    else
1194      p=pJet(pMult(p,pInvers(n-pTotaldegree(p),u)),n);
1195  }
1196  return p;
1197}
1198
1199poly pInvers(int n,poly u)
1200{
1201  if(n<0)
1202    return NULL;
1203  number u0=nInvers(pGetCoeff(u));
1204  poly v=pNSet(u0);
1205  if(n==0)
1206    return v;
1207  /* u0 is pGetCoeff(v) */ 
1208  poly u1=pJet(pSub(pOne(),pMult_nn(u,u0)),n);
1209  if(u1==NULL)
1210    return v;
1211  poly v1=pMult_nn(pCopy(u1),u0);
1212  v=pAdd(v,pCopy(v1));
1213  for(int i=n/pTotaldegree(u1);i>1;i--)
1214  {
1215    v1=pJet(pMult(v1,pCopy(u1)),n);
1216    v=pAdd(v,pCopy(v1));
1217  }
1218  pDelete(&u1);
1219  pDelete(&v1);
1220  return v;
1221}
1222
1223int pDegW(poly p, short *w)
1224{
1225  int r=0;
1226  short *wsave=ecartWeights;
1227
1228  ecartWeights=w;
1229
1230  while (p!=NULL)
1231  {
1232    r=max(r, totaldegreeWecart(p));
1233    pIter(p);
1234  }
1235  ecartWeights=wsave;
1236  return r;
1237}
1238
1239/*-----------type conversions ----------------------------*/
1240/*2
1241* input: a set of polys (len elements: p[0]..p[len-1])
1242* output: a vector
1243* p will not be changed
1244*/
1245poly  pPolys2Vec(polyset p, int len)
1246{
1247  poly v=NULL;
1248  poly h;
1249  int i;
1250
1251  for (i=len-1; i>=0; i--)
1252  {
1253    if (p[i])
1254    {
1255      h=pCopy(p[i]);
1256      pSetCompP(h,i+1);
1257      v=pAdd(v,h);
1258    }
1259  }
1260 return v;
1261}
1262
1263/*2
1264* convert a vector to a set of polys,
1265* allocates the polyset, (entries 0..(*len)-1)
1266* the vector will not be changed
1267*/
1268void  pVec2Polys(poly v, polyset *p, int *len)
1269{
1270  poly h;
1271  int k;
1272
1273  *len=pMaxComp(v);
1274  if (*len==0) *len=1;
1275  *p=(polyset)omAlloc0((*len)*sizeof(poly));
1276  while (v!=NULL)
1277  {
1278    h=pHead(v);
1279    k=pGetComp(h);
1280    pSetComp(h,0);
1281    (*p)[k-1]=pAdd((*p)[k-1],h);
1282    pIter(v);
1283  }
1284}
1285
1286int pVar(poly m)
1287{
1288  if (m==NULL) return 0;
1289  if (pNext(m)!=NULL) return 0;
1290  int i,e=0;
1291  for (i=pVariables; i>0; i--)
1292  {
1293    if (pGetExp(m,i)==1)
1294    {
1295      if (e==0) e=i;
1296      else return 0;
1297    }
1298  }
1299  return e;
1300}
1301
1302/*----------utilities for syzygies--------------*/
1303//BOOLEAN   pVectorHasUnitM(poly p, int * k)
1304//{
1305//  while (p!=NULL)
1306//  {
1307//    if (pLmIsConstantComp(p))
1308//    {
1309//      *k = pGetComp(p);
1310//      return TRUE;
1311//    }
1312//    else pIter(p);
1313//  }
1314//  return FALSE;
1315//}
1316
1317BOOLEAN   pVectorHasUnitB(poly p, int * k)
1318{
1319  poly q=p,qq;
1320  int i;
1321
1322  while (q!=NULL)
1323  {
1324    if (pLmIsConstantComp(q))
1325    {
1326      i = pGetComp(q);
1327      qq = p;
1328      while ((qq != q) && (pGetComp(qq) != i)) pIter(qq);
1329      if (qq == q)
1330      {
1331        *k = i;
1332        return TRUE;
1333      }
1334      else
1335        pIter(q);
1336    }
1337    else pIter(q);
1338  }
1339  return FALSE;
1340}
1341
1342void   pVectorHasUnit(poly p, int * k, int * len)
1343{
1344  poly q=p,qq;
1345  int i,j=0;
1346
1347  *len = 0;
1348  while (q!=NULL)
1349  {
1350    if (pLmIsConstantComp(q))
1351    {
1352      i = pGetComp(q);
1353      qq = p;
1354      while ((qq != q) && (pGetComp(qq) != i)) pIter(qq);
1355      if (qq == q)
1356      {
1357       j = 0;
1358       while (qq!=NULL)
1359       {
1360         if (pGetComp(qq)==i) j++;
1361        pIter(qq);
1362       }
1363       if ((*len == 0) || (j<*len))
1364       {
1365         *len = j;
1366         *k = i;
1367       }
1368      }
1369    }
1370    pIter(q);
1371  }
1372}
1373
1374/*2
1375* returns TRUE if p1 = p2
1376*/
1377BOOLEAN pEqualPolys(poly p1,poly p2)
1378{
1379  while ((p1 != NULL) && (p2 != NULL))
1380  {
1381    if (! pLmEqual(p1, p2))
1382      return FALSE;
1383    if (! nEqual(pGetCoeff(p1), pGetCoeff(p2)))
1384      return FALSE;
1385    pIter(p1);
1386    pIter(p2);
1387  }
1388  return (p1==p2);
1389}
1390
1391/*2
1392*returns TRUE if p1 is a skalar multiple of p2
1393*assume p1 != NULL and p2 != NULL
1394*/
1395BOOLEAN pComparePolys(poly p1,poly p2)
1396{
1397  number n,nn;
1398  int i;
1399  pAssume(p1 != NULL && p2 != NULL);
1400
1401  if (!pLmEqual(p1,p2)) //compare leading mons
1402      return FALSE;
1403  if ((pNext(p1)==NULL) && (pNext(p2)!=NULL))
1404     return FALSE;
1405  if ((pNext(p2)==NULL) && (pNext(p1)!=NULL))
1406     return FALSE;
1407  if (pLength(p1) != pLength(p2))
1408    return FALSE;
1409  n=nDiv(pGetCoeff(p1),pGetCoeff(p2));
1410  while ((p1 != NULL) /*&& (p2 != NULL)*/)
1411  {
1412    if ( ! pLmEqual(p1, p2))
1413    {
1414        nDelete(&n);
1415        return FALSE;
1416    }
1417    if (!nEqual(pGetCoeff(p1),nn=nMult(pGetCoeff(p2),n)))
1418    {
1419      nDelete(&n);
1420      nDelete(&nn);
1421      return FALSE;
1422    }
1423    nDelete(&nn);
1424    pIter(p1);
1425    pIter(p2);
1426  }
1427  nDelete(&n);
1428  return TRUE;
1429}
Note: See TracBrowser for help on using the repository browser.