source: git/Singular/polys1.cc @ 24d587

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