source: git/Singular/polys1.cc @ b874ce

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