source: git/kernel/polys1.cc @ 4bbe3b

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