source: git/kernel/polys1.cc @ 68349d

spielwiese
Last change on this file since 68349d was 3d9ed9, checked in by Viktor Levandovskyy <levandov@…>, 20 years ago
*levandov: Plural Power fix git-svn-id: file:///usr/local/Singular/svn/trunk@7108 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 27.3 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: polys1.cc,v 1.3 2004-03-25 21:16:47 levandov 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#ifdef HAVE_PLURAL
326          if (rIsPluralRing(currRing)) /* in the NC case nothing helps :-( */
327          {
328            int j=i;
329            rc = pCopy(p);
330            while (j>1)
331            {
332              rc = pMult(pCopy(p),rc);
333              j--;
334            }
335            pDelete(&p);
336            return rc;
337          }
338#endif
339          rc = pNext(p);
340          if (rc == NULL)
341            return pMonPower(p,i);
342          /* else: binom ?*/
343          int char_p=rChar(currRing);
344          if (pNext(rc) != NULL)
345            return pPow(p,i);
346          if ((char_p==0) || (i<=char_p))
347            return pTwoMonPower(p,i);
348          poly p_p=pTwoMonPower(pCopy(p),char_p);
349          return pMult(pPower(p,i-char_p),p_p);
350        }
351      /*end default:*/
352    }
353  }
354  return rc;
355}
356
357/*2
358* returns the partial differentiate of a by the k-th variable
359* does not destroy the input
360*/
361poly pDiff(poly a, int k)
362{
363  poly res, f, last;
364  number t;
365
366  last = res = NULL;
367  while (a!=NULL)
368  {
369    if (pGetExp(a,k)!=0)
370    {
371      f = pLmInit(a);
372      t = nInit(pGetExp(a,k));
373      pSetCoeff0(f,nMult(t,pGetCoeff(a)));
374      nDelete(&t);
375      if (nIsZero(pGetCoeff(f)))
376        pDeleteLm(&f);
377      else
378      {
379        pDecrExp(f,k);
380        pSetm(f);
381        if (res==NULL)
382        {
383          res=last=f;
384        }
385        else
386        {
387          pNext(last)=f;
388          last=f;
389        }
390      }
391    }
392    pIter(a);
393  }
394  return res;
395}
396
397static poly pDiffOpM(poly a, poly b,BOOLEAN multiply)
398{
399  int i,j,s;
400  number n,h,hh;
401  poly p=pOne();
402  n=nMult(pGetCoeff(a),pGetCoeff(b));
403  for(i=pVariables;i>0;i--)
404  {
405    s=pGetExp(b,i);
406    if (s<pGetExp(a,i))
407    {
408      nDelete(&n);
409      pDeleteLm(&p);
410      return NULL;
411    }
412    if (multiply)
413    {
414      for(j=pGetExp(a,i); j>0;j--)
415      {
416        h = nInit(s);
417        hh=nMult(n,h);
418        nDelete(&h);
419        nDelete(&n);
420        n=hh;
421        s--;
422      }
423      pSetExp(p,i,s);
424    }
425    else
426    {
427      pSetExp(p,i,s-pGetExp(a,i));
428    }
429  }
430  pSetm(p);
431  /*if (multiply)*/ pSetCoeff(p,n);
432  return p;
433}
434
435poly pDiffOp(poly a, poly b,BOOLEAN multiply)
436{
437  poly result=NULL;
438  poly h;
439  for(;a!=NULL;pIter(a))
440  {
441    for(h=b;h!=NULL;pIter(h))
442    {
443      result=pAdd(result,pDiffOpM(a,h,multiply));
444    }
445  }
446  return result;
447}
448
449
450void pSplit(poly p, poly *h)
451{
452  *h=pNext(p);
453  pNext(p)=NULL;
454}
455
456
457
458int pMaxCompProc(poly p)
459{
460  return pMaxComp(p);
461}
462
463/*2
464* handle memory request for sets of polynomials (ideals)
465* l is the length of *p, increment is the difference (may be negative)
466*/
467void pEnlargeSet(polyset *p, int l, int increment)
468{
469  int i;
470  polyset h;
471
472  h=(polyset)omReallocSize((poly*)*p,l*sizeof(poly),(l+increment)*sizeof(poly));
473  if (increment>0)
474  {
475    //for (i=l; i<l+increment; i++)
476    //  h[i]=NULL;
477    memset(&(h[l]),0,increment*sizeof(poly));
478  }
479  *p=h;
480}
481
482void pContent(poly ph)
483{
484  number h,d;
485  poly p;
486
487  if(TEST_OPT_CONTENTSB) return;
488  if(pNext(ph)==NULL)
489  {
490    pSetCoeff(ph,nInit(1));
491  }
492  else
493  {
494    nNormalize(pGetCoeff(ph));
495    if(!nGreaterZero(pGetCoeff(ph))) ph = pNeg(ph);
496    h=nCopy(pGetCoeff(ph));
497    p = pNext(ph);
498    while (p!=NULL)
499    {
500      nNormalize(pGetCoeff(p));
501      d=nGcd(h,pGetCoeff(p),currRing);
502      nDelete(&h);
503      h = d;
504      if(nIsOne(h))
505      {
506        break;
507      }
508      pIter(p);
509    }
510    p = ph;
511    //number tmp;
512    if(!nIsOne(h))
513    {
514      while (p!=NULL)
515      {
516        //d = nDiv(pGetCoeff(p),h);
517        //tmp = nIntDiv(pGetCoeff(p),h);
518        //if (!nEqual(d,tmp))
519        //{
520        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
521        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
522        //  nWrite(tmp);Print(StringAppendS("\n"));
523        //}
524        //nDelete(&tmp);
525        d = nIntDiv(pGetCoeff(p),h);
526        pSetCoeff(p,d);
527        pIter(p);
528      }
529    }
530    nDelete(&h);
531#ifdef HAVE_FACTORY
532    if ( (nGetChar() == 1) || (nGetChar() < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
533    {
534      singclap_divide_content(ph);
535      if(!nGreaterZero(pGetCoeff(ph))) ph = pNeg(ph);
536    }
537#endif
538  }
539}
540
541//void pContent(poly ph)
542//{
543//  number h,d;
544//  poly p;
545//
546//  p = ph;
547//  if(pNext(p)==NULL)
548//  {
549//    pSetCoeff(p,nInit(1));
550//  }
551//  else
552//  {
553//#ifdef PDEBUG
554//    if (!pTest(p)) return;
555//#endif
556//    nNormalize(pGetCoeff(p));
557//    if(!nGreaterZero(pGetCoeff(ph)))
558//    {
559//      ph = pNeg(ph);
560//      nNormalize(pGetCoeff(p));
561//    }
562//    h=pGetCoeff(p);
563//    pIter(p);
564//    while (p!=NULL)
565//    {
566//      nNormalize(pGetCoeff(p));
567//      if (nGreater(h,pGetCoeff(p))) h=pGetCoeff(p);
568//      pIter(p);
569//    }
570//    h=nCopy(h);
571//    p=ph;
572//    while (p!=NULL)
573//    {
574//      d=nGcd(h,pGetCoeff(p));
575//      nDelete(&h);
576//      h = d;
577//      if(nIsOne(h))
578//      {
579//        break;
580//      }
581//      pIter(p);
582//    }
583//    p = ph;
584//    //number tmp;
585//    if(!nIsOne(h))
586//    {
587//      while (p!=NULL)
588//      {
589//        d = nIntDiv(pGetCoeff(p),h);
590//        pSetCoeff(p,d);
591//        pIter(p);
592//      }
593//    }
594//    nDelete(&h);
595//#ifdef HAVE_FACTORY
596//    if ( (nGetChar() == 1) || (nGetChar() < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
597//    {
598//      pTest(ph);
599//      singclap_divide_content(ph);
600//      pTest(ph);
601//    }
602//#endif
603//  }
604//}
605void p_Content(poly ph, ring r)
606{
607  number h,d;
608  poly p;
609
610  if(pNext(ph)==NULL)
611  {
612    pSetCoeff(ph,n_Init(1,r));
613  }
614  else
615  {
616    n_Normalize(pGetCoeff(ph),r);
617    if(!n_GreaterZero(pGetCoeff(ph),r)) ph = p_Neg(ph,r);
618    h=n_Copy(pGetCoeff(ph),r);
619    p = pNext(ph);
620    while (p!=NULL)
621    {
622      n_Normalize(pGetCoeff(p),r);
623      d=n_Gcd(h,pGetCoeff(p),r);
624      n_Delete(&h,r);
625      h = d;
626      if(n_IsOne(h,r))
627      {
628        break;
629      }
630      pIter(p);
631    }
632    p = ph;
633    //number tmp;
634    if(!n_IsOne(h,r))
635    {
636      while (p!=NULL)
637      {
638        //d = nDiv(pGetCoeff(p),h);
639        //tmp = nIntDiv(pGetCoeff(p),h);
640        //if (!nEqual(d,tmp))
641        //{
642        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
643        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
644        //  nWrite(tmp);Print(StringAppendS("\n"));
645        //}
646        //nDelete(&tmp);
647        d = n_IntDiv(pGetCoeff(p),h,r);
648        p_SetCoeff(p,d,r);
649        pIter(p);
650      }
651    }
652    n_Delete(&h,r);
653#ifdef HAVE_FACTORY
654    //if ( (nGetChar() == 1) || (nGetChar() < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
655    //{
656    //  singclap_divide_content(ph);
657    //  if(!nGreaterZero(pGetCoeff(ph))) ph = pNeg(ph);
658    //}
659#endif
660  }
661}
662
663void pCleardenom(poly ph)
664{
665  number d, h;
666  poly p;
667
668  p = ph;
669  if(pNext(p)==NULL)
670  {
671    if (TEST_OPT_CONTENTSB)
672    {
673      number n=nGetDenom(pGetCoeff(p));
674      if (!nIsOne(n))
675      {
676        number nn=nMult(pGetCoeff(p),n);
677        nNormalize(nn);
678        pSetCoeff(p,nn);
679      }
680      nDelete(&n);
681    }
682    else
683      pSetCoeff(p,nInit(1));
684  }
685  else
686  {
687    h = nInit(1);
688    while (p!=NULL)
689    {
690      nNormalize(pGetCoeff(p));
691      d=nLcm(h,pGetCoeff(p),currRing);
692      nDelete(&h);
693      h=d;
694      pIter(p);
695    }
696    /* contains the 1/lcm of all denominators */
697    if(!nIsOne(h))
698    {
699      p = ph;
700      while (p!=NULL)
701      {
702        /* should be:
703        * number hh;
704        * nGetDenom(p->coef,&hh);
705        * nMult(&h,&hh,&d);
706        * nNormalize(d);
707        * nDelete(&hh);
708        * nMult(d,p->coef,&hh);
709        * nDelete(&d);
710        * nDelete(&(p->coef));
711        * p->coef =hh;
712        */
713        d=nMult(h,pGetCoeff(p));
714        nNormalize(d);
715        pSetCoeff(p,d);
716        pIter(p);
717      }
718      nDelete(&h);
719      if (nGetChar()==1)
720      {
721        loop
722        {
723          h = nInit(1);
724          p=ph;
725          while (p!=NULL)
726          {
727            d=nLcm(h,pGetCoeff(p),currRing);
728            nDelete(&h);
729            h=d;
730            pIter(p);
731          }
732          /* contains the 1/lcm of all denominators */
733          if(!nIsOne(h))
734          {
735            p = ph;
736            while (p!=NULL)
737            {
738              /* should be:
739              * number hh;
740              * nGetDenom(p->coef,&hh);
741              * nMult(&h,&hh,&d);
742              * nNormalize(d);
743              * nDelete(&hh);
744              * nMult(d,p->coef,&hh);
745              * nDelete(&d);
746              * nDelete(&(p->coef));
747              * p->coef =hh;
748              */
749              d=nMult(h,pGetCoeff(p));
750              nNormalize(d);
751              pSetCoeff(p,d);
752              pIter(p);
753            }
754            nDelete(&h);
755          }
756          else
757          {
758            nDelete(&h);
759            break;
760          }
761        }
762      }
763    }
764    if (h!=NULL) nDelete(&h);
765    pContent(ph);
766  }
767}
768
769/*2
770*tests if p is homogeneous with respect to the actual weigths
771*/
772BOOLEAN pIsHomogeneous (poly p)
773{
774  poly qp=p;
775  int o;
776
777  if ((p == NULL) || (pNext(p) == NULL)) return TRUE;
778  pFDegProc d=(pLexOrder ? pTotaldegree : pFDeg );
779  o = d(p);
780  do
781  {
782    if (d(qp) != o) return FALSE;
783    pIter(qp);
784  }
785  while (qp != NULL);
786  return TRUE;
787}
788
789// orders monoms of poly using merge sort (ususally faster than
790// insertion sort). ASSUMES that pSetm was performed on monoms
791poly pOrdPolyMerge(poly p)
792{
793  poly qq,pp,result=NULL;
794
795  if (p == NULL) return NULL;
796
797  loop
798  {
799    qq = p;
800    loop
801    {
802      if (pNext(p) == NULL)
803      {
804        result=pAdd(result, qq);
805        pTest(result);
806        return result;
807      }
808      if (pLmCmp(p,pNext(p)) != 1)
809      {
810        pp = p;
811        pIter(p);
812        pNext(pp) = NULL;
813        result = pAdd(result, qq);
814        break;
815      }
816      pIter(p);
817    }
818  }
819}
820
821// orders monoms of poly using insertion sort, performs pSetm on each monom
822poly pOrdPolyInsertSetm(poly p)
823{
824  poly qq,result = NULL;
825
826#if 0
827  while (p != NULL)
828  {
829    qq = p;
830    pIter(p);
831    qq->next = NULL;
832    pSetm(qq);
833    result = pAdd(result,qq);
834    pTest(result);
835  }
836#else
837  while (p != NULL)
838  {
839    qq = p;
840    pIter(p);
841    qq->next = result;
842    result = qq;
843    pSetm(qq);
844  }
845  p = result;
846  result = NULL;
847  while (p != NULL)
848  {
849    qq = p;
850    pIter(p);
851    qq->next = NULL;
852    result = pAdd(result, qq);
853  }
854  pTest(result);
855#endif
856  return result;
857}
858
859/*2
860*returns a re-ordered copy of a polynomial, with permutation of the variables
861*/
862poly pPermPoly (poly p, int * perm, ring oldRing, nMapFunc nMap,
863   int *par_perm, int OldPar)
864{
865  int OldpVariables = oldRing->N;
866  poly result = NULL;
867  poly result_last = NULL;
868  poly aq=NULL; /* the map coefficient */
869  poly qq; /* the mapped monomial */
870
871  while (p != NULL)
872  {
873    if ((OldPar==0)||(rField_is_GF(oldRing)))
874    {
875      qq = pInit();
876      number n=nMap(pGetCoeff(p));
877      if ((currRing->minpoly!=NULL)
878      && ((rField_is_Zp_a()) || (rField_is_Q_a())))
879      {
880        nNormalize(n);
881      }
882      pGetCoeff(qq)=n;
883    // coef may be zero:  pTest(qq);
884    }
885    else
886    {
887      qq=pOne();
888      aq=naPermNumber(pGetCoeff(p),par_perm,OldPar, oldRing);
889      if ((currRing->minpoly!=NULL)
890      && ((rField_is_Zp_a()) || (rField_is_Q_a())))
891      {
892        poly tmp=aq;
893        while (tmp!=NULL)
894        {
895          number n=pGetCoeff(tmp);
896          nNormalize(n);
897          pGetCoeff(tmp)=n;
898          pIter(tmp);
899        }
900      }
901      pTest(aq);
902    }
903    pSetComp(qq, p_GetComp(p,oldRing));
904    if (nIsZero(pGetCoeff(qq)))
905    {
906      pDeleteLm(&qq);
907    }
908    else
909    {
910      int i;
911      int mapped_to_par=0;
912      for(i=1; i<=OldpVariables; i++)
913      {
914        int e=p_GetExp(p,i,oldRing);
915        if (e!=0)
916        {
917          if (perm==NULL)
918          {
919            pSetExp(qq,i, e);
920          }
921          else if (perm[i]>0)
922            pAddExp(qq,perm[i], e/*p_GetExp( p,i,oldRing)*/);
923          else if (perm[i]<0)
924          {
925            if (rField_is_GF())
926            {
927              number c=pGetCoeff(qq);
928              number ee=nfPar(1);
929              number eee;nfPower(ee,e,&eee); //nfDelete(ee,currRing);
930              ee=nfMult(c,eee);
931              //nfDelete(c,currRing);nfDelete(eee,currRing);
932              pSetCoeff0(qq,ee);
933            }
934            else
935            {
936              lnumber c=(lnumber)pGetCoeff(qq);
937              if (c->z->next==NULL)
938                napAddExp(c->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/);
939              else /* more difficult: we have really to multiply: */
940              {
941                lnumber mmc=(lnumber)naInit(1);
942                napSetExp(mmc->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/);
943                napSetm(mmc->z);
944                pGetCoeff(qq)=naMult((number)c,(number)mmc);
945                nDelete((number *)&c);
946                nDelete((number *)&mmc); 
947              }
948              mapped_to_par=1;
949            }
950          }
951          else
952          {
953            /* this variable maps to 0 !*/
954            pDeleteLm(&qq);
955            break;
956          }
957        }
958      }
959      if (mapped_to_par
960      && (currRing->minpoly!=NULL))
961      {
962        number n=pGetCoeff(qq);
963        nNormalize(n);
964        pGetCoeff(qq)=n;
965      }
966    }
967    pIter(p);
968#if 1
969    if (qq!=NULL)
970    {
971      pSetm(qq);
972      pTest(aq);
973      pTest(qq);
974      if (aq!=NULL) qq=pMult(aq,qq);
975      aq = qq;
976      while (pNext(aq) != NULL) pIter(aq);
977      if (result_last==NULL)
978      {
979        result=qq;
980      }
981      else
982      {
983        pNext(result_last)=qq;
984      }
985      result_last=aq;
986      aq = NULL;
987    }
988    else if (aq!=NULL)
989    {
990      pDelete(&aq);
991    }
992  }
993  result=pSortAdd(result);
994#else
995  //  if (qq!=NULL)
996  //  {
997  //    pSetm(qq);
998  //    pTest(qq);
999  //    pTest(aq);
1000  //    if (aq!=NULL) qq=pMult(aq,qq);
1001  //    aq = qq;
1002  //    while (pNext(aq) != NULL) pIter(aq);
1003  //    pNext(aq) = result;
1004  //    aq = NULL;
1005  //    result = qq;
1006  //  }
1007  //  else if (aq!=NULL)
1008  //  {
1009  //    pDelete(&aq);
1010  //  }
1011  //}
1012  //p = result;
1013  //result = NULL;
1014  //while (p != NULL)
1015  //{
1016  //  qq = p;
1017  //  pIter(p);
1018  //  qq->next = NULL;
1019  //  result = pAdd(result, qq);
1020  //}
1021#endif
1022  pTest(result);
1023  return result;
1024}
1025
1026#if 0
1027/*2
1028*returns a re-ordered copy of a polynomial, with permutation of the variables
1029*/
1030poly p_PermPoly (poly p, int * perm, ring oldRing,
1031   int *par_perm, int OldPar, ring newRing)
1032{
1033  int OldpVariables = oldRing->N;
1034  poly result = NULL;
1035  poly result_last = NULL;
1036  poly aq=NULL; /* the map coefficient */
1037  poly qq; /* the mapped monomial */
1038
1039  while (p != NULL)
1040  {
1041    if (OldPar==0)
1042    {
1043      qq = pInit();
1044      number n=newRing->cf->nMap(pGetCoeff(p));
1045      if ((newRing->minpoly!=NULL)
1046      && ((rField_is_Zp_a(newRing)) || (rField_is_Q_a(newRing))))
1047      {
1048        newRing->cf->nNormalize(n);
1049      }
1050      pGetCoeff(qq)=n;
1051    // coef may be zero:  pTest(qq);
1052    }
1053    else
1054    {
1055      qq=p_ISet(1, newRing);
1056      aq=naPermNumber(pGetCoeff(p),par_perm,OldPar, oldRing);
1057      if ((newRing->minpoly!=NULL)
1058      && ((rField_is_Zp_a(newRing)) || (rField_is_Q_a(newRing))))
1059      {
1060        poly tmp=aq;
1061        while (tmp!=NULL)
1062        {
1063          number n=pGetCoeff(tmp);
1064          newRing->cf->nNormalize(n);
1065          pGetCoeff(tmp)=n;
1066          pIter(tmp);
1067        }
1068      }
1069      //pTest(aq);
1070    }
1071    p_SetComp(qq, p_GetComp(p,oldRing), newRing);
1072    if (newRing->cf->nIsZero(pGetCoeff(qq)))
1073    {
1074      p_DeleteLm(&qq, newRing);
1075    }
1076    else
1077    {
1078      int i;
1079      int mapped_to_par=0;
1080      for(i=1; i<=OldpVariables; i++)
1081      {
1082        int e=p_GetExp(p,i,oldRing);
1083        if (e!=0)
1084        {
1085          if (perm==NULL)
1086          {
1087            p_SetExp(qq,i, e, newRing);
1088          }
1089          else if (perm[i]>0)
1090            p_AddExp(qq,perm[i], e/*p_GetExp( p,i,oldRing)*/, newRing);
1091          else if (perm[i]<0)
1092          {
1093            lnumber c=(lnumber)pGetCoeff(qq);
1094            napAddExp(c->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/);
1095            mapped_to_par=1;
1096          }
1097          else
1098          {
1099            /* this variable maps to 0 !*/
1100            p_DeleteLm(&qq, newRing);
1101            break;
1102          }
1103        }
1104      }
1105      if (mapped_to_par
1106      && (newRing->minpoly!=NULL))
1107      {
1108        number n=pGetCoeff(qq);
1109        newRing->cf->nNormalize(n);
1110        pGetCoeff(qq)=n;
1111      }
1112    }
1113    pIter(p);
1114    if (qq!=NULL)
1115    {
1116      p_Setm(qq, newRing);
1117      //pTest(aq);
1118      //pTest(qq);
1119      if (aq!=NULL) qq=pMult(aq,qq);
1120      aq = qq;
1121      while (pNext(aq) != NULL) pIter(aq);
1122      if (result_last==NULL)
1123      {
1124        result=qq;
1125      }
1126      else
1127      {
1128        pNext(result_last)=qq;
1129      }
1130      result_last=aq;
1131      aq = NULL;
1132    }
1133    else if (aq!=NULL)
1134    {
1135      p_Delete(&aq, newRing);
1136    }
1137  }
1138  result=pOrdPolyMerge(result);
1139  //pTest(result);
1140  return result;
1141}
1142#endif
1143
1144poly ppJet(poly p, int m)
1145{
1146  poly r=NULL;
1147  poly t=NULL;
1148
1149  while (p!=NULL)
1150  {
1151    if (pTotaldegree(p)<=m)
1152    {
1153      if (r==NULL)
1154        r=pHead(p);
1155      else
1156      if (t==NULL)
1157      {
1158        pNext(r)=pHead(p);
1159        t=pNext(r);
1160      }
1161      else
1162      {
1163        pNext(t)=pHead(p);
1164        pIter(t);
1165      }
1166    }
1167    pIter(p);
1168  }
1169  return r;
1170}
1171
1172poly pJet(poly p, int m)
1173{
1174  poly t=NULL;
1175
1176  while((p!=NULL) && (pTotaldegree(p)>m)) pLmDelete(&p);
1177  if (p==NULL) return NULL;
1178  poly r=p;
1179  while (pNext(p)!=NULL)
1180  {
1181    if (pTotaldegree(pNext(p))>m)
1182    {
1183      pLmDelete(&pNext(p));
1184    }
1185    else
1186      pIter(p);
1187  }
1188  return r;
1189}
1190
1191poly ppJetW(poly p, int m, short *w)
1192{
1193  poly r=NULL;
1194  poly t=NULL;
1195  while (p!=NULL)
1196  {
1197    if (totaldegreeWecart_IV(p,currRing,w)<=m)
1198    {
1199      if (r==NULL)
1200        r=pHead(p);
1201      else
1202      if (t==NULL)
1203      {
1204        pNext(r)=pHead(p);
1205        t=pNext(r);
1206      }
1207      else
1208      {
1209        pNext(t)=pHead(p);
1210        pIter(t);
1211      }
1212    }
1213    pIter(p);
1214  }
1215  return r;
1216}
1217
1218poly pJetW(poly p, int m, short *w)
1219{
1220  poly t=NULL;
1221  while((p!=NULL) && (totaldegreeWecart_IV(p,currRing,w)>m)) pLmDelete(&p);
1222  if (p==NULL) return NULL;
1223  poly r=p;
1224  while (pNext(p)!=NULL)
1225  {
1226    if (totaldegreeWecart_IV(pNext(p),currRing,w)>m)
1227    {
1228      pLmDelete(&pNext(p));
1229    }
1230    else
1231      pIter(p);
1232  }
1233  return r;
1234}
1235
1236int pMinDeg(poly p,intvec *w)
1237{
1238  if(p==NULL)
1239    return -1;
1240  int d=-1;
1241  while(p!=NULL)
1242  {
1243    int d0=0;
1244    for(int j=0;j<pVariables;j++)
1245      if(w==NULL||j>=w->length())
1246        d0+=pGetExp(p,j+1);
1247      else
1248        d0+=(*w)[j]*pGetExp(p,j+1);
1249    if(d0<d||d==-1)
1250      d=d0;
1251    pIter(p);
1252  }
1253  return d;
1254}
1255
1256poly pSeries(int n,poly p,poly u, intvec *w)
1257{
1258  short *ww=iv2array(w);
1259  if(p!=NULL)
1260  {
1261    if(u==NULL)
1262      p=pJetW(p,n,ww);
1263    else
1264      p=pJetW(pMult(p,pInvers(n-pMinDeg(p,w),u,w)),n,ww);
1265  }
1266  omFreeSize((ADDRESS)ww,(pVariables+1)*sizeof(short));
1267  return p;
1268}
1269
1270poly pInvers(int n,poly u,intvec *w)
1271{
1272  short *ww=iv2array(w);
1273  if(n<0)
1274    return NULL;
1275  number u0=nInvers(pGetCoeff(u));
1276  poly v=pNSet(u0);
1277  if(n==0)
1278    return v;
1279  poly u1=pJetW(pSub(pOne(),pMult_nn(u,u0)),n,ww);
1280  if(u1==NULL)
1281    return v;
1282  poly v1=pMult_nn(pCopy(u1),u0);
1283  v=pAdd(v,pCopy(v1));
1284  for(int i=n/pMinDeg(u1,w);i>1;i--)
1285  {
1286    v1=pJetW(pMult(v1,pCopy(u1)),n,ww);
1287    v=pAdd(v,pCopy(v1));
1288  }
1289  pDelete(&u1);
1290  pDelete(&v1);
1291  omFreeSize((ADDRESS)ww,(pVariables+1)*sizeof(short));
1292  return v;
1293}
1294
1295long pDegW(poly p, short *w)
1296{
1297  long r=-LONG_MAX;
1298
1299  while (p!=NULL)
1300  {
1301    r=si_max(r, totaldegreeWecart_IV(p,currRing,w));
1302    pIter(p);
1303  }
1304  return r;
1305}
1306
1307/*-----------type conversions ----------------------------*/
1308/*2
1309* input: a set of polys (len elements: p[0]..p[len-1])
1310* output: a vector
1311* p will not be changed
1312*/
1313poly  pPolys2Vec(polyset p, int len)
1314{
1315  poly v=NULL;
1316  poly h;
1317  int i;
1318
1319  for (i=len-1; i>=0; i--)
1320  {
1321    if (p[i])
1322    {
1323      h=pCopy(p[i]);
1324      pSetCompP(h,i+1);
1325      v=pAdd(v,h);
1326    }
1327  }
1328 return v;
1329}
1330
1331/*2
1332* convert a vector to a set of polys,
1333* allocates the polyset, (entries 0..(*len)-1)
1334* the vector will not be changed
1335*/
1336void  pVec2Polys(poly v, polyset *p, int *len)
1337{
1338  poly h;
1339  int k;
1340
1341  *len=pMaxComp(v);
1342  if (*len==0) *len=1;
1343  *p=(polyset)omAlloc0((*len)*sizeof(poly));
1344  while (v!=NULL)
1345  {
1346    h=pHead(v);
1347    k=pGetComp(h);
1348    pSetComp(h,0);
1349    (*p)[k-1]=pAdd((*p)[k-1],h);
1350    pIter(v);
1351  }
1352}
1353
1354int pVar(poly m)
1355{
1356  if (m==NULL) return 0;
1357  if (pNext(m)!=NULL) return 0;
1358  int i,e=0;
1359  for (i=pVariables; i>0; i--)
1360  {
1361    if (pGetExp(m,i)==1)
1362    {
1363      if (e==0) e=i;
1364      else return 0;
1365    }
1366  }
1367  return e;
1368}
1369
1370/*----------utilities for syzygies--------------*/
1371//BOOLEAN   pVectorHasUnitM(poly p, int * k)
1372//{
1373//  while (p!=NULL)
1374//  {
1375//    if (pLmIsConstantComp(p))
1376//    {
1377//      *k = pGetComp(p);
1378//      return TRUE;
1379//    }
1380//    else pIter(p);
1381//  }
1382//  return FALSE;
1383//}
1384
1385BOOLEAN   pVectorHasUnitB(poly p, int * k)
1386{
1387  poly q=p,qq;
1388  int i;
1389
1390  while (q!=NULL)
1391  {
1392    if (pLmIsConstantComp(q))
1393    {
1394      i = pGetComp(q);
1395      qq = p;
1396      while ((qq != q) && (pGetComp(qq) != i)) pIter(qq);
1397      if (qq == q)
1398      {
1399        *k = i;
1400        return TRUE;
1401      }
1402      else
1403        pIter(q);
1404    }
1405    else pIter(q);
1406  }
1407  return FALSE;
1408}
1409
1410void   pVectorHasUnit(poly p, int * k, int * len)
1411{
1412  poly q=p,qq;
1413  int i,j=0;
1414
1415  *len = 0;
1416  while (q!=NULL)
1417  {
1418    if (pLmIsConstantComp(q))
1419    {
1420      i = pGetComp(q);
1421      qq = p;
1422      while ((qq != q) && (pGetComp(qq) != i)) pIter(qq);
1423      if (qq == q)
1424      {
1425       j = 0;
1426       while (qq!=NULL)
1427       {
1428         if (pGetComp(qq)==i) j++;
1429        pIter(qq);
1430       }
1431       if ((*len == 0) || (j<*len))
1432       {
1433         *len = j;
1434         *k = i;
1435       }
1436      }
1437    }
1438    pIter(q);
1439  }
1440}
1441
1442/*2
1443* returns TRUE if p1 = p2
1444*/
1445BOOLEAN pEqualPolys(poly p1,poly p2)
1446{
1447  while ((p1 != NULL) && (p2 != NULL))
1448  {
1449    if (! pLmEqual(p1, p2))
1450      return FALSE;
1451    if (! nEqual(pGetCoeff(p1), pGetCoeff(p2)))
1452      return FALSE;
1453    pIter(p1);
1454    pIter(p2);
1455  }
1456  return (p1==p2);
1457}
1458
1459/*2
1460*returns TRUE if p1 is a skalar multiple of p2
1461*assume p1 != NULL and p2 != NULL
1462*/
1463BOOLEAN pComparePolys(poly p1,poly p2)
1464{
1465  number n,nn;
1466  int i;
1467  pAssume(p1 != NULL && p2 != NULL);
1468
1469  if (!pLmEqual(p1,p2)) //compare leading mons
1470      return FALSE;
1471  if ((pNext(p1)==NULL) && (pNext(p2)!=NULL))
1472     return FALSE;
1473  if ((pNext(p2)==NULL) && (pNext(p1)!=NULL))
1474     return FALSE;
1475  if (pLength(p1) != pLength(p2))
1476    return FALSE;
1477  n=nDiv(pGetCoeff(p1),pGetCoeff(p2));
1478  while ((p1 != NULL) /*&& (p2 != NULL)*/)
1479  {
1480    if ( ! pLmEqual(p1, p2))
1481    {
1482        nDelete(&n);
1483        return FALSE;
1484    }
1485    if (!nEqual(pGetCoeff(p1),nn=nMult(pGetCoeff(p2),n)))
1486    {
1487      nDelete(&n);
1488      nDelete(&nn);
1489      return FALSE;
1490    }
1491    nDelete(&nn);
1492    pIter(p1);
1493    pIter(p2);
1494  }
1495  nDelete(&n);
1496  return TRUE;
1497}
Note: See TracBrowser for help on using the repository browser.