source: git/kernel/polys.cc @ 2b17ec

jengelh-datetimespielwiese
Last change on this file since 2b17ec was 2b17ec, checked in by Hans Schoenemann <hannes@…>, 12 years ago
fix memory leak in resolutions git-svn-id: file:///usr/local/Singular/svn/trunk@14211 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 19.3 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id$ */
5
6/*
7* ABSTRACT - all basic methods to manipulate polynomials
8*/
9
10/* includes */
11#include <stdio.h>
12#include <string.h>
13#include <ctype.h>
14#include <kernel/mod2.h>
15#include <kernel/options.h>
16#include <omalloc/omalloc.h>
17#include <kernel/febase.h>
18#include <kernel/numbers.h>
19#include <kernel/polys.h>
20#include <kernel/ring.h>
21#include <kernel/sbuckets.h>
22
23#ifdef HAVE_PLURAL
24#include <kernel/gring.h>
25#include <kernel/sca.h>
26#endif
27
28/* ----------- global variables, set by pSetGlobals --------------------- */
29/* computes length and maximal degree of a POLYnomial */
30pLDegProc pLDeg;
31/* computes the degree of the initial term, used for std */
32pFDegProc pFDeg;
33/* the monomial ordering of the head monomials a and b */
34/* returns -1 if a comes before b, 0 if a=b, 1 otherwise */
35
36int pVariables;     // number of variables
37
38/* 1 for polynomial ring, -1 otherwise */
39int     pOrdSgn;
40// it is of type int, not BOOLEAN because it is also in ip
41/* TRUE if the monomial ordering is not compatible with pFDeg */
42BOOLEAN pLexOrder;
43
44/* ----------- global variables, set by procedures from hecke/kstd1 ----- */
45/* the highest monomial below pHEdge */
46poly      ppNoether = NULL;
47
48/* -------------------------------------------------------- */
49/*2
50* change all global variables to fit the description of the new ring
51*/
52
53
54void pSetGlobals(const ring r, BOOLEAN complete)
55{
56  if (ppNoether!=NULL) pDelete(&ppNoether);
57  pVariables = r->N;
58  pOrdSgn = r->OrdSgn;
59  pFDeg=r->pFDeg;
60  pLDeg=r->pLDeg;
61  pLexOrder=r->LexOrder;
62
63  if (complete)
64  {
65    test &= ~ TEST_RINGDEP_OPTS;
66    test |= r->options;
67  }
68}
69
70// resets the pFDeg and pLDeg: if pLDeg is not given, it is
71// set to currRing->pLDegOrig, i.e. to the respective LDegProc which
72// only uses pFDeg (and not pDeg, or pTotalDegree, etc)
73void pSetDegProcs(pFDegProc new_FDeg, pLDegProc new_lDeg)
74{
75  assume(new_FDeg != NULL);
76  pFDeg = new_FDeg;
77  currRing->pFDeg = new_FDeg;
78
79  if (new_lDeg == NULL)
80    new_lDeg = currRing->pLDegOrig;
81
82  pLDeg = new_lDeg;
83  currRing->pLDeg = new_lDeg;
84}
85
86
87// restores pFDeg and pLDeg:
88extern void pRestoreDegProcs(pFDegProc old_FDeg, pLDegProc old_lDeg)
89{
90  assume(old_FDeg != NULL && old_lDeg != NULL);
91  pFDeg = old_FDeg;
92  currRing->pFDeg = old_FDeg;
93  pLDeg = old_lDeg;
94  currRing->pLDeg = old_lDeg;
95}
96
97/*2
98* assumes that the head term of b is a multiple of the head term of a
99* and return the multiplicant *m
100* Frank's observation: If LM(b) = LM(a)*m, then we may actually set
101* negative(!) exponents in the below loop. I suspect that the correct
102* comment should be "assumes that LM(a) = LM(b)*m, for some monomial m..."
103*/
104poly pDivide(poly a, poly b)
105{
106  int i;
107  poly result = pInit();
108
109  for(i=(int)pVariables; i; i--)
110    pSetExp(result,i, pGetExp(a,i)- pGetExp(b,i));
111  pSetComp(result, pGetComp(a) - pGetComp(b));
112  pSetm(result);
113  return result;
114}
115
116#ifdef HAVE_RINGS   //TODO Oliver
117#define pDiv_nn(p, n)              p_Div_nn(p, n, currRing)
118
119poly p_Div_nn(poly p, const number n, const ring r)
120{
121  pAssume(!n_IsZero(n,r));
122  p_Test(p, r);
123
124  poly q = p;
125  while (p != NULL)
126  {
127    number nc = pGetCoeff(p);
128    pSetCoeff0(p, n_Div(nc, n, r));
129    n_Delete(&nc, r);
130    pIter(p);
131  }
132  p_Test(q, r);
133  return q;
134}
135#endif
136
137#ifdef HAVE_RINGS
138/* TRUE iff LT(f) | LT(g) */
139BOOLEAN pDivisibleByRingCase(poly f, poly g)
140{
141  int exponent;
142  for(int i = (int)pVariables; i; i--)
143  {
144    exponent = pGetExp(g, i) - pGetExp(f, i);
145    if (exponent < 0) return FALSE;
146  }
147  return nDivBy(pGetCoeff(g), pGetCoeff(f));
148}
149#endif
150
151/*2
152* divides a by the monomial b, ignores monomials which are not divisible
153* assumes that b is not NULL, destroys b
154*/
155poly pDivideM(poly a, poly b)
156{
157  if (a==NULL) { pDelete(&b); return NULL; }
158  poly result=a;
159  poly prev=NULL;
160  int i;
161#ifdef HAVE_RINGS
162  number inv=pGetCoeff(b);
163#else
164  number inv=nInvers(pGetCoeff(b));
165#endif
166
167  while (a!=NULL)
168  {
169    if (pDivisibleBy(b,a))
170    {
171      for(i=(int)pVariables; i; i--)
172         pSubExp(a,i, pGetExp(b,i));
173      pSubComp(a, pGetComp(b));
174      pSetm(a);
175      prev=a;
176      pIter(a);
177    }
178    else
179    {
180      if (prev==NULL)
181      {
182        pLmDelete(&result);
183        a=result;
184      }
185      else
186      {
187        pLmDelete(&pNext(prev));
188        a=pNext(prev);
189      }
190    }
191  }
192#ifdef HAVE_RINGS
193  if (nIsUnit(inv))
194  {
195    inv = nInvers(inv);
196    pMult_nn(result,inv);
197    nDelete(&inv);
198  }
199  else
200  {
201    pDiv_nn(result,inv);
202  }
203#else
204  pMult_nn(result,inv);
205  nDelete(&inv);
206#endif
207  pDelete(&b);
208  return result;
209}
210
211/*2
212* returns the LCM of the head terms of a and b in *m
213*/
214void pLcm(poly a, poly b, poly m)
215{
216  int i;
217  for (i=pVariables; i; i--)
218  {
219    pSetExp(m,i, si_max( pGetExp(a,i), pGetExp(b,i)));
220  }
221  pSetComp(m, si_max(pGetComp(a), pGetComp(b)));
222  /* Don't do a pSetm here, otherwise hres/lres chockes */
223}
224
225/*2
226* convert monomial given as string to poly, e.g. 1x3y5z
227*/
228const char * p_Read(const char *st, poly &rc, const ring r)
229{
230  if (r==NULL) { rc=NULL;return st;}
231  int i,j;
232  rc = p_Init(r);
233  const char *s = r->cf->nRead(st,&(rc->coef));
234  if (s==st)
235  /* i.e. it does not start with a coeff: test if it is a ringvar*/
236  {
237    j = r_IsRingVar(s,r);
238    if (j >= 0)
239    {
240      p_IncrExp(rc,1+j,r);
241      while (*s!='\0') s++;
242      goto done;
243    }
244  }
245  while (*s!='\0')
246  {
247    char ss[2];
248    ss[0] = *s++;
249    ss[1] = '\0';
250    j = r_IsRingVar(ss,r);
251    if (j >= 0)
252    {
253      const char *s_save=s;
254      s = eati(s,&i);
255      if (((unsigned long)i) >  r->bitmask)
256      {
257        // exponent to large: it is not a monomial
258        p_LmDelete(&rc,r);
259        return s_save;
260      }
261      p_AddExp(rc,1+j, (long)i, r);
262    }
263    else
264    {
265      // 1st char of is not a varname
266      p_LmDelete(&rc,r);
267      s--;
268      return s;
269    }
270  }
271done:
272  if (r->cf->nIsZero(pGetCoeff(rc))) p_LmDelete(&rc,r);
273  else
274  {
275#ifdef HAVE_PLURAL
276    // in super-commutative ring
277    // squares of anti-commutative variables are zeroes!
278    if(rIsSCA(r))
279    {
280      const unsigned int iFirstAltVar = scaFirstAltVar(r);
281      const unsigned int iLastAltVar  = scaLastAltVar(r);
282
283      assume(rc != NULL);
284
285      for(unsigned int k = iFirstAltVar; k <= iLastAltVar; k++)
286        if( p_GetExp(rc, k, r) > 1 )
287        {
288          p_LmDelete(&rc, r);
289          goto finish;
290        }
291    }
292#endif
293    p_Setm(rc,r);
294  }
295finish:
296  return s;
297}
298
299BOOLEAN _p_Test(poly p, ring r, int level);
300poly pmInit(const char *st, BOOLEAN &ok)
301{
302  poly p;
303  const char *s=p_Read(st,p,currRing);
304  if (*s!='\0')
305  {
306    if ((s!=st)&&isdigit(st[0]))
307    {
308      errorreported=TRUE;
309    }
310    ok=FALSE;
311    pDelete(&p);
312    return NULL;
313  }
314  #ifdef PDEBUG
315  _p_Test(p,currRing,PDEBUG);
316  #endif
317  ok=!errorreported;
318  return p;
319}
320
321/*2
322*make p homogeneous by multiplying the monomials by powers of x_varnum
323*assume: deg(var(varnum))==1
324*/
325poly pHomogen (poly p, int varnum)
326{
327  pFDegProc deg;
328  if (pLexOrder && (currRing->order[0]==ringorder_lp))
329    deg=p_Totaldegree;
330  else
331    deg=pFDeg;
332
333  poly q=NULL, qn;
334  int  o,ii;
335  sBucket_pt bp;
336
337  if (p!=NULL)
338  {
339    if ((varnum < 1) || (varnum > pVariables))
340    {
341      return NULL;
342    }
343    o=deg(p,currRing);
344    q=pNext(p);
345    while (q != NULL)
346    {
347      ii=deg(q,currRing);
348      if (ii>o) o=ii;
349      pIter(q);
350    }
351    q = pCopy(p);
352    bp = sBucketCreate(currRing);
353    while (q != NULL)
354    {
355      ii = o-deg(q,currRing);
356      if (ii!=0)
357      {
358        pAddExp(q,varnum, (long)ii);
359        pSetm(q);
360      }
361      qn = pNext(q);
362      pNext(q) = NULL;
363      sBucket_Add_p(bp, q, 1);
364      q = qn;
365    }
366    sBucketDestroyAdd(bp, &q, &ii);
367  }
368  return q;
369}
370
371/*----------utilities for syzygies--------------*/
372poly pTakeOutComp(poly * p, int k)
373{
374  poly q = *p,qq=NULL,result = NULL;
375
376  if (q==NULL) return NULL;
377  BOOLEAN use_setmcomp=rOrd_SetCompRequiresSetm(currRing);
378  if (pGetComp(q)==k)
379  {
380    result = q;
381    do
382    {
383      pSetComp(q,0);
384      if (use_setmcomp) pSetmComp(q);
385      qq = q;
386      pIter(q);
387    }
388    while ((q!=NULL) && (pGetComp(q)==k));
389    *p = q;
390    pNext(qq) = NULL;
391  }
392  if (q==NULL) return result;
393  if (pGetComp(q) > k)
394  {
395    pSubComp(q,1);
396    if (use_setmcomp) pSetmComp(q);
397  }
398  poly pNext_q;
399  while ((pNext_q=pNext(q))!=NULL)
400  {
401    if (pGetComp(pNext_q)==k)
402    {
403      if (result==NULL)
404      {
405        result = pNext_q;
406        qq = result;
407      }
408      else
409      {
410        pNext(qq) = pNext_q;
411        pIter(qq);
412      }
413      pNext(q) = pNext(pNext_q);
414      pNext(qq) =NULL;
415      pSetComp(qq,0);
416      if (use_setmcomp) pSetmComp(qq);
417    }
418    else
419    {
420      /*pIter(q);*/ q=pNext_q;
421      if (pGetComp(q) > k)
422      {
423        pSubComp(q,1);
424        if (use_setmcomp) pSetmComp(q);
425      }
426    }
427  }
428  return result;
429}
430
431// Splits *p into two polys: *q which consists of all monoms with
432// component == comp and *p of all other monoms *lq == pLength(*q)
433void pTakeOutComp(poly *r_p, long comp, poly *r_q, int *lq)
434{
435  spolyrec pp, qq;
436  poly p, q, p_prev;
437  int l = 0;
438
439#ifdef HAVE_ASSUME
440  int lp = pLength(*r_p);
441#endif
442
443  pNext(&pp) = *r_p;
444  p = *r_p;
445  p_prev = &pp;
446  q = &qq;
447
448  while(p != NULL)
449  {
450    while (pGetComp(p) == comp)
451    {
452      pNext(q) = p;
453      pIter(q);
454      pSetComp(p, 0);
455      pSetmComp(p);
456      pIter(p);
457      l++;
458      if (p == NULL)
459      {
460        pNext(p_prev) = NULL;
461        goto Finish;
462      }
463    }
464    pNext(p_prev) = p;
465    p_prev = p;
466    pIter(p);
467  }
468
469  Finish:
470  pNext(q) = NULL;
471  *r_p = pNext(&pp);
472  *r_q = pNext(&qq);
473  *lq = l;
474#ifdef HAVE_ASSUME
475  assume(pLength(*r_p) + pLength(*r_q) == lp);
476#endif
477  pTest(*r_p);
478  pTest(*r_q);
479}
480
481#if 1
482poly pTakeOutComp1(poly * p, int k)
483{
484  poly q = *p;
485
486  if (q==NULL) return NULL;
487
488  poly qq=NULL,result = NULL;
489
490  if (pGetComp(q)==k)
491  {
492    result = q; /* *p */
493    while ((q!=NULL) && (pGetComp(q)==k))
494    {
495      pSetComp(q,0);
496      pSetmComp(q);
497      qq = q;
498      pIter(q);
499    }
500    *p = q;
501    pNext(qq) = NULL;
502  }
503  if (q==NULL) return result;
504//  if (pGetComp(q) > k) pGetComp(q)--;
505  while (pNext(q)!=NULL)
506  {
507    if (pGetComp(pNext(q))==k)
508    {
509      if (result==NULL)
510      {
511        result = pNext(q);
512        qq = result;
513      }
514      else
515      {
516        pNext(qq) = pNext(q);
517        pIter(qq);
518      }
519      pNext(q) = pNext(pNext(q));
520      pNext(qq) =NULL;
521      pSetComp(qq,0);
522      pSetmComp(qq);
523    }
524    else
525    {
526      pIter(q);
527//      if (pGetComp(q) > k) pGetComp(q)--;
528    }
529  }
530  return result;
531}
532#endif
533
534void pDeleteComp(poly * p,int k)
535{
536  poly q;
537
538  while ((*p!=NULL) && (pGetComp(*p)==k)) pLmDelete(p);
539  if (*p==NULL) return;
540  q = *p;
541  if (pGetComp(q)>k)
542  {
543    pSubComp(q,1);
544    pSetmComp(q);
545  }
546  while (pNext(q)!=NULL)
547  {
548    if (pGetComp(pNext(q))==k)
549      pLmDelete(&(pNext(q)));
550    else
551    {
552      pIter(q);
553      if (pGetComp(q)>k)
554      {
555        pSubComp(q,1);
556        pSetmComp(q);
557      }
558    }
559  }
560}
561/*----------end of utilities for syzygies--------------*/
562
563/*2
564* pair has no common factor ? or is no polynomial
565*/
566BOOLEAN pHasNotCF(poly p1, poly p2)
567{
568
569  if (pGetComp(p1) > 0 || pGetComp(p2) > 0)
570    return FALSE;
571  int i = pVariables;
572  loop
573  {
574    if ((pGetExp(p1, i) > 0) && (pGetExp(p2, i) > 0))   return FALSE;
575    i--;
576    if (i == 0)                                         return TRUE;
577  }
578}
579
580/*2
581* divides p1 by its leading coefficient if it is a unit
582* (this will always be true over fields; but not over coefficient rings)
583*/
584void pNorm(poly p1)
585{
586#ifdef HAVE_RINGS
587  if (rField_is_Ring(currRing))
588  {
589    if (!nIsUnit(pGetCoeff(p1))) return;
590  }
591#endif
592  if (p1!=NULL)
593  {
594    if (pNext(p1)==NULL)
595    {
596      pSetCoeff(p1,nInit(1));
597      return;
598    }
599    poly h;
600    if (!nIsOne(pGetCoeff(p1)))
601    {
602      number k, c;
603      nNormalize(pGetCoeff(p1));
604      k = pGetCoeff(p1);
605      c = nInit(1);
606      pSetCoeff0(p1,c);
607      h = pNext(p1);
608      while (h!=NULL)
609      {
610        c=nDiv(pGetCoeff(h),k);
611        // no need to normalize: Z/p, R
612        // normalize already in nDiv: Q_a, Z/p_a
613        // remains: Q
614        if (rField_is_Q() && (!nIsOne(c))) nNormalize(c);
615        pSetCoeff(h,c);
616        pIter(h);
617      }
618      nDelete(&k);
619    }
620    else
621    {
622      if (nNormalize != nDummy2)
623      {
624        h = pNext(p1);
625        while (h!=NULL)
626        {
627          nNormalize(pGetCoeff(h));
628          pIter(h);
629        }
630      }
631    }
632  }
633}
634
635/*2
636*normalize all coefficients
637*/
638void p_Normalize(poly p,const ring r)
639{
640  if (rField_has_simple_inverse(r)) return; /* Z/p, GF(p,n), R, long R/C */
641  while (p!=NULL)
642  {
643#ifdef LDEBUG
644    if (currRing==r) {nTest(pGetCoeff(p));}
645#endif
646    n_Normalize(pGetCoeff(p),r);
647    pIter(p);
648  }
649}
650
651// splits p into polys with Exp(n) == 0 and Exp(n) != 0
652// Poly with Exp(n) != 0 is reversed
653static void pSplitAndReversePoly(poly p, int n, poly *non_zero, poly *zero)
654{
655  if (p == NULL)
656  {
657    *non_zero = NULL;
658    *zero = NULL;
659    return;
660  }
661  spolyrec sz;
662  poly z, n_z, next;
663  z = &sz;
664  n_z = NULL;
665
666  while(p != NULL)
667  {
668    next = pNext(p);
669    if (pGetExp(p, n) == 0)
670    {
671      pNext(z) = p;
672      pIter(z);
673    }
674    else
675    {
676      pNext(p) = n_z;
677      n_z = p;
678    }
679    p = next;
680  }
681  pNext(z) = NULL;
682  *zero = pNext(&sz);
683  *non_zero = n_z;
684  return;
685}
686
687/*3
688* substitute the n-th variable by 1 in p
689* destroy p
690*/
691static poly pSubst1 (poly p,int n)
692{
693  poly qq=NULL, result = NULL;
694  poly zero=NULL, non_zero=NULL;
695
696  // reverse, so that add is likely to be linear
697  pSplitAndReversePoly(p, n, &non_zero, &zero);
698
699  while (non_zero != NULL)
700  {
701    assume(pGetExp(non_zero, n) != 0);
702    qq = non_zero;
703    pIter(non_zero);
704    qq->next = NULL;
705    pSetExp(qq,n,0);
706    pSetm(qq);
707    result = pAdd(result,qq);
708  }
709  p = pAdd(result, zero);
710  pTest(p);
711  return p;
712}
713
714/*3
715* substitute the n-th variable by number e in p
716* destroy p
717*/
718static poly pSubst2 (poly p,int n, number e)
719{
720  assume( ! nIsZero(e) );
721  poly qq,result = NULL;
722  number nn, nm;
723  poly zero, non_zero;
724
725  // reverse, so that add is likely to be linear
726  pSplitAndReversePoly(p, n, &non_zero, &zero);
727
728  while (non_zero != NULL)
729  {
730    assume(pGetExp(non_zero, n) != 0);
731    qq = non_zero;
732    pIter(non_zero);
733    qq->next = NULL;
734    nPower(e, pGetExp(qq, n), &nn);
735    nm = nMult(nn, pGetCoeff(qq));
736#ifdef HAVE_RINGS
737    if (nIsZero(nm))
738    {
739      pLmFree(&qq);
740      nDelete(&nm);
741    }
742    else
743#endif
744    {
745      pSetCoeff(qq, nm);
746      pSetExp(qq, n, 0);
747      pSetm(qq);
748      result = pAdd(result,qq);
749    }
750    nDelete(&nn);
751  }
752  p = pAdd(result, zero);
753  pTest(p);
754  return p;
755}
756
757
758/* delete monoms whose n-th exponent is different from zero */
759poly pSubst0(poly p, int n)
760{
761  spolyrec res;
762  poly h = &res;
763  pNext(h) = p;
764
765  while (pNext(h)!=NULL)
766  {
767    if (pGetExp(pNext(h),n)!=0)
768    {
769      pLmDelete(&pNext(h));
770    }
771    else
772    {
773      pIter(h);
774    }
775  }
776  pTest(pNext(&res));
777  return pNext(&res);
778}
779
780/*2
781* substitute the n-th variable by e in p
782* destroy p
783*/
784poly pSubst(poly p, int n, poly e)
785{
786  if (e == NULL) return pSubst0(p, n);
787
788  if (pIsConstant(e))
789  {
790    if (nIsOne(pGetCoeff(e))) return pSubst1(p,n);
791    else return pSubst2(p, n, pGetCoeff(e));
792  }
793
794#ifdef HAVE_PLURAL
795  if (rIsPluralRing(currRing))
796  {
797    return nc_pSubst(p,n,e);
798  }
799#endif
800
801  int exponent,i;
802  poly h, res, m;
803  int *me,*ee;
804  number nu,nu1;
805
806  me=(int *)omAlloc((pVariables+1)*sizeof(int));
807  ee=(int *)omAlloc((pVariables+1)*sizeof(int));
808  if (e!=NULL) pGetExpV(e,ee);
809  res=NULL;
810  h=p;
811  while (h!=NULL)
812  {
813    if ((e!=NULL) || (pGetExp(h,n)==0))
814    {
815      m=pHead(h);
816      pGetExpV(m,me);
817      exponent=me[n];
818      me[n]=0;
819      for(i=pVariables;i>0;i--)
820        me[i]+=exponent*ee[i];
821      pSetExpV(m,me);
822      if (e!=NULL)
823      {
824        nPower(pGetCoeff(e),exponent,&nu);
825        nu1=nMult(pGetCoeff(m),nu);
826        nDelete(&nu);
827        pSetCoeff(m,nu1);
828      }
829      res=pAdd(res,m);
830    }
831    pLmDelete(&h);
832  }
833  omFreeSize((ADDRESS)me,(pVariables+1)*sizeof(int));
834  omFreeSize((ADDRESS)ee,(pVariables+1)*sizeof(int));
835  return res;
836}
837
838/* Returns TRUE if
839     * LM(p) | LM(lcm)
840     * LC(p) | LC(lcm) only if ring
841     * Exists i, j:
842         * LE(p, i)  != LE(lcm, i)
843         * LE(p1, i) != LE(lcm, i)   ==> LCM(p1, p) != lcm
844         * LE(p, j)  != LE(lcm, j)
845         * LE(p2, j) != LE(lcm, j)   ==> LCM(p2, p) != lcm
846*/
847BOOLEAN pCompareChain (poly p,poly p1,poly p2,poly lcm)
848{
849  int k, j;
850
851  if (lcm==NULL) return FALSE;
852
853  for (j=pVariables; j; j--)
854    if ( pGetExp(p,j) >  pGetExp(lcm,j)) return FALSE;
855  if ( pGetComp(p) !=  pGetComp(lcm)) return FALSE;
856  for (j=pVariables; j; j--)
857  {
858    if (pGetExp(p1,j)!=pGetExp(lcm,j))
859    {
860      if (pGetExp(p,j)!=pGetExp(lcm,j))
861      {
862        for (k=pVariables; k>j; k--)
863        {
864          if ((pGetExp(p,k)!=pGetExp(lcm,k))
865          && (pGetExp(p2,k)!=pGetExp(lcm,k)))
866            return TRUE;
867        }
868        for (k=j-1; k; k--)
869        {
870          if ((pGetExp(p,k)!=pGetExp(lcm,k))
871          && (pGetExp(p2,k)!=pGetExp(lcm,k)))
872            return TRUE;
873        }
874        return FALSE;
875      }
876    }
877    else if (pGetExp(p2,j)!=pGetExp(lcm,j))
878    {
879      if (pGetExp(p,j)!=pGetExp(lcm,j))
880      {
881        for (k=pVariables; k>j; k--)
882        {
883          if ((pGetExp(p,k)!=pGetExp(lcm,k))
884          && (pGetExp(p1,k)!=pGetExp(lcm,k)))
885            return TRUE;
886        }
887        for (k=j-1; k!=0 ; k--)
888        {
889          if ((pGetExp(p,k)!=pGetExp(lcm,k))
890          && (pGetExp(p1,k)!=pGetExp(lcm,k)))
891            return TRUE;
892        }
893        return FALSE;
894      }
895    }
896  }
897  return FALSE;
898}
899#ifdef HAVE_RATGRING
900BOOLEAN pCompareChainPart (poly p,poly p1,poly p2,poly lcm)
901{
902  int k, j;
903
904  if (lcm==NULL) return FALSE;
905
906  for (j=currRing->real_var_end; j>=currRing->real_var_start; j--)
907    if ( pGetExp(p,j) >  pGetExp(lcm,j)) return FALSE;
908  if ( pGetComp(p) !=  pGetComp(lcm)) return FALSE;
909  for (j=currRing->real_var_end; j>=currRing->real_var_start; j--)
910  {
911    if (pGetExp(p1,j)!=pGetExp(lcm,j))
912    {
913      if (pGetExp(p,j)!=pGetExp(lcm,j))
914      {
915        for (k=pVariables; k>j; k--)
916        for (k=currRing->real_var_end; k>j; k--)
917        {
918          if ((pGetExp(p,k)!=pGetExp(lcm,k))
919          && (pGetExp(p2,k)!=pGetExp(lcm,k)))
920            return TRUE;
921        }
922        for (k=j-1; k>=currRing->real_var_start; k--)
923        {
924          if ((pGetExp(p,k)!=pGetExp(lcm,k))
925          && (pGetExp(p2,k)!=pGetExp(lcm,k)))
926            return TRUE;
927        }
928        return FALSE;
929      }
930    }
931    else if (pGetExp(p2,j)!=pGetExp(lcm,j))
932    {
933      if (pGetExp(p,j)!=pGetExp(lcm,j))
934      {
935        for (k=currRing->real_var_end; k>j; k--)
936        {
937          if ((pGetExp(p,k)!=pGetExp(lcm,k))
938          && (pGetExp(p1,k)!=pGetExp(lcm,k)))
939            return TRUE;
940        }
941        for (k=j-1; k>=currRing->real_var_start; k--)
942        {
943          if ((pGetExp(p,k)!=pGetExp(lcm,k))
944          && (pGetExp(p1,k)!=pGetExp(lcm,k)))
945            return TRUE;
946        }
947        return FALSE;
948      }
949    }
950  }
951  return FALSE;
952}
953#endif
954
955int pSize(poly p)
956{
957  int count = 0;
958  while ( p != NULL )
959  {
960    count+= nSize( pGetCoeff( p ) );
961    pIter( p );
962  }
963  return count;
964}
965
966/*2
967* returns the length of a (numbers of monomials)
968* respect syzComp
969*/
970poly pLast(poly a, int &l)
971{
972  if (a == NULL)
973  {
974    l = 0;
975    return NULL;
976  }
977  l = 1;
978  if (! rIsSyzIndexRing(currRing))
979  {
980    while (pNext(a)!=NULL)
981    {
982      pIter(a);
983      l++;
984    }
985  }
986  else
987  {
988    int curr_limit = rGetCurrSyzLimit(currRing);
989    poly pp = a;
990    while ((a=pNext(a))!=NULL)
991    {
992      if (pGetComp(a)<=curr_limit/*syzComp*/)
993        l++;
994      else break;
995      pp = a;
996    }
997    a=pp;
998  }
999  return a;
1000}
1001
Note: See TracBrowser for help on using the repository browser.