source: git/libpolys/polys/monomials/p_polys.cc @ f489c7b

spielwiese
Last change on this file since f489c7b was f489c7b, checked in by Hans Schoenemann <hannes@…>, 6 years ago
opt: p_Content
  • Property mode set to 100644
File size: 102.3 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/***************************************************************
5 *  File:    p_polys.cc
6 *  Purpose: implementation of ring independent poly procedures?
7 *  Author:  obachman (Olaf Bachmann)
8 *  Created: 8/00
9 *******************************************************************/
10
11#include <ctype.h>
12
13#include "omalloc/omalloc.h"
14
15#include "misc/auxiliary.h"
16
17#include "misc/options.h"
18#include "misc/intvec.h"
19
20
21#include "coeffs/longrat.h" // snumber is needed...
22#include "coeffs/numbers.h" // ndCopyMap
23
24#include "polys/PolyEnumerator.h"
25
26#define TRANSEXT_PRIVATES
27
28#include "polys/ext_fields/transext.h"
29#include "polys/ext_fields/algext.h"
30
31#include "polys/weight.h"
32#include "polys/simpleideals.h"
33
34#include "ring.h"
35#include "p_polys.h"
36
37#include "polys/templates/p_MemCmp.h"
38#include "polys/templates/p_MemAdd.h"
39#include "polys/templates/p_MemCopy.h"
40
41
42#ifdef HAVE_PLURAL
43#include "nc/nc.h"
44#include "nc/sca.h"
45#endif
46
47#include "clapsing.h"
48
49/*
50 * lift ideal with coeffs over Z (mod N) to Q via Farey
51 */
52poly p_Farey(poly p, number N, const ring r)
53{
54  poly h=p_Copy(p,r);
55  poly hh=h;
56  while(h!=NULL)
57  {
58    number c=pGetCoeff(h);
59    pSetCoeff0(h,n_Farey(c,N,r->cf));
60    n_Delete(&c,r->cf);
61    pIter(h);
62  }
63  while((hh!=NULL)&&(n_IsZero(pGetCoeff(hh),r->cf)))
64  {
65    p_LmDelete(&hh,r);
66  }
67  h=hh;
68  while((h!=NULL) && (pNext(h)!=NULL))
69  {
70    if(n_IsZero(pGetCoeff(pNext(h)),r->cf))
71    {
72      p_LmDelete(&pNext(h),r);
73    }
74    else pIter(h);
75  }
76  return hh;
77}
78/*2
79* xx,q: arrays of length 0..rl-1
80* xx[i]: SB mod q[i]
81* assume: char=0
82* assume: q[i]!=0
83* destroys xx
84*/
85poly p_ChineseRemainder(poly *xx, number *x,number *q, int rl, CFArray &inv_cache,const ring R)
86{
87  poly r,h,hh;
88  int j;
89  poly  res_p=NULL;
90  loop
91  {
92    /* search the lead term */
93    r=NULL;
94    for(j=rl-1;j>=0;j--)
95    {
96      h=xx[j];
97      if ((h!=NULL)
98      &&((r==NULL)||(p_LmCmp(r,h,R)==-1)))
99        r=h;
100    }
101    /* nothing found -> return */
102    if (r==NULL) break;
103    /* create the monomial in h */
104    h=p_Head(r,R);
105    /* collect the coeffs in x[..]*/
106    for(j=rl-1;j>=0;j--)
107    {
108      hh=xx[j];
109      if ((hh!=NULL) && (p_LmCmp(h,hh,R)==0))
110      {
111        x[j]=pGetCoeff(hh);
112        hh=p_LmFreeAndNext(hh,R);
113        xx[j]=hh;
114      }
115      else
116        x[j]=n_Init(0, R->cf);
117    }
118    number n=n_ChineseRemainderSym(x,q,rl,TRUE,inv_cache,R->cf);
119    for(j=rl-1;j>=0;j--)
120    {
121      x[j]=NULL; // n_Init(0...) takes no memory
122    }
123    if (n_IsZero(n,R->cf)) p_Delete(&h,R);
124    else
125    {
126      //Print("new mon:");pWrite(h);
127      p_SetCoeff(h,n,R);
128      pNext(h)=res_p;
129      res_p=h; // building res_p in reverse order!
130    }
131  }
132  res_p=pReverse(res_p);
133  p_Test(res_p, R);
134  return res_p;
135}
136/***************************************************************
137 *
138 * Completing what needs to be set for the monomial
139 *
140 ***************************************************************/
141// this is special for the syz stuff
142static int* _components = NULL;
143static long* _componentsShifted = NULL;
144static int _componentsExternal = 0;
145
146BOOLEAN pSetm_error=0;
147
148#ifndef SING_NDEBUG
149# define MYTEST 0
150#else /* ifndef SING_NDEBUG */
151# define MYTEST 0
152#endif /* ifndef SING_NDEBUG */
153
154void p_Setm_General(poly p, const ring r)
155{
156  p_LmCheckPolyRing(p, r);
157  int pos=0;
158  if (r->typ!=NULL)
159  {
160    loop
161    {
162      unsigned long ord=0;
163      sro_ord* o=&(r->typ[pos]);
164      switch(o->ord_typ)
165      {
166        case ro_dp:
167        {
168          int a,e;
169          a=o->data.dp.start;
170          e=o->data.dp.end;
171          for(int i=a;i<=e;i++) ord+=p_GetExp(p,i,r);
172          p->exp[o->data.dp.place]=ord;
173          break;
174        }
175        case ro_wp_neg:
176          ord=POLY_NEGWEIGHT_OFFSET;
177          // no break;
178        case ro_wp:
179        {
180          int a,e;
181          a=o->data.wp.start;
182          e=o->data.wp.end;
183          int *w=o->data.wp.weights;
184#if 1
185          for(int i=a;i<=e;i++) ord+=((unsigned long)p_GetExp(p,i,r))*((unsigned long)w[i-a]);
186#else
187          long ai;
188          int ei,wi;
189          for(int i=a;i<=e;i++)
190          {
191             ei=p_GetExp(p,i,r);
192             wi=w[i-a];
193             ai=ei*wi;
194             if (ai/ei!=wi) pSetm_error=TRUE;
195             ord+=ai;
196             if (ord<ai) pSetm_error=TRUE;
197          }
198#endif
199          p->exp[o->data.wp.place]=ord;
200          break;
201        }
202        case ro_am:
203        {
204          ord = POLY_NEGWEIGHT_OFFSET;
205          const short a=o->data.am.start;
206          const short e=o->data.am.end;
207          const int * w=o->data.am.weights;
208#if 1
209          for(short i=a; i<=e; i++, w++)
210            ord += ((*w) * p_GetExp(p,i,r));
211#else
212          long ai;
213          int ei,wi;
214          for(short i=a;i<=e;i++)
215          {
216             ei=p_GetExp(p,i,r);
217             wi=w[i-a];
218             ai=ei*wi;
219             if (ai/ei!=wi) pSetm_error=TRUE;
220             ord += ai;
221             if (ord<ai) pSetm_error=TRUE;
222          }
223#endif
224          const int c = p_GetComp(p,r);
225
226          const short len_gen= o->data.am.len_gen;
227
228          if ((c > 0) && (c <= len_gen))
229          {
230            assume( w == o->data.am.weights_m );
231            assume( w[0] == len_gen );
232            ord += w[c];
233          }
234
235          p->exp[o->data.am.place] = ord;
236          break;
237        }
238      case ro_wp64:
239        {
240          int64 ord=0;
241          int a,e;
242          a=o->data.wp64.start;
243          e=o->data.wp64.end;
244          int64 *w=o->data.wp64.weights64;
245          int64 ei,wi,ai;
246          for(int i=a;i<=e;i++)
247          {
248            //Print("exp %d w %d \n",p_GetExp(p,i,r),(int)w[i-a]);
249            //ord+=((int64)p_GetExp(p,i,r))*w[i-a];
250            ei=(int64)p_GetExp(p,i,r);
251            wi=w[i-a];
252            ai=ei*wi;
253            if(ei!=0 && ai/ei!=wi)
254            {
255              pSetm_error=TRUE;
256              #if SIZEOF_LONG == 4
257              Print("ai %lld, wi %lld\n",ai,wi);
258              #else
259              Print("ai %ld, wi %ld\n",ai,wi);
260              #endif
261            }
262            ord+=ai;
263            if (ord<ai)
264            {
265              pSetm_error=TRUE;
266              #if SIZEOF_LONG == 4
267              Print("ai %lld, ord %lld\n",ai,ord);
268              #else
269              Print("ai %ld, ord %ld\n",ai,ord);
270              #endif
271            }
272          }
273          int64 mask=(int64)0x7fffffff;
274          long a_0=(long)(ord&mask); //2^31
275          long a_1=(long)(ord >>31 ); /*(ord/(mask+1));*/
276
277          //Print("mask: %x,  ord: %d,  a_0: %d,  a_1: %d\n"
278          //,(int)mask,(int)ord,(int)a_0,(int)a_1);
279                    //Print("mask: %d",mask);
280
281          p->exp[o->data.wp64.place]=a_1;
282          p->exp[o->data.wp64.place+1]=a_0;
283//            if(p_Setm_error) PrintS("***************************\n"
284//                                    "***************************\n"
285//                                    "**WARNING: overflow error**\n"
286//                                    "***************************\n"
287//                                    "***************************\n");
288          break;
289        }
290        case ro_cp:
291        {
292          int a,e;
293          a=o->data.cp.start;
294          e=o->data.cp.end;
295          int pl=o->data.cp.place;
296          for(int i=a;i<=e;i++) { p->exp[pl]=p_GetExp(p,i,r); pl++; }
297          break;
298        }
299        case ro_syzcomp:
300        {
301          long c=__p_GetComp(p,r);
302          long sc = c;
303          int* Components = (_componentsExternal ? _components :
304                             o->data.syzcomp.Components);
305          long* ShiftedComponents = (_componentsExternal ? _componentsShifted:
306                                     o->data.syzcomp.ShiftedComponents);
307          if (ShiftedComponents != NULL)
308          {
309            assume(Components != NULL);
310            assume(c == 0 || Components[c] != 0);
311            sc = ShiftedComponents[Components[c]];
312            assume(c == 0 || sc != 0);
313          }
314          p->exp[o->data.syzcomp.place]=sc;
315          break;
316        }
317        case ro_syz:
318        {
319          const unsigned long c = __p_GetComp(p, r);
320          const short place = o->data.syz.place;
321          const int limit = o->data.syz.limit;
322
323          if (c > (unsigned long)limit)
324            p->exp[place] = o->data.syz.curr_index;
325          else if (c > 0)
326          {
327            assume( (1 <= c) && (c <= (unsigned long)limit) );
328            p->exp[place]= o->data.syz.syz_index[c];
329          }
330          else
331          {
332            assume(c == 0);
333            p->exp[place]= 0;
334          }
335          break;
336        }
337        // Prefix for Induced Schreyer ordering
338        case ro_isTemp: // Do nothing?? (to be removed into suffix later on...?)
339        {
340          assume(p != NULL);
341
342#ifndef SING_NDEBUG
343#if MYTEST
344          Print("p_Setm_General: ro_isTemp ord: pos: %d, p: ", pos);  p_wrp(p, r);
345#endif
346#endif
347          int c = p_GetComp(p, r);
348
349          assume( c >= 0 );
350
351          // Let's simulate case ro_syz above....
352          // Should accumulate (by Suffix) and be a level indicator
353          const int* const pVarOffset = o->data.isTemp.pVarOffset;
354
355          assume( pVarOffset != NULL );
356
357          // TODO: Can this be done in the suffix???
358          for( int i = 1; i <= r->N; i++ ) // No v[0] here!!!
359          {
360            const int vo = pVarOffset[i];
361            if( vo != -1) // TODO: optimize: can be done once!
362            {
363              // Hans! Please don't break it again! p_SetExp(p, ..., r, vo) is correct:
364              p_SetExp(p, p_GetExp(p, i, r), r, vo); // copy put them verbatim
365              // Hans! Please don't break it again! p_GetExp(p, r, vo) is correct:
366              assume( p_GetExp(p, r, vo) == p_GetExp(p, i, r) ); // copy put them verbatim
367            }
368          }
369#ifndef SING_NDEBUG
370          for( int i = 1; i <= r->N; i++ ) // No v[0] here!!!
371          {
372            const int vo = pVarOffset[i];
373            if( vo != -1) // TODO: optimize: can be done once!
374            {
375              // Hans! Please don't break it again! p_GetExp(p, r, vo) is correct:
376              assume( p_GetExp(p, r, vo) == p_GetExp(p, i, r) ); // copy put them verbatim
377            }
378          }
379#if MYTEST
380//          if( p->exp[o->data.isTemp.start] > 0 )
381            PrintS("after Values: "); p_wrp(p, r);
382#endif
383#endif
384          break;
385        }
386
387        // Suffix for Induced Schreyer ordering
388        case ro_is:
389        {
390#ifndef SING_NDEBUG
391#if MYTEST
392          Print("p_Setm_General: ro_is ord: pos: %d, p: ", pos);  p_wrp(p, r);
393#endif
394#endif
395
396          assume(p != NULL);
397
398          int c = p_GetComp(p, r);
399
400          assume( c >= 0 );
401          const ideal F = o->data.is.F;
402          const int limit = o->data.is.limit;
403          assume( limit >= 0 );
404          const int start = o->data.is.start;
405
406          if( F != NULL && c > limit )
407          {
408#ifndef SING_NDEBUG
409#if MYTEST
410            Print("p_Setm_General: ro_is : in rSetm: pos: %d, c: %d >  limit: %d\n", c, pos, limit);
411            PrintS("preComputed Values: ");
412            p_wrp(p, r);
413#endif
414#endif
415//          if( c > limit ) // BUG???
416            p->exp[start] = 1;
417//          else
418//            p->exp[start] = 0;
419
420
421            c -= limit;
422            assume( c > 0 );
423            c--;
424
425            if( c >= IDELEMS(F) )
426              break;
427
428            assume( c < IDELEMS(F) ); // What about others???
429
430            const poly pp = F->m[c]; // get reference monomial!!!
431
432            if(pp == NULL)
433              break;
434
435            assume(pp != NULL);
436
437#ifndef SING_NDEBUG
438#if MYTEST
439            Print("Respective F[c - %d: %d] pp: ", limit, c);
440            p_wrp(pp, r);
441#endif
442#endif
443
444            const int end = o->data.is.end;
445            assume(start <= end);
446
447
448//          const int st = o->data.isTemp.start;
449
450#ifndef SING_NDEBUG
451#if MYTEST
452            Print("p_Setm_General: is(-Temp-) :: c: %d, limit: %d, [st:%d] ===>>> %ld\n", c, limit, start, p->exp[start]);
453#endif
454#endif
455
456            // p_ExpVectorAdd(p, pp, r);
457
458            for( int i = start; i <= end; i++) // v[0] may be here...
459              p->exp[i] += pp->exp[i]; // !!!!!!!! ADD corresponding LT(F)
460
461            // p_MemAddAdjust(p, ri);
462            if (r->NegWeightL_Offset != NULL)
463            {
464              for (int i=r->NegWeightL_Size-1; i>=0; i--)
465              {
466                const int _i = r->NegWeightL_Offset[i];
467                if( start <= _i && _i <= end )
468                  p->exp[_i] -= POLY_NEGWEIGHT_OFFSET;
469              }
470            }
471
472
473#ifndef SING_NDEBUG
474            const int* const pVarOffset = o->data.is.pVarOffset;
475
476            assume( pVarOffset != NULL );
477
478            for( int i = 1; i <= r->N; i++ ) // No v[0] here!!!
479            {
480              const int vo = pVarOffset[i];
481              if( vo != -1) // TODO: optimize: can be done once!
482                // Hans! Please don't break it again! p_GetExp(p/pp, r, vo) is correct:
483                assume( p_GetExp(p, r, vo) == (p_GetExp(p, i, r) + p_GetExp(pp, r, vo)) );
484            }
485            // TODO: how to check this for computed values???
486#if MYTEST
487            PrintS("Computed Values: "); p_wrp(p, r);
488#endif
489#endif
490          } else
491          {
492            p->exp[start] = 0; //!!!!????? where?????
493
494            const int* const pVarOffset = o->data.is.pVarOffset;
495
496            // What about v[0] - component: it will be added later by
497            // suffix!!!
498            // TODO: Test it!
499            const int vo = pVarOffset[0];
500            if( vo != -1 )
501              p->exp[vo] = c; // initial component v[0]!
502
503#ifndef SING_NDEBUG
504#if MYTEST
505            Print("ELSE p_Setm_General: ro_is :: c: %d <= limit: %d, vo: %d, exp: %d\n", c, limit, vo, p->exp[vo]);
506            p_wrp(p, r);
507#endif
508#endif
509          }
510
511          break;
512        }
513        default:
514          dReportError("wrong ord in rSetm:%d\n",o->ord_typ);
515          return;
516      }
517      pos++;
518      if (pos == r->OrdSize) return;
519    }
520  }
521}
522
523void p_Setm_Syz(poly p, ring r, int* Components, long* ShiftedComponents)
524{
525  _components = Components;
526  _componentsShifted = ShiftedComponents;
527  _componentsExternal = 1;
528  p_Setm_General(p, r);
529  _componentsExternal = 0;
530}
531
532// dummy for lp, ls, etc
533void p_Setm_Dummy(poly p, const ring r)
534{
535  p_LmCheckPolyRing(p, r);
536}
537
538// for dp, Dp, ds, etc
539void p_Setm_TotalDegree(poly p, const ring r)
540{
541  p_LmCheckPolyRing(p, r);
542  p->exp[r->pOrdIndex] = p_Totaldegree(p, r);
543}
544
545// for wp, Wp, ws, etc
546void p_Setm_WFirstTotalDegree(poly p, const ring r)
547{
548  p_LmCheckPolyRing(p, r);
549  p->exp[r->pOrdIndex] = p_WFirstTotalDegree(p, r);
550}
551
552p_SetmProc p_GetSetmProc(const ring r)
553{
554  // covers lp, rp, ls,
555  if (r->typ == NULL) return p_Setm_Dummy;
556
557  if (r->OrdSize == 1)
558  {
559    if (r->typ[0].ord_typ == ro_dp &&
560        r->typ[0].data.dp.start == 1 &&
561        r->typ[0].data.dp.end == r->N &&
562        r->typ[0].data.dp.place == r->pOrdIndex)
563      return p_Setm_TotalDegree;
564    if (r->typ[0].ord_typ == ro_wp &&
565        r->typ[0].data.wp.start == 1 &&
566        r->typ[0].data.wp.end == r->N &&
567        r->typ[0].data.wp.place == r->pOrdIndex &&
568        r->typ[0].data.wp.weights == r->firstwv)
569      return p_Setm_WFirstTotalDegree;
570  }
571  return p_Setm_General;
572}
573
574
575/* -------------------------------------------------------------------*/
576/* several possibilities for pFDeg: the degree of the head term       */
577
578/* comptible with ordering */
579long p_Deg(poly a, const ring r)
580{
581  p_LmCheckPolyRing(a, r);
582//  assume(p_GetOrder(a, r) == p_WTotaldegree(a, r)); // WRONG assume!
583  return p_GetOrder(a, r);
584}
585
586// p_WTotalDegree for weighted orderings
587// whose first block covers all variables
588long p_WFirstTotalDegree(poly p, const ring r)
589{
590  int i;
591  long sum = 0;
592
593  for (i=1; i<= r->firstBlockEnds; i++)
594  {
595    sum += p_GetExp(p, i, r)*r->firstwv[i-1];
596  }
597  return sum;
598}
599
600/*2
601* compute the degree of the leading monomial of p
602* with respect to weigths from the ordering
603* the ordering is not compatible with degree so do not use p->Order
604*/
605long p_WTotaldegree(poly p, const ring r)
606{
607  p_LmCheckPolyRing(p, r);
608  int i, k;
609  long j =0;
610
611  // iterate through each block:
612  for (i=0;r->order[i]!=0;i++)
613  {
614    int b0=r->block0[i];
615    int b1=r->block1[i];
616    switch(r->order[i])
617    {
618      case ringorder_M:
619        for (k=b0 /*r->block0[i]*/;k<=b1 /*r->block1[i]*/;k++)
620        { // in jedem block:
621          j+= p_GetExp(p,k,r)*r->wvhdl[i][k - b0 /*r->block0[i]*/]*r->OrdSgn;
622        }
623        break;
624      case ringorder_am:
625        b1=si_min(b1,r->N);
626        /* no break, continue as ringorder_a*/
627      case ringorder_a:
628        for (k=b0 /*r->block0[i]*/;k<=b1 /*r->block1[i]*/;k++)
629        { // only one line
630          j+= p_GetExp(p,k,r)*r->wvhdl[i][k - b0 /*r->block0[i]*/];
631        }
632        return j*r->OrdSgn;
633      case ringorder_wp:
634      case ringorder_ws:
635      case ringorder_Wp:
636      case ringorder_Ws:
637        for (k=b0 /*r->block0[i]*/;k<=b1 /*r->block1[i]*/;k++)
638        { // in jedem block:
639          j+= p_GetExp(p,k,r)*r->wvhdl[i][k - b0 /*r->block0[i]*/];
640        }
641        break;
642      case ringorder_lp:
643      case ringorder_ls:
644      case ringorder_rs:
645      case ringorder_dp:
646      case ringorder_ds:
647      case ringorder_Dp:
648      case ringorder_Ds:
649      case ringorder_rp:
650        for (k=b0 /*r->block0[i]*/;k<=b1 /*r->block1[i]*/;k++)
651        {
652          j+= p_GetExp(p,k,r);
653        }
654        break;
655      case ringorder_a64:
656        {
657          int64* w=(int64*)r->wvhdl[i];
658          for (k=0;k<=(b1 /*r->block1[i]*/ - b0 /*r->block0[i]*/);k++)
659          {
660            //there should be added a line which checks if w[k]>2^31
661            j+= p_GetExp(p,k+1, r)*(long)w[k];
662          }
663          //break;
664          return j;
665        }
666      case ringorder_c: /* nothing to do*/
667      case ringorder_C: /* nothing to do*/
668      case ringorder_S: /* nothing to do*/
669      case ringorder_s: /* nothing to do*/
670      case ringorder_IS: /* nothing to do */
671      case ringorder_unspec: /* to make clang happy, does not occur*/
672      case ringorder_no: /* to make clang happy, does not occur*/
673      case ringorder_L: /* to make clang happy, does not occur*/
674      case ringorder_aa: /* ignored by p_WTotaldegree*/
675        break;
676    /* no default: all orderings covered */
677    }
678  }
679  return  j;
680}
681
682long p_DegW(poly p, const short *w, const ring R)
683{
684  p_Test(p, R);
685  assume( w != NULL );
686  long r=-LONG_MAX;
687
688  while (p!=NULL)
689  {
690    long t=totaldegreeWecart_IV(p,R,w);
691    if (t>r) r=t;
692    pIter(p);
693  }
694  return r;
695}
696
697int p_Weight(int i, const ring r)
698{
699  if ((r->firstwv==NULL) || (i>r->firstBlockEnds))
700  {
701    return 1;
702  }
703  return r->firstwv[i-1];
704}
705
706long p_WDegree(poly p, const ring r)
707{
708  if (r->firstwv==NULL) return p_Totaldegree(p, r);
709  p_LmCheckPolyRing(p, r);
710  int i;
711  long j =0;
712
713  for(i=1;i<=r->firstBlockEnds;i++)
714    j+=p_GetExp(p, i, r)*r->firstwv[i-1];
715
716  for (;i<=rVar(r);i++)
717    j+=p_GetExp(p,i, r)*p_Weight(i, r);
718
719  return j;
720}
721
722
723/* ---------------------------------------------------------------------*/
724/* several possibilities for pLDeg: the maximal degree of a monomial in p*/
725/*  compute in l also the pLength of p                                   */
726
727/*2
728* compute the length of a polynomial (in l)
729* and the degree of the monomial with maximal degree: the last one
730*/
731long pLDeg0(poly p,int *l, const ring r)
732{
733  p_CheckPolyRing(p, r);
734  long k= p_GetComp(p, r);
735  int ll=1;
736
737  if (k > 0)
738  {
739    while ((pNext(p)!=NULL) && (__p_GetComp(pNext(p), r)==k))
740    {
741      pIter(p);
742      ll++;
743    }
744  }
745  else
746  {
747     while (pNext(p)!=NULL)
748     {
749       pIter(p);
750       ll++;
751     }
752  }
753  *l=ll;
754  return r->pFDeg(p, r);
755}
756
757/*2
758* compute the length of a polynomial (in l)
759* and the degree of the monomial with maximal degree: the last one
760* but search in all components before syzcomp
761*/
762long pLDeg0c(poly p,int *l, const ring r)
763{
764  assume(p!=NULL);
765  p_Test(p,r);
766  p_CheckPolyRing(p, r);
767  long o;
768  int ll=1;
769
770  if (! rIsSyzIndexRing(r))
771  {
772    while (pNext(p) != NULL)
773    {
774      pIter(p);
775      ll++;
776    }
777    o = r->pFDeg(p, r);
778  }
779  else
780  {
781    int curr_limit = rGetCurrSyzLimit(r);
782    poly pp = p;
783    while ((p=pNext(p))!=NULL)
784    {
785      if (__p_GetComp(p, r)<=curr_limit/*syzComp*/)
786        ll++;
787      else break;
788      pp = p;
789    }
790    p_Test(pp,r);
791    o = r->pFDeg(pp, r);
792  }
793  *l=ll;
794  return o;
795}
796
797/*2
798* compute the length of a polynomial (in l)
799* and the degree of the monomial with maximal degree: the first one
800* this works for the polynomial case with degree orderings
801* (both c,dp and dp,c)
802*/
803long pLDegb(poly p,int *l, const ring r)
804{
805  p_CheckPolyRing(p, r);
806  long k= p_GetComp(p, r);
807  long o = r->pFDeg(p, r);
808  int ll=1;
809
810  if (k != 0)
811  {
812    while (((p=pNext(p))!=NULL) && (__p_GetComp(p, r)==k))
813    {
814      ll++;
815    }
816  }
817  else
818  {
819    while ((p=pNext(p)) !=NULL)
820    {
821      ll++;
822    }
823  }
824  *l=ll;
825  return o;
826}
827
828/*2
829* compute the length of a polynomial (in l)
830* and the degree of the monomial with maximal degree:
831* this is NOT the last one, we have to look for it
832*/
833long pLDeg1(poly p,int *l, const ring r)
834{
835  p_CheckPolyRing(p, r);
836  long k= p_GetComp(p, r);
837  int ll=1;
838  long  t,max;
839
840  max=r->pFDeg(p, r);
841  if (k > 0)
842  {
843    while (((p=pNext(p))!=NULL) && (__p_GetComp(p, r)==k))
844    {
845      t=r->pFDeg(p, r);
846      if (t>max) max=t;
847      ll++;
848    }
849  }
850  else
851  {
852    while ((p=pNext(p))!=NULL)
853    {
854      t=r->pFDeg(p, r);
855      if (t>max) max=t;
856      ll++;
857    }
858  }
859  *l=ll;
860  return max;
861}
862
863/*2
864* compute the length of a polynomial (in l)
865* and the degree of the monomial with maximal degree:
866* this is NOT the last one, we have to look for it
867* in all components
868*/
869long pLDeg1c(poly p,int *l, const ring r)
870{
871  p_CheckPolyRing(p, r);
872  int ll=1;
873  long  t,max;
874
875  max=r->pFDeg(p, r);
876  if (rIsSyzIndexRing(r))
877  {
878    long limit = rGetCurrSyzLimit(r);
879    while ((p=pNext(p))!=NULL)
880    {
881      if (__p_GetComp(p, r)<=limit)
882      {
883        if ((t=r->pFDeg(p, r))>max) max=t;
884        ll++;
885      }
886      else break;
887    }
888  }
889  else
890  {
891    while ((p=pNext(p))!=NULL)
892    {
893      if ((t=r->pFDeg(p, r))>max) max=t;
894      ll++;
895    }
896  }
897  *l=ll;
898  return max;
899}
900
901// like pLDeg1, only pFDeg == pDeg
902long pLDeg1_Deg(poly p,int *l, const ring r)
903{
904  assume(r->pFDeg == p_Deg);
905  p_CheckPolyRing(p, r);
906  long k= p_GetComp(p, r);
907  int ll=1;
908  long  t,max;
909
910  max=p_GetOrder(p, r);
911  if (k > 0)
912  {
913    while (((p=pNext(p))!=NULL) && (__p_GetComp(p, r)==k))
914    {
915      t=p_GetOrder(p, r);
916      if (t>max) max=t;
917      ll++;
918    }
919  }
920  else
921  {
922    while ((p=pNext(p))!=NULL)
923    {
924      t=p_GetOrder(p, r);
925      if (t>max) max=t;
926      ll++;
927    }
928  }
929  *l=ll;
930  return max;
931}
932
933long pLDeg1c_Deg(poly p,int *l, const ring r)
934{
935  assume(r->pFDeg == p_Deg);
936  p_CheckPolyRing(p, r);
937  int ll=1;
938  long  t,max;
939
940  max=p_GetOrder(p, r);
941  if (rIsSyzIndexRing(r))
942  {
943    long limit = rGetCurrSyzLimit(r);
944    while ((p=pNext(p))!=NULL)
945    {
946      if (__p_GetComp(p, r)<=limit)
947      {
948        if ((t=p_GetOrder(p, r))>max) max=t;
949        ll++;
950      }
951      else break;
952    }
953  }
954  else
955  {
956    while ((p=pNext(p))!=NULL)
957    {
958      if ((t=p_GetOrder(p, r))>max) max=t;
959      ll++;
960    }
961  }
962  *l=ll;
963  return max;
964}
965
966// like pLDeg1, only pFDeg == pTotoalDegree
967long pLDeg1_Totaldegree(poly p,int *l, const ring r)
968{
969  p_CheckPolyRing(p, r);
970  long k= p_GetComp(p, r);
971  int ll=1;
972  long  t,max;
973
974  max=p_Totaldegree(p, r);
975  if (k > 0)
976  {
977    while (((p=pNext(p))!=NULL) && (__p_GetComp(p, r)==k))
978    {
979      t=p_Totaldegree(p, r);
980      if (t>max) max=t;
981      ll++;
982    }
983  }
984  else
985  {
986    while ((p=pNext(p))!=NULL)
987    {
988      t=p_Totaldegree(p, r);
989      if (t>max) max=t;
990      ll++;
991    }
992  }
993  *l=ll;
994  return max;
995}
996
997long pLDeg1c_Totaldegree(poly p,int *l, const ring r)
998{
999  p_CheckPolyRing(p, r);
1000  int ll=1;
1001  long  t,max;
1002
1003  max=p_Totaldegree(p, r);
1004  if (rIsSyzIndexRing(r))
1005  {
1006    long limit = rGetCurrSyzLimit(r);
1007    while ((p=pNext(p))!=NULL)
1008    {
1009      if (__p_GetComp(p, r)<=limit)
1010      {
1011        if ((t=p_Totaldegree(p, r))>max) max=t;
1012        ll++;
1013      }
1014      else break;
1015    }
1016  }
1017  else
1018  {
1019    while ((p=pNext(p))!=NULL)
1020    {
1021      if ((t=p_Totaldegree(p, r))>max) max=t;
1022      ll++;
1023    }
1024  }
1025  *l=ll;
1026  return max;
1027}
1028
1029// like pLDeg1, only pFDeg == p_WFirstTotalDegree
1030long pLDeg1_WFirstTotalDegree(poly p,int *l, const ring r)
1031{
1032  p_CheckPolyRing(p, r);
1033  long k= p_GetComp(p, r);
1034  int ll=1;
1035  long  t,max;
1036
1037  max=p_WFirstTotalDegree(p, r);
1038  if (k > 0)
1039  {
1040    while (((p=pNext(p))!=NULL) && (__p_GetComp(p, r)==k))
1041    {
1042      t=p_WFirstTotalDegree(p, r);
1043      if (t>max) max=t;
1044      ll++;
1045    }
1046  }
1047  else
1048  {
1049    while ((p=pNext(p))!=NULL)
1050    {
1051      t=p_WFirstTotalDegree(p, r);
1052      if (t>max) max=t;
1053      ll++;
1054    }
1055  }
1056  *l=ll;
1057  return max;
1058}
1059
1060long pLDeg1c_WFirstTotalDegree(poly p,int *l, const ring r)
1061{
1062  p_CheckPolyRing(p, r);
1063  int ll=1;
1064  long  t,max;
1065
1066  max=p_WFirstTotalDegree(p, r);
1067  if (rIsSyzIndexRing(r))
1068  {
1069    long limit = rGetCurrSyzLimit(r);
1070    while ((p=pNext(p))!=NULL)
1071    {
1072      if (__p_GetComp(p, r)<=limit)
1073      {
1074        if ((t=p_Totaldegree(p, r))>max) max=t;
1075        ll++;
1076      }
1077      else break;
1078    }
1079  }
1080  else
1081  {
1082    while ((p=pNext(p))!=NULL)
1083    {
1084      if ((t=p_Totaldegree(p, r))>max) max=t;
1085      ll++;
1086    }
1087  }
1088  *l=ll;
1089  return max;
1090}
1091
1092/***************************************************************
1093 *
1094 * Maximal Exponent business
1095 *
1096 ***************************************************************/
1097
1098static inline unsigned long
1099p_GetMaxExpL2(unsigned long l1, unsigned long l2, const ring r,
1100              unsigned long number_of_exp)
1101{
1102  const unsigned long bitmask = r->bitmask;
1103  unsigned long ml1 = l1 & bitmask;
1104  unsigned long ml2 = l2 & bitmask;
1105  unsigned long max = (ml1 > ml2 ? ml1 : ml2);
1106  unsigned long j = number_of_exp - 1;
1107
1108  if (j > 0)
1109  {
1110    unsigned long mask = bitmask << r->BitsPerExp;
1111    while (1)
1112    {
1113      ml1 = l1 & mask;
1114      ml2 = l2 & mask;
1115      max |= ((ml1 > ml2 ? ml1 : ml2) & mask);
1116      j--;
1117      if (j == 0) break;
1118      mask = mask << r->BitsPerExp;
1119    }
1120  }
1121  return max;
1122}
1123
1124static inline unsigned long
1125p_GetMaxExpL2(unsigned long l1, unsigned long l2, const ring r)
1126{
1127  return p_GetMaxExpL2(l1, l2, r, r->ExpPerLong);
1128}
1129
1130poly p_GetMaxExpP(poly p, const ring r)
1131{
1132  p_CheckPolyRing(p, r);
1133  if (p == NULL) return p_Init(r);
1134  poly max = p_LmInit(p, r);
1135  pIter(p);
1136  if (p == NULL) return max;
1137  int i, offset;
1138  unsigned long l_p, l_max;
1139  unsigned long divmask = r->divmask;
1140
1141  do
1142  {
1143    offset = r->VarL_Offset[0];
1144    l_p = p->exp[offset];
1145    l_max = max->exp[offset];
1146    // do the divisibility trick to find out whether l has an exponent
1147    if (l_p > l_max ||
1148        (((l_max & divmask) ^ (l_p & divmask)) != ((l_max-l_p) & divmask)))
1149      max->exp[offset] = p_GetMaxExpL2(l_max, l_p, r);
1150
1151    for (i=1; i<r->VarL_Size; i++)
1152    {
1153      offset = r->VarL_Offset[i];
1154      l_p = p->exp[offset];
1155      l_max = max->exp[offset];
1156      // do the divisibility trick to find out whether l has an exponent
1157      if (l_p > l_max ||
1158          (((l_max & divmask) ^ (l_p & divmask)) != ((l_max-l_p) & divmask)))
1159        max->exp[offset] = p_GetMaxExpL2(l_max, l_p, r);
1160    }
1161    pIter(p);
1162  }
1163  while (p != NULL);
1164  return max;
1165}
1166
1167unsigned long p_GetMaxExpL(poly p, const ring r, unsigned long l_max)
1168{
1169  unsigned long l_p, divmask = r->divmask;
1170  int i;
1171
1172  while (p != NULL)
1173  {
1174    l_p = p->exp[r->VarL_Offset[0]];
1175    if (l_p > l_max ||
1176        (((l_max & divmask) ^ (l_p & divmask)) != ((l_max-l_p) & divmask)))
1177      l_max = p_GetMaxExpL2(l_max, l_p, r);
1178    for (i=1; i<r->VarL_Size; i++)
1179    {
1180      l_p = p->exp[r->VarL_Offset[i]];
1181      // do the divisibility trick to find out whether l has an exponent
1182      if (l_p > l_max ||
1183          (((l_max & divmask) ^ (l_p & divmask)) != ((l_max-l_p) & divmask)))
1184        l_max = p_GetMaxExpL2(l_max, l_p, r);
1185    }
1186    pIter(p);
1187  }
1188  return l_max;
1189}
1190
1191
1192
1193
1194/***************************************************************
1195 *
1196 * Misc things
1197 *
1198 ***************************************************************/
1199// returns TRUE, if all monoms have the same component
1200BOOLEAN p_OneComp(poly p, const ring r)
1201{
1202  if(p!=NULL)
1203  {
1204    long i = p_GetComp(p, r);
1205    while (pNext(p)!=NULL)
1206    {
1207      pIter(p);
1208      if(i != p_GetComp(p, r)) return FALSE;
1209    }
1210  }
1211  return TRUE;
1212}
1213
1214/*2
1215*test if a monomial /head term is a pure power,
1216* i.e. depends on only one variable
1217*/
1218int p_IsPurePower(const poly p, const ring r)
1219{
1220  int i,k=0;
1221
1222  for (i=r->N;i;i--)
1223  {
1224    if (p_GetExp(p,i, r)!=0)
1225    {
1226      if(k!=0) return 0;
1227      k=i;
1228    }
1229  }
1230  return k;
1231}
1232
1233/*2
1234*test if a polynomial is univariate
1235* return -1 for constant,
1236* 0 for not univariate,s
1237* i if dep. on var(i)
1238*/
1239int p_IsUnivariate(poly p, const ring r)
1240{
1241  int i,k=-1;
1242
1243  while (p!=NULL)
1244  {
1245    for (i=r->N;i;i--)
1246    {
1247      if (p_GetExp(p,i, r)!=0)
1248      {
1249        if((k!=-1)&&(k!=i)) return 0;
1250        k=i;
1251      }
1252    }
1253    pIter(p);
1254  }
1255  return k;
1256}
1257
1258// set entry e[i] to 1 if var(i) occurs in p, ignore var(j) if e[j]>0
1259int  p_GetVariables(poly p, int * e, const ring r)
1260{
1261  int i;
1262  int n=0;
1263  while(p!=NULL)
1264  {
1265    n=0;
1266    for(i=r->N; i>0; i--)
1267    {
1268      if(e[i]==0)
1269      {
1270        if (p_GetExp(p,i,r)>0)
1271        {
1272          e[i]=1;
1273          n++;
1274        }
1275      }
1276      else
1277        n++;
1278    }
1279    if (n==r->N) break;
1280    pIter(p);
1281  }
1282  return n;
1283}
1284
1285
1286/*2
1287* returns a polynomial representing the integer i
1288*/
1289poly p_ISet(long i, const ring r)
1290{
1291  poly rc = NULL;
1292  if (i!=0)
1293  {
1294    rc = p_Init(r);
1295    pSetCoeff0(rc,n_Init(i,r->cf));
1296    if (n_IsZero(pGetCoeff(rc),r->cf))
1297      p_LmDelete(&rc,r);
1298  }
1299  return rc;
1300}
1301
1302/*2
1303* an optimized version of p_ISet for the special case 1
1304*/
1305poly p_One(const ring r)
1306{
1307  poly rc = p_Init(r);
1308  pSetCoeff0(rc,n_Init(1,r->cf));
1309  return rc;
1310}
1311
1312void p_Split(poly p, poly *h)
1313{
1314  *h=pNext(p);
1315  pNext(p)=NULL;
1316}
1317
1318/*2
1319* pair has no common factor ? or is no polynomial
1320*/
1321BOOLEAN p_HasNotCF(poly p1, poly p2, const ring r)
1322{
1323
1324  if (p_GetComp(p1,r) > 0 || p_GetComp(p2,r) > 0)
1325    return FALSE;
1326  int i = rVar(r);
1327  loop
1328  {
1329    if ((p_GetExp(p1, i, r) > 0) && (p_GetExp(p2, i, r) > 0))
1330      return FALSE;
1331    i--;
1332    if (i == 0)
1333      return TRUE;
1334  }
1335}
1336
1337/*2
1338* convert monomial given as string to poly, e.g. 1x3y5z
1339*/
1340const char * p_Read(const char *st, poly &rc, const ring r)
1341{
1342  if (r==NULL) { rc=NULL;return st;}
1343  int i,j;
1344  rc = p_Init(r);
1345  const char *s = n_Read(st,&(p_GetCoeff(rc, r)),r->cf);
1346  if (s==st)
1347  /* i.e. it does not start with a coeff: test if it is a ringvar*/
1348  {
1349    j = r_IsRingVar(s,r->names,r->N);
1350    if (j >= 0)
1351    {
1352      p_IncrExp(rc,1+j,r);
1353      while (*s!='\0') s++;
1354      goto done;
1355    }
1356  }
1357  while (*s!='\0')
1358  {
1359    char ss[2];
1360    ss[0] = *s++;
1361    ss[1] = '\0';
1362    j = r_IsRingVar(ss,r->names,r->N);
1363    if (j >= 0)
1364    {
1365      const char *s_save=s;
1366      s = eati(s,&i);
1367      if (((unsigned long)i) >  r->bitmask/2)
1368      {
1369        // exponent to large: it is not a monomial
1370        p_LmDelete(&rc,r);
1371        return s_save;
1372      }
1373      p_AddExp(rc,1+j, (long)i, r);
1374    }
1375    else
1376    {
1377      // 1st char of is not a varname
1378      // We return the parsed polynomial nevertheless. This is needed when
1379      // we are parsing coefficients in a rational function field.
1380      s--;
1381      break;
1382    }
1383  }
1384done:
1385  if (n_IsZero(pGetCoeff(rc),r->cf)) p_LmDelete(&rc,r);
1386  else
1387  {
1388#ifdef HAVE_PLURAL
1389    // in super-commutative ring
1390    // squares of anti-commutative variables are zeroes!
1391    if(rIsSCA(r))
1392    {
1393      const unsigned int iFirstAltVar = scaFirstAltVar(r);
1394      const unsigned int iLastAltVar  = scaLastAltVar(r);
1395
1396      assume(rc != NULL);
1397
1398      for(unsigned int k = iFirstAltVar; k <= iLastAltVar; k++)
1399        if( p_GetExp(rc, k, r) > 1 )
1400        {
1401          p_LmDelete(&rc, r);
1402          goto finish;
1403        }
1404    }
1405#endif
1406
1407    p_Setm(rc,r);
1408  }
1409finish:
1410  return s;
1411}
1412poly p_mInit(const char *st, BOOLEAN &ok, const ring r)
1413{
1414  poly p;
1415  const char *s=p_Read(st,p,r);
1416  if (*s!='\0')
1417  {
1418    if ((s!=st)&&isdigit(st[0]))
1419    {
1420      errorreported=TRUE;
1421    }
1422    ok=FALSE;
1423    p_Delete(&p,r);
1424    return NULL;
1425  }
1426  p_Test(p,r);
1427  ok=!errorreported;
1428  return p;
1429}
1430
1431/*2
1432* returns a polynomial representing the number n
1433* destroys n
1434*/
1435poly p_NSet(number n, const ring r)
1436{
1437  if (n_IsZero(n,r->cf))
1438  {
1439    n_Delete(&n, r->cf);
1440    return NULL;
1441  }
1442  else
1443  {
1444    poly rc = p_Init(r);
1445    pSetCoeff0(rc,n);
1446    return rc;
1447  }
1448}
1449/*2
1450* assumes that LM(a) = LM(b)*m, for some monomial m,
1451* returns the multiplicant m,
1452* leaves a and b unmodified
1453*/
1454poly p_MDivide(poly a, poly b, const ring r)
1455{
1456  assume((p_GetComp(a,r)==p_GetComp(b,r)) || (p_GetComp(b,r)==0));
1457  int i;
1458  poly result = p_Init(r);
1459
1460  for(i=(int)r->N; i; i--)
1461    p_SetExp(result,i, p_GetExp(a,i,r)- p_GetExp(b,i,r),r);
1462  p_SetComp(result, p_GetComp(a,r) - p_GetComp(b,r),r);
1463  p_Setm(result,r);
1464  return result;
1465}
1466
1467poly p_Div_nn(poly p, const number n, const ring r)
1468{
1469  pAssume(!n_IsZero(n,r->cf));
1470  p_Test(p, r);
1471  poly result = p;
1472  poly prev = NULL;
1473  while (p!=NULL)
1474  {
1475    number nc = n_Div(pGetCoeff(p),n,r->cf);
1476    if (!n_IsZero(nc,r->cf))
1477    {
1478      p_SetCoeff(p,nc,r);
1479      prev=p;
1480      pIter(p);
1481    }
1482    else
1483    {
1484      if (prev==NULL)
1485      {
1486        p_LmDelete(&result,r);
1487        p=result;
1488      }
1489      else
1490      {
1491        p_LmDelete(&pNext(prev),r);
1492        p=pNext(prev);
1493      }
1494    }
1495  }
1496  p_Test(result,r);
1497  return(result);
1498}
1499
1500poly p_Div_mm(poly p, const poly m, const ring r)
1501{
1502  p_Test(p, r);
1503  p_Test(m, r);
1504  poly result = p;
1505  poly prev = NULL;
1506  number n=pGetCoeff(m);
1507  while (p!=NULL)
1508  {
1509    number nc = n_Div(pGetCoeff(p),n,r->cf);
1510    n_Normalize(nc,r->cf);
1511    if (!n_IsZero(nc,r->cf))
1512    {
1513      p_SetCoeff(p,nc,r);
1514      prev=p;
1515      p_ExpVectorSub(p,m,r);
1516      pIter(p);
1517    }
1518    else
1519    {
1520      if (prev==NULL)
1521      {
1522        p_LmDelete(&result,r);
1523        p=result;
1524      }
1525      else
1526      {
1527        p_LmDelete(&pNext(prev),r);
1528        p=pNext(prev);
1529      }
1530    }
1531  }
1532  p_Test(result,r);
1533  return(result);
1534}
1535
1536/*2
1537* divides a by the monomial b, ignores monomials which are not divisible
1538* assumes that b is not NULL, destroyes b
1539*/
1540poly p_DivideM(poly a, poly b, const ring r)
1541{
1542  if (a==NULL) { p_Delete(&b,r); return NULL; }
1543  poly result=a;
1544  poly prev=NULL;
1545  number inv=pGetCoeff(b);
1546
1547  while (a!=NULL)
1548  {
1549    if (p_DivisibleBy(b,a,r))
1550    {
1551      p_ExpVectorSub(a,b,r);
1552      prev=a;
1553      pIter(a);
1554    }
1555    else
1556    {
1557      if (prev==NULL)
1558      {
1559        p_LmDelete(&result,r);
1560        a=result;
1561      }
1562      else
1563      {
1564        p_LmDelete(&pNext(prev),r);
1565        a=pNext(prev);
1566      }
1567    }
1568  }
1569  if (result!=NULL)
1570  {
1571    //if ((!rField_is_Ring(r)) || n_IsUnit(inv,r->cf))
1572    if (rField_is_Zp(r))
1573    {
1574      inv = n_Invers(inv,r->cf);
1575      __p_Mult_nn(result,inv,r);
1576      n_Delete(&inv, r->cf);
1577    }
1578    else
1579    {
1580      result = p_Div_nn(result,inv,r);
1581    }
1582  }
1583  p_Delete(&b, r);
1584  return result;
1585}
1586
1587#ifdef HAVE_RINGS
1588/* TRUE iff LT(f) | LT(g) */
1589BOOLEAN p_DivisibleByRingCase(poly f, poly g, const ring r)
1590{
1591  int exponent;
1592  for(int i = (int)rVar(r); i>0; i--)
1593  {
1594    exponent = p_GetExp(g, i, r) - p_GetExp(f, i, r);
1595    if (exponent < 0) return FALSE;
1596  }
1597  return n_DivBy(pGetCoeff(g), pGetCoeff(f), r->cf);
1598}
1599#endif
1600
1601// returns the LCM of the head terms of a and b in *m
1602void p_Lcm(const poly a, const poly b, poly m, const ring r)
1603{
1604  for (int i=r->N; i; --i)
1605    p_SetExp(m,i, si_max( p_GetExp(a,i,r), p_GetExp(b,i,r)),r);
1606
1607  p_SetComp(m, si_max(p_GetComp(a,r), p_GetComp(b,r)),r);
1608  /* Don't do a pSetm here, otherwise hres/lres chockes */
1609}
1610
1611poly p_Lcm(const poly a, const poly b, const ring r)
1612{
1613  poly m=p_Init(r);
1614  p_Lcm(a, b, m, r);
1615  p_Setm(m,r);
1616  return(m);
1617}
1618
1619#ifdef HAVE_RATGRING
1620/*2
1621* returns the rational LCM of the head terms of a and b
1622* without coefficient!!!
1623*/
1624poly p_LcmRat(const poly a, const poly b, const long lCompM, const ring r)
1625{
1626  poly m = // p_One( r);
1627          p_Init(r);
1628
1629//  const int (currRing->N) = r->N;
1630
1631  //  for (int i = (currRing->N); i>=r->real_var_start; i--)
1632  for (int i = r->real_var_end; i>=r->real_var_start; i--)
1633  {
1634    const int lExpA = p_GetExp (a, i, r);
1635    const int lExpB = p_GetExp (b, i, r);
1636
1637    p_SetExp (m, i, si_max(lExpA, lExpB), r);
1638  }
1639
1640  p_SetComp (m, lCompM, r);
1641  p_Setm(m,r);
1642  n_New(&(p_GetCoeff(m, r)), r);
1643
1644  return(m);
1645};
1646
1647void p_LmDeleteAndNextRat(poly *p, int ishift, ring r)
1648{
1649  /* modifies p*/
1650  //  Print("start: "); Print(" "); p_wrp(*p,r);
1651  p_LmCheckPolyRing2(*p, r);
1652  poly q = p_Head(*p,r);
1653  const long cmp = p_GetComp(*p, r);
1654  while ( ( (*p)!=NULL ) && ( p_Comp_k_n(*p, q, ishift+1, r) ) && (p_GetComp(*p, r) == cmp) )
1655  {
1656    p_LmDelete(p,r);
1657    //    Print("while: ");p_wrp(*p,r);Print(" ");
1658  }
1659  //  p_wrp(*p,r);Print(" ");
1660  //  PrintS("end\n");
1661  p_LmDelete(&q,r);
1662}
1663
1664
1665/* returns x-coeff of p, i.e. a poly in x, s.t. corresponding xd-monomials
1666have the same D-part and the component 0
1667does not destroy p
1668*/
1669poly p_GetCoeffRat(poly p, int ishift, ring r)
1670{
1671  poly q   = pNext(p);
1672  poly res; // = p_Head(p,r);
1673  res = p_GetExp_k_n(p, ishift+1, r->N, r); // does pSetm internally
1674  p_SetCoeff(res,n_Copy(p_GetCoeff(p,r),r),r);
1675  poly s;
1676  long cmp = p_GetComp(p, r);
1677  while ( (q!= NULL) && (p_Comp_k_n(p, q, ishift+1, r)) && (p_GetComp(q, r) == cmp) )
1678  {
1679    s   = p_GetExp_k_n(q, ishift+1, r->N, r);
1680    p_SetCoeff(s,n_Copy(p_GetCoeff(q,r),r),r);
1681    res = p_Add_q(res,s,r);
1682    q   = pNext(q);
1683  }
1684  cmp = 0;
1685  p_SetCompP(res,cmp,r);
1686  return res;
1687}
1688
1689
1690
1691void p_ContentRat(poly &ph, const ring r)
1692// changes ph
1693// for rat coefficients in K(x1,..xN)
1694{
1695  // init array of RatLeadCoeffs
1696  //  poly p_GetCoeffRat(poly p, int ishift, ring r);
1697
1698  int len=pLength(ph);
1699  poly *C = (poly *)omAlloc0((len+1)*sizeof(poly));  //rat coeffs
1700  poly *LM = (poly *)omAlloc0((len+1)*sizeof(poly));  // rat lead terms
1701  int *D = (int *)omAlloc0((len+1)*sizeof(int));  //degrees of coeffs
1702  int *L = (int *)omAlloc0((len+1)*sizeof(int));  //lengths of coeffs
1703  int k = 0;
1704  poly p = p_Copy(ph, r); // ph will be needed below
1705  int mintdeg = p_Totaldegree(p, r);
1706  int minlen = len;
1707  int dd = 0; int i;
1708  int HasConstantCoef = 0;
1709  int is = r->real_var_start - 1;
1710  while (p!=NULL)
1711  {
1712    LM[k] = p_GetExp_k_n(p,1,is, r); // need LmRat istead of  p_HeadRat(p, is, currRing); !
1713    C[k] = p_GetCoeffRat(p, is, r);
1714    D[k] =  p_Totaldegree(C[k], r);
1715    mintdeg = si_min(mintdeg,D[k]);
1716    L[k] = pLength(C[k]);
1717    minlen = si_min(minlen,L[k]);
1718    if (p_IsConstant(C[k], r))
1719    {
1720      // C[k] = const, so the content will be numerical
1721      HasConstantCoef = 1;
1722      // smth like goto cleanup and return(pContent(p));
1723    }
1724    p_LmDeleteAndNextRat(&p, is, r);
1725    k++;
1726  }
1727
1728  // look for 1 element of minimal degree and of minimal length
1729  k--;
1730  poly d;
1731  int mindeglen = len;
1732  if (k<=0) // this poly is not a ratgring poly -> pContent
1733  {
1734    p_Delete(&C[0], r);
1735    p_Delete(&LM[0], r);
1736    p_ContentForGB(ph, r);
1737    goto cleanup;
1738  }
1739
1740  int pmindeglen;
1741  for(i=0; i<=k; i++)
1742  {
1743    if (D[i] == mintdeg)
1744    {
1745      if (L[i] < mindeglen)
1746      {
1747        mindeglen=L[i];
1748        pmindeglen = i;
1749      }
1750    }
1751  }
1752  d = p_Copy(C[pmindeglen], r);
1753  // there are dd>=1 mindeg elements
1754  // and pmideglen is the coordinate of one of the smallest among them
1755
1756  //  poly g = singclap_gcd(p_Copy(p,r),p_Copy(q,r));
1757  //  return naGcd(d,d2,currRing);
1758
1759  // adjoin pContentRat here?
1760  for(i=0; i<=k; i++)
1761  {
1762    d=singclap_gcd(d,p_Copy(C[i], r), r);
1763    if (p_Totaldegree(d, r)==0)
1764    {
1765      // cleanup, pContent, return
1766      p_Delete(&d, r);
1767      for(;k>=0;k--)
1768      {
1769        p_Delete(&C[k], r);
1770        p_Delete(&LM[k], r);
1771      }
1772      p_ContentForGB(ph, r);
1773      goto cleanup;
1774    }
1775  }
1776  for(i=0; i<=k; i++)
1777  {
1778    poly h=singclap_pdivide(C[i],d, r);
1779    p_Delete(&C[i], r);
1780    C[i]=h;
1781  }
1782
1783  // zusammensetzen,
1784  p=NULL; // just to be sure
1785  for(i=0; i<=k; i++)
1786  {
1787    p = p_Add_q(p, p_Mult_q(C[i],LM[i], r), r);
1788    C[i]=NULL; LM[i]=NULL;
1789  }
1790  p_Delete(&ph, r); // do not need it anymore
1791  ph = p;
1792  // aufraeumen, return
1793cleanup:
1794  omFree(C);
1795  omFree(LM);
1796  omFree(D);
1797  omFree(L);
1798}
1799
1800
1801#endif
1802
1803
1804/* assumes that p and divisor are univariate polynomials in r,
1805   mentioning the same variable;
1806   assumes divisor != NULL;
1807   p may be NULL;
1808   assumes a global monomial ordering in r;
1809   performs polynomial division of p by divisor:
1810     - afterwards p contains the remainder of the division, i.e.,
1811       p_before = result * divisor + p_afterwards;
1812     - if needResult == TRUE, then the method computes and returns 'result',
1813       otherwise NULL is returned (This parametrization can be used when
1814       one is only interested in the remainder of the division. In this
1815       case, the method will be slightly faster.)
1816   leaves divisor unmodified */
1817poly      p_PolyDiv(poly &p, const poly divisor, const BOOLEAN needResult, const ring r)
1818{
1819  assume(divisor != NULL);
1820  if (p == NULL) return NULL;
1821
1822  poly result = NULL;
1823  number divisorLC = p_GetCoeff(divisor, r);
1824  int divisorLE = p_GetExp(divisor, 1, r);
1825  while ((p != NULL) && (p_Deg(p, r) >= p_Deg(divisor, r)))
1826  {
1827    /* determine t = LT(p) / LT(divisor) */
1828    poly t = p_ISet(1, r);
1829    number c = n_Div(p_GetCoeff(p, r), divisorLC, r->cf);
1830    n_Normalize(c,r->cf);
1831    p_SetCoeff(t, c, r);
1832    int e = p_GetExp(p, 1, r) - divisorLE;
1833    p_SetExp(t, 1, e, r);
1834    p_Setm(t, r);
1835    if (needResult) result = p_Add_q(result, p_Copy(t, r), r);
1836    p = p_Add_q(p, p_Neg(p_Mult_q(t, p_Copy(divisor, r), r), r), r);
1837  }
1838  return result;
1839}
1840
1841/*2
1842* returns the partial differentiate of a by the k-th variable
1843* does not destroy the input
1844*/
1845poly p_Diff(poly a, int k, const ring r)
1846{
1847  poly res, f, last;
1848  number t;
1849
1850  last = res = NULL;
1851  while (a!=NULL)
1852  {
1853    if (p_GetExp(a,k,r)!=0)
1854    {
1855      f = p_LmInit(a,r);
1856      t = n_Init(p_GetExp(a,k,r),r->cf);
1857      pSetCoeff0(f,n_Mult(t,pGetCoeff(a),r->cf));
1858      n_Delete(&t,r->cf);
1859      if (n_IsZero(pGetCoeff(f),r->cf))
1860        p_LmDelete(&f,r);
1861      else
1862      {
1863        p_DecrExp(f,k,r);
1864        p_Setm(f,r);
1865        if (res==NULL)
1866        {
1867          res=last=f;
1868        }
1869        else
1870        {
1871          pNext(last)=f;
1872          last=f;
1873        }
1874      }
1875    }
1876    pIter(a);
1877  }
1878  return res;
1879}
1880
1881static poly p_DiffOpM(poly a, poly b,BOOLEAN multiply, const ring r)
1882{
1883  int i,j,s;
1884  number n,h,hh;
1885  poly p=p_One(r);
1886  n=n_Mult(pGetCoeff(a),pGetCoeff(b),r->cf);
1887  for(i=rVar(r);i>0;i--)
1888  {
1889    s=p_GetExp(b,i,r);
1890    if (s<p_GetExp(a,i,r))
1891    {
1892      n_Delete(&n,r->cf);
1893      p_LmDelete(&p,r);
1894      return NULL;
1895    }
1896    if (multiply)
1897    {
1898      for(j=p_GetExp(a,i,r); j>0;j--)
1899      {
1900        h = n_Init(s,r->cf);
1901        hh=n_Mult(n,h,r->cf);
1902        n_Delete(&h,r->cf);
1903        n_Delete(&n,r->cf);
1904        n=hh;
1905        s--;
1906      }
1907      p_SetExp(p,i,s,r);
1908    }
1909    else
1910    {
1911      p_SetExp(p,i,s-p_GetExp(a,i,r),r);
1912    }
1913  }
1914  p_Setm(p,r);
1915  /*if (multiply)*/ p_SetCoeff(p,n,r);
1916  if (n_IsZero(n,r->cf))  p=p_LmDeleteAndNext(p,r); // return NULL as p is a monomial
1917  return p;
1918}
1919
1920poly p_DiffOp(poly a, poly b,BOOLEAN multiply, const ring r)
1921{
1922  poly result=NULL;
1923  poly h;
1924  for(;a!=NULL;pIter(a))
1925  {
1926    for(h=b;h!=NULL;pIter(h))
1927    {
1928      result=p_Add_q(result,p_DiffOpM(a,h,multiply,r),r);
1929    }
1930  }
1931  return result;
1932}
1933/*2
1934* subtract p2 from p1, p1 and p2 are destroyed
1935* do not put attention on speed: the procedure is only used in the interpreter
1936*/
1937poly p_Sub(poly p1, poly p2, const ring r)
1938{
1939  return p_Add_q(p1, p_Neg(p2,r),r);
1940}
1941
1942/*3
1943* compute for a monomial m
1944* the power m^exp, exp > 1
1945* destroys p
1946*/
1947static poly p_MonPower(poly p, int exp, const ring r)
1948{
1949  int i;
1950
1951  if(!n_IsOne(pGetCoeff(p),r->cf))
1952  {
1953    number x, y;
1954    y = pGetCoeff(p);
1955    n_Power(y,exp,&x,r->cf);
1956    n_Delete(&y,r->cf);
1957    pSetCoeff0(p,x);
1958  }
1959  for (i=rVar(r); i!=0; i--)
1960  {
1961    p_MultExp(p,i, exp,r);
1962  }
1963  p_Setm(p,r);
1964  return p;
1965}
1966
1967/*3
1968* compute for monomials p*q
1969* destroys p, keeps q
1970*/
1971static void p_MonMult(poly p, poly q, const ring r)
1972{
1973  number x, y;
1974
1975  y = pGetCoeff(p);
1976  x = n_Mult(y,pGetCoeff(q),r->cf);
1977  n_Delete(&y,r->cf);
1978  pSetCoeff0(p,x);
1979  //for (int i=pVariables; i!=0; i--)
1980  //{
1981  //  pAddExp(p,i, pGetExp(q,i));
1982  //}
1983  //p->Order += q->Order;
1984  p_ExpVectorAdd(p,q,r);
1985}
1986
1987/*3
1988* compute for monomials p*q
1989* keeps p, q
1990*/
1991static poly p_MonMultC(poly p, poly q, const ring rr)
1992{
1993  number x;
1994  poly r = p_Init(rr);
1995
1996  x = n_Mult(pGetCoeff(p),pGetCoeff(q),rr->cf);
1997  pSetCoeff0(r,x);
1998  p_ExpVectorSum(r,p, q, rr);
1999  return r;
2000}
2001
2002/*3
2003*  create binomial coef.
2004*/
2005static number* pnBin(int exp, const ring r)
2006{
2007  int e, i, h;
2008  number x, y, *bin=NULL;
2009
2010  x = n_Init(exp,r->cf);
2011  if (n_IsZero(x,r->cf))
2012  {
2013    n_Delete(&x,r->cf);
2014    return bin;
2015  }
2016  h = (exp >> 1) + 1;
2017  bin = (number *)omAlloc0(h*sizeof(number));
2018  bin[1] = x;
2019  if (exp < 4)
2020    return bin;
2021  i = exp - 1;
2022  for (e=2; e<h; e++)
2023  {
2024      x = n_Init(i,r->cf);
2025      i--;
2026      y = n_Mult(x,bin[e-1],r->cf);
2027      n_Delete(&x,r->cf);
2028      x = n_Init(e,r->cf);
2029      bin[e] = n_ExactDiv(y,x,r->cf);
2030      n_Delete(&x,r->cf);
2031      n_Delete(&y,r->cf);
2032  }
2033  return bin;
2034}
2035
2036static void pnFreeBin(number *bin, int exp,const coeffs r)
2037{
2038  int e, h = (exp >> 1) + 1;
2039
2040  if (bin[1] != NULL)
2041  {
2042    for (e=1; e<h; e++)
2043      n_Delete(&(bin[e]),r);
2044  }
2045  omFreeSize((ADDRESS)bin, h*sizeof(number));
2046}
2047
2048/*
2049*  compute for a poly p = head+tail, tail is monomial
2050*          (head + tail)^exp, exp > 1
2051*          with binomial coef.
2052*/
2053static poly p_TwoMonPower(poly p, int exp, const ring r)
2054{
2055  int eh, e;
2056  long al;
2057  poly *a;
2058  poly tail, b, res, h;
2059  number x;
2060  number *bin = pnBin(exp,r);
2061
2062  tail = pNext(p);
2063  if (bin == NULL)
2064  {
2065    p_MonPower(p,exp,r);
2066    p_MonPower(tail,exp,r);
2067    p_Test(p,r);
2068    return p;
2069  }
2070  eh = exp >> 1;
2071  al = (exp + 1) * sizeof(poly);
2072  a = (poly *)omAlloc(al);
2073  a[1] = p;
2074  for (e=1; e<exp; e++)
2075  {
2076    a[e+1] = p_MonMultC(a[e],p,r);
2077  }
2078  res = a[exp];
2079  b = p_Head(tail,r);
2080  for (e=exp-1; e>eh; e--)
2081  {
2082    h = a[e];
2083    x = n_Mult(bin[exp-e],pGetCoeff(h),r->cf);
2084    p_SetCoeff(h,x,r);
2085    p_MonMult(h,b,r);
2086    res = pNext(res) = h;
2087    p_MonMult(b,tail,r);
2088  }
2089  for (e=eh; e!=0; e--)
2090  {
2091    h = a[e];
2092    x = n_Mult(bin[e],pGetCoeff(h),r->cf);
2093    p_SetCoeff(h,x,r);
2094    p_MonMult(h,b,r);
2095    res = pNext(res) = h;
2096    p_MonMult(b,tail,r);
2097  }
2098  p_LmDelete(&tail,r);
2099  pNext(res) = b;
2100  pNext(b) = NULL;
2101  res = a[exp];
2102  omFreeSize((ADDRESS)a, al);
2103  pnFreeBin(bin, exp, r->cf);
2104//  tail=res;
2105// while((tail!=NULL)&&(pNext(tail)!=NULL))
2106// {
2107//   if(nIsZero(pGetCoeff(pNext(tail))))
2108//   {
2109//     pLmDelete(&pNext(tail));
2110//   }
2111//   else
2112//     pIter(tail);
2113// }
2114  p_Test(res,r);
2115  return res;
2116}
2117
2118static poly p_Pow(poly p, int i, const ring r)
2119{
2120  poly rc = p_Copy(p,r);
2121  i -= 2;
2122  do
2123  {
2124    rc = p_Mult_q(rc,p_Copy(p,r),r);
2125    p_Normalize(rc,r);
2126    i--;
2127  }
2128  while (i != 0);
2129  return p_Mult_q(rc,p,r);
2130}
2131
2132static poly p_Pow_charp(poly p, int i, const ring r)
2133{
2134  //assume char_p == i
2135  poly h=p;
2136  while(h!=NULL) { p_MonPower(h,i,r);pIter(h);}
2137  return p;
2138}
2139
2140/*2
2141* returns the i-th power of p
2142* p will be destroyed
2143*/
2144poly p_Power(poly p, int i, const ring r)
2145{
2146  poly rc=NULL;
2147
2148  if (i==0)
2149  {
2150    p_Delete(&p,r);
2151    return p_One(r);
2152  }
2153
2154  if(p!=NULL)
2155  {
2156    if ( (i > 0) && ((unsigned long ) i > (r->bitmask)))
2157    {
2158      Werror("exponent %d is too large, max. is %ld",i,r->bitmask);
2159      return NULL;
2160    }
2161    switch (i)
2162    {
2163// cannot happen, see above
2164//      case 0:
2165//      {
2166//        rc=pOne();
2167//        pDelete(&p);
2168//        break;
2169//      }
2170      case 1:
2171        rc=p;
2172        break;
2173      case 2:
2174        rc=p_Mult_q(p_Copy(p,r),p,r);
2175        break;
2176      default:
2177        if (i < 0)
2178        {
2179          p_Delete(&p,r);
2180          return NULL;
2181        }
2182        else
2183        {
2184#ifdef HAVE_PLURAL
2185          if (rIsPluralRing(r)) /* in the NC case nothing helps :-( */
2186          {
2187            int j=i;
2188            rc = p_Copy(p,r);
2189            while (j>1)
2190            {
2191              rc = p_Mult_q(p_Copy(p,r),rc,r);
2192              j--;
2193            }
2194            p_Delete(&p,r);
2195            return rc;
2196          }
2197#endif
2198          rc = pNext(p);
2199          if (rc == NULL)
2200            return p_MonPower(p,i,r);
2201          /* else: binom ?*/
2202          int char_p=rChar(r);
2203          if ((char_p>0) && (i>char_p)
2204          && ((rField_is_Zp(r,char_p)
2205            || (rField_is_Zp_a(r,char_p)))))
2206          {
2207            poly h=p_Pow_charp(p_Copy(p,r),char_p,r);
2208            int rest=i-char_p;
2209            while (rest>=char_p)
2210            {
2211              rest-=char_p;
2212              h=p_Mult_q(h,p_Pow_charp(p_Copy(p,r),char_p,r),r);
2213            }
2214            poly res=h;
2215            if (rest>0)
2216              res=p_Mult_q(p_Power(p_Copy(p,r),rest,r),h,r);
2217            p_Delete(&p,r);
2218            return res;
2219          }
2220          if ((pNext(rc) != NULL)
2221             || rField_is_Ring(r)
2222             )
2223            return p_Pow(p,i,r);
2224          if ((char_p==0) || (i<=char_p))
2225            return p_TwoMonPower(p,i,r);
2226          return p_Pow(p,i,r);
2227        }
2228      /*end default:*/
2229    }
2230  }
2231  return rc;
2232}
2233
2234/* --------------------------------------------------------------------------------*/
2235/* content suff                                                                   */
2236//number p_InitContent(poly ph, const ring r);
2237
2238void p_Content(poly ph, const ring r)
2239{
2240  if (ph==NULL) return;
2241  const coeffs cf=r->cf;
2242  if (pNext(ph)==NULL)
2243  {
2244    p_SetCoeff(ph,n_Init(1,cf),r);
2245  }
2246  if (cf->cfSubringGcd==ndGcd) /* trivial gcd*/ return;
2247  number h=p_InitContent(ph,r); /* first guess of a gcd of all coeffs */
2248  poly p;
2249  if(n_IsOne(h,cf))
2250  {
2251    goto content_finish;
2252  }
2253  p=ph;
2254  // take the SubringGcd of all coeffs
2255  while (p!=NULL)
2256  {
2257    n_Normalize(pGetCoeff(p),cf);
2258    number d=n_SubringGcd(h,pGetCoeff(p),cf);
2259    n_Delete(&h,cf);
2260    h = d;
2261    if(n_IsOne(h,cf))
2262    {
2263      goto content_finish;
2264    }
2265    pIter(p);
2266  }
2267  // if found<>1, divide by it
2268  p = ph;
2269  while (p!=NULL)
2270  {
2271    number d = n_ExactDiv(pGetCoeff(p),h,cf);
2272    p_SetCoeff(p,d,r);
2273    pIter(p);
2274  }
2275content_finish:
2276  n_Delete(&h,r->cf);
2277  // and last: check leading sign:
2278  if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2279}
2280
2281#define CLEARENUMERATORS 1
2282
2283void p_ContentForGB(poly ph, const ring r)
2284{
2285  if(TEST_OPT_CONTENTSB) return;
2286  assume( ph != NULL );
2287
2288  assume( r != NULL ); assume( r->cf != NULL );
2289
2290
2291#if CLEARENUMERATORS
2292  if( 0 )
2293  {
2294    const coeffs C = r->cf;
2295      // experimentall (recursive enumerator treatment) of alg. Ext!
2296    CPolyCoeffsEnumerator itr(ph);
2297    n_ClearContent(itr, r->cf);
2298
2299    p_Test(ph, r); n_Test(pGetCoeff(ph), C);
2300    assume(n_GreaterZero(pGetCoeff(ph), C)); // ??
2301
2302      // if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2303    return;
2304  }
2305#endif
2306
2307
2308#ifdef HAVE_RINGS
2309  if (rField_is_Ring(r))
2310  {
2311    if (rField_has_Units(r))
2312    {
2313      number k = n_GetUnit(pGetCoeff(ph),r->cf);
2314      if (!n_IsOne(k,r->cf))
2315      {
2316        number tmpGMP = k;
2317        k = n_Invers(k,r->cf);
2318        n_Delete(&tmpGMP,r->cf);
2319        poly h = pNext(ph);
2320        p_SetCoeff(ph, n_Mult(pGetCoeff(ph), k,r->cf),r);
2321        while (h != NULL)
2322        {
2323          p_SetCoeff(h, n_Mult(pGetCoeff(h), k,r->cf),r);
2324          pIter(h);
2325        }
2326//        assume( n_GreaterZero(pGetCoeff(ph),r->cf) );
2327//        if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2328      }
2329      n_Delete(&k,r->cf);
2330    }
2331    return;
2332  }
2333#endif
2334  number h,d;
2335  poly p;
2336
2337  if(pNext(ph)==NULL)
2338  {
2339    p_SetCoeff(ph,n_Init(1,r->cf),r);
2340  }
2341  else
2342  {
2343    assume( pNext(ph) != NULL );
2344#if CLEARENUMERATORS
2345    if( nCoeff_is_Q(r->cf) )
2346    {
2347      // experimentall (recursive enumerator treatment) of alg. Ext!
2348      CPolyCoeffsEnumerator itr(ph);
2349      n_ClearContent(itr, r->cf);
2350
2351      p_Test(ph, r); n_Test(pGetCoeff(ph), r->cf);
2352      assume(n_GreaterZero(pGetCoeff(ph), r->cf)); // ??
2353
2354      // if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2355      return;
2356    }
2357#endif
2358
2359    n_Normalize(pGetCoeff(ph),r->cf);
2360    if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2361    if (rField_is_Q(r)||(getCoeffType(r->cf)==n_transExt)) // should not be used anymore if CLEARENUMERATORS is 1
2362    {
2363      h=p_InitContent(ph,r);
2364      p=ph;
2365    }
2366    else
2367    {
2368      h=n_Copy(pGetCoeff(ph),r->cf);
2369      p = pNext(ph);
2370    }
2371    while (p!=NULL)
2372    {
2373      n_Normalize(pGetCoeff(p),r->cf);
2374      d=n_SubringGcd(h,pGetCoeff(p),r->cf);
2375      n_Delete(&h,r->cf);
2376      h = d;
2377      if(n_IsOne(h,r->cf))
2378      {
2379        break;
2380      }
2381      pIter(p);
2382    }
2383    //number tmp;
2384    if(!n_IsOne(h,r->cf))
2385    {
2386      p = ph;
2387      while (p!=NULL)
2388      {
2389        //d = nDiv(pGetCoeff(p),h);
2390        //tmp = nExactDiv(pGetCoeff(p),h);
2391        //if (!nEqual(d,tmp))
2392        //{
2393        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
2394        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
2395        //  nWrite(tmp);Print(StringEndS("\n")); // NOTE/TODO: use StringAppendS("\n"); omFree(s);
2396        //}
2397        //nDelete(&tmp);
2398        d = n_ExactDiv(pGetCoeff(p),h,r->cf);
2399        p_SetCoeff(p,d,r);
2400        pIter(p);
2401      }
2402    }
2403    n_Delete(&h,r->cf);
2404    if (rField_is_Q_a(r))
2405    {
2406      // special handling for alg. ext.:
2407      if (getCoeffType(r->cf)==n_algExt)
2408      {
2409        h = n_Init(1, r->cf->extRing->cf);
2410        p=ph;
2411        while (p!=NULL)
2412        { // each monom: coeff in Q_a
2413          poly c_n_n=(poly)pGetCoeff(p);
2414          poly c_n=c_n_n;
2415          while (c_n!=NULL)
2416          { // each monom: coeff in Q
2417            d=n_NormalizeHelper(h,pGetCoeff(c_n),r->cf->extRing->cf);
2418            n_Delete(&h,r->cf->extRing->cf);
2419            h=d;
2420            pIter(c_n);
2421          }
2422          pIter(p);
2423        }
2424        /* h contains the 1/lcm of all denominators in c_n_n*/
2425        //n_Normalize(h,r->cf->extRing->cf);
2426        if(!n_IsOne(h,r->cf->extRing->cf))
2427        {
2428          p=ph;
2429          while (p!=NULL)
2430          { // each monom: coeff in Q_a
2431            poly c_n=(poly)pGetCoeff(p);
2432            while (c_n!=NULL)
2433            { // each monom: coeff in Q
2434              d=n_Mult(h,pGetCoeff(c_n),r->cf->extRing->cf);
2435              n_Normalize(d,r->cf->extRing->cf);
2436              n_Delete(&pGetCoeff(c_n),r->cf->extRing->cf);
2437              pGetCoeff(c_n)=d;
2438              pIter(c_n);
2439            }
2440            pIter(p);
2441          }
2442        }
2443        n_Delete(&h,r->cf->extRing->cf);
2444      }
2445      /*else
2446      {
2447      // special handling for rat. functions.:
2448        number hzz =NULL;
2449        p=ph;
2450        while (p!=NULL)
2451        { // each monom: coeff in Q_a (Z_a)
2452          fraction f=(fraction)pGetCoeff(p);
2453          poly c_n=NUM(f);
2454          if (hzz==NULL)
2455          {
2456            hzz=n_Copy(pGetCoeff(c_n),r->cf->extRing->cf);
2457            pIter(c_n);
2458          }
2459          while ((c_n!=NULL)&&(!n_IsOne(hzz,r->cf->extRing->cf)))
2460          { // each monom: coeff in Q (Z)
2461            d=n_Gcd(hzz,pGetCoeff(c_n),r->cf->extRing->cf);
2462            n_Delete(&hzz,r->cf->extRing->cf);
2463            hzz=d;
2464            pIter(c_n);
2465          }
2466          pIter(p);
2467        }
2468        // hzz contains the gcd of all numerators in f
2469        h=n_Invers(hzz,r->cf->extRing->cf);
2470        n_Delete(&hzz,r->cf->extRing->cf);
2471        n_Normalize(h,r->cf->extRing->cf);
2472        if(!n_IsOne(h,r->cf->extRing->cf))
2473        {
2474          p=ph;
2475          while (p!=NULL)
2476          { // each monom: coeff in Q_a (Z_a)
2477            fraction f=(fraction)pGetCoeff(p);
2478            NUM(f)=__p_Mult_nn(NUM(f),h,r->cf->extRing);
2479            p_Normalize(NUM(f),r->cf->extRing);
2480            pIter(p);
2481          }
2482        }
2483        n_Delete(&h,r->cf->extRing->cf);
2484      }*/
2485    }
2486  }
2487  if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2488}
2489
2490// Not yet?
2491#if 1 // currently only used by Singular/janet
2492void p_SimpleContent(poly ph, int smax, const ring r)
2493{
2494  if(TEST_OPT_CONTENTSB) return;
2495  if (ph==NULL) return;
2496  if (pNext(ph)==NULL)
2497  {
2498    p_SetCoeff(ph,n_Init(1,r->cf),r);
2499    return;
2500  }
2501  if ((pNext(pNext(ph))==NULL)||(!rField_is_Q(r)))
2502  {
2503    return;
2504  }
2505  number d=p_InitContent(ph,r);
2506  if (n_Size(d,r->cf)<=smax)
2507  {
2508    //if (TEST_OPT_PROT) PrintS("G");
2509    return;
2510  }
2511
2512  poly p=ph;
2513  number h=d;
2514  if (smax==1) smax=2;
2515  while (p!=NULL)
2516  {
2517#if 0
2518    d=n_Gcd(h,pGetCoeff(p),r->cf);
2519    n_Delete(&h,r->cf);
2520    h = d;
2521#else
2522    STATISTIC(n_Gcd); nlInpGcd(h,pGetCoeff(p),r->cf);
2523#endif
2524    if(n_Size(h,r->cf)<smax)
2525    {
2526      //if (TEST_OPT_PROT) PrintS("g");
2527      return;
2528    }
2529    pIter(p);
2530  }
2531  p = ph;
2532  if (!n_GreaterZero(pGetCoeff(p),r->cf)) h=n_InpNeg(h,r->cf);
2533  if(n_IsOne(h,r->cf)) return;
2534  //if (TEST_OPT_PROT) PrintS("c");
2535  while (p!=NULL)
2536  {
2537#if 1
2538    d = n_ExactDiv(pGetCoeff(p),h,r->cf);
2539    p_SetCoeff(p,d,r);
2540#else
2541    STATISTIC(n_ExactDiv); nlInpExactDiv(pGetCoeff(p),h,r->cf); // no such function... ?
2542#endif
2543    pIter(p);
2544  }
2545  n_Delete(&h,r->cf);
2546}
2547#endif
2548
2549number p_InitContent(poly ph, const ring r)
2550// only for coefficients in Q and rational functions
2551#if 0
2552{
2553  assume(!TEST_OPT_CONTENTSB);
2554  assume(ph!=NULL);
2555  assume(pNext(ph)!=NULL);
2556  assume(rField_is_Q(r));
2557  if (pNext(pNext(ph))==NULL)
2558  {
2559    return n_GetNumerator(pGetCoeff(pNext(ph)),r->cf);
2560  }
2561  poly p=ph;
2562  number n1=n_GetNumerator(pGetCoeff(p),r->cf);
2563  pIter(p);
2564  number n2=n_GetNumerator(pGetCoeff(p),r->cf);
2565  pIter(p);
2566  number d;
2567  number t;
2568  loop
2569  {
2570    nlNormalize(pGetCoeff(p),r->cf);
2571    t=n_GetNumerator(pGetCoeff(p),r->cf);
2572    if (nlGreaterZero(t,r->cf))
2573      d=nlAdd(n1,t,r->cf);
2574    else
2575      d=nlSub(n1,t,r->cf);
2576    nlDelete(&t,r->cf);
2577    nlDelete(&n1,r->cf);
2578    n1=d;
2579    pIter(p);
2580    if (p==NULL) break;
2581    nlNormalize(pGetCoeff(p),r->cf);
2582    t=n_GetNumerator(pGetCoeff(p),r->cf);
2583    if (nlGreaterZero(t,r->cf))
2584      d=nlAdd(n2,t,r->cf);
2585    else
2586      d=nlSub(n2,t,r->cf);
2587    nlDelete(&t,r->cf);
2588    nlDelete(&n2,r->cf);
2589    n2=d;
2590    pIter(p);
2591    if (p==NULL) break;
2592  }
2593  d=nlGcd(n1,n2,r->cf);
2594  nlDelete(&n1,r->cf);
2595  nlDelete(&n2,r->cf);
2596  return d;
2597}
2598#else
2599{
2600  number d=pGetCoeff(ph);
2601  int s;
2602  int s2=-1;
2603  if(rField_is_Q(r))
2604  {
2605    if  (SR_HDL(d)&SR_INT) return d;
2606    s=mpz_size1(d->z);
2607  }
2608  else
2609    s=n_Size(d,r->cf);
2610  number d2=d;
2611  loop
2612  {
2613    pIter(ph);
2614    if(ph==NULL)
2615    {
2616      if (s2==-1) return n_Copy(d,r->cf);
2617      break;
2618    }
2619    if (rField_is_Q(r))
2620    {
2621      if (SR_HDL(pGetCoeff(ph))&SR_INT)
2622      {
2623        s2=s;
2624        d2=d;
2625        s=0;
2626        d=pGetCoeff(ph);
2627        if (s2==0) break;
2628      }
2629      else if (mpz_size1((pGetCoeff(ph)->z))<=s)
2630      {
2631        s2=s;
2632        d2=d;
2633        d=pGetCoeff(ph);
2634        s=mpz_size1(d->z);
2635      }
2636    }
2637    else
2638    {
2639      int ns=n_Size(pGetCoeff(ph),r->cf);
2640      if (ns<=3)
2641      {
2642        s2=s;
2643        d2=d;
2644        d=pGetCoeff(ph);
2645        s=ns;
2646        if (s2<=3) break;
2647      }
2648      else if (ns<s)
2649      {
2650        s2=s;
2651        d2=d;
2652        d=pGetCoeff(ph);
2653        s=ns;
2654      }
2655    }
2656  }
2657  return n_SubringGcd(d,d2,r->cf);
2658}
2659#endif
2660
2661//void pContent(poly ph)
2662//{
2663//  number h,d;
2664//  poly p;
2665//
2666//  p = ph;
2667//  if(pNext(p)==NULL)
2668//  {
2669//    pSetCoeff(p,nInit(1));
2670//  }
2671//  else
2672//  {
2673//#ifdef PDEBUG
2674//    if (!pTest(p)) return;
2675//#endif
2676//    nNormalize(pGetCoeff(p));
2677//    if(!nGreaterZero(pGetCoeff(ph)))
2678//    {
2679//      ph = pNeg(ph);
2680//      nNormalize(pGetCoeff(p));
2681//    }
2682//    h=pGetCoeff(p);
2683//    pIter(p);
2684//    while (p!=NULL)
2685//    {
2686//      nNormalize(pGetCoeff(p));
2687//      if (nGreater(h,pGetCoeff(p))) h=pGetCoeff(p);
2688//      pIter(p);
2689//    }
2690//    h=nCopy(h);
2691//    p=ph;
2692//    while (p!=NULL)
2693//    {
2694//      d=n_Gcd(h,pGetCoeff(p));
2695//      nDelete(&h);
2696//      h = d;
2697//      if(nIsOne(h))
2698//      {
2699//        break;
2700//      }
2701//      pIter(p);
2702//    }
2703//    p = ph;
2704//    //number tmp;
2705//    if(!nIsOne(h))
2706//    {
2707//      while (p!=NULL)
2708//      {
2709//        d = nExactDiv(pGetCoeff(p),h);
2710//        pSetCoeff(p,d);
2711//        pIter(p);
2712//      }
2713//    }
2714//    nDelete(&h);
2715//    if ( (nGetChar() == 1) || (nGetChar() < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
2716//    {
2717//      pTest(ph);
2718//      singclap_divide_content(ph);
2719//      pTest(ph);
2720//    }
2721//  }
2722//}
2723#if 0
2724void p_Content(poly ph, const ring r)
2725{
2726  number h,d;
2727  poly p;
2728
2729  if(pNext(ph)==NULL)
2730  {
2731    p_SetCoeff(ph,n_Init(1,r->cf),r);
2732  }
2733  else
2734  {
2735    n_Normalize(pGetCoeff(ph),r->cf);
2736    if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2737    h=n_Copy(pGetCoeff(ph),r->cf);
2738    p = pNext(ph);
2739    while (p!=NULL)
2740    {
2741      n_Normalize(pGetCoeff(p),r->cf);
2742      d=n_Gcd(h,pGetCoeff(p),r->cf);
2743      n_Delete(&h,r->cf);
2744      h = d;
2745      if(n_IsOne(h,r->cf))
2746      {
2747        break;
2748      }
2749      pIter(p);
2750    }
2751    p = ph;
2752    //number tmp;
2753    if(!n_IsOne(h,r->cf))
2754    {
2755      while (p!=NULL)
2756      {
2757        //d = nDiv(pGetCoeff(p),h);
2758        //tmp = nExactDiv(pGetCoeff(p),h);
2759        //if (!nEqual(d,tmp))
2760        //{
2761        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
2762        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
2763        //  nWrite(tmp);Print(StringEndS("\n")); // NOTE/TODO: use StringAppendS("\n"); omFree(s);
2764        //}
2765        //nDelete(&tmp);
2766        d = n_ExactDiv(pGetCoeff(p),h,r->cf);
2767        p_SetCoeff(p,d,r->cf);
2768        pIter(p);
2769      }
2770    }
2771    n_Delete(&h,r->cf);
2772    //if ( (n_GetChar(r) == 1) || (n_GetChar(r) < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
2773    //{
2774    //  singclap_divide_content(ph);
2775    //  if(!n_GreaterZero(pGetCoeff(ph),r)) ph = p_Neg(ph,r);
2776    //}
2777  }
2778}
2779#endif
2780/* ---------------------------------------------------------------------------*/
2781/* cleardenom suff                                                           */
2782poly p_Cleardenom(poly p, const ring r)
2783{
2784  if( p == NULL )
2785    return NULL;
2786
2787  assume( r != NULL ); assume( r->cf != NULL ); const coeffs C = r->cf;
2788
2789#if CLEARENUMERATORS
2790  if( 0 )
2791  {
2792    CPolyCoeffsEnumerator itr(p);
2793    n_ClearDenominators(itr, C);
2794    n_ClearContent(itr, C); // divide out the content
2795    p_Test(p, r); n_Test(pGetCoeff(p), C);
2796    assume(n_GreaterZero(pGetCoeff(p), C)); // ??
2797//    if(!n_GreaterZero(pGetCoeff(p),C)) p = p_Neg(p,r);
2798    return p;
2799  }
2800#endif
2801
2802  number d, h;
2803
2804  if (rField_is_Ring(r))
2805  {
2806    p_ContentForGB(p,r);
2807    if(!n_GreaterZero(pGetCoeff(p),C)) p = p_Neg(p,r);
2808    return p;
2809  }
2810
2811  if (rField_is_Zp(r) && TEST_OPT_INTSTRATEGY)
2812  {
2813    if(!n_GreaterZero(pGetCoeff(p),C)) p = p_Neg(p,r);
2814    return p;
2815  }
2816
2817  assume(p != NULL);
2818
2819  if(pNext(p)==NULL)
2820  {
2821    if (!TEST_OPT_CONTENTSB
2822    && !rField_is_Ring(r))
2823      p_SetCoeff(p,n_Init(1,r->cf),r);
2824    else if(!n_GreaterZero(pGetCoeff(p),C))
2825      p = p_Neg(p,r);
2826    return p;
2827  }
2828
2829  assume(pNext(p)!=NULL);
2830  poly start=p;
2831
2832#if 0 && CLEARENUMERATORS
2833//CF: does not seem to work that well..
2834
2835  if( nCoeff_is_Q(C) || nCoeff_is_Q_a(C) )
2836  {
2837    CPolyCoeffsEnumerator itr(p);
2838    n_ClearDenominators(itr, C);
2839    n_ClearContent(itr, C); // divide out the content
2840    p_Test(p, r); n_Test(pGetCoeff(p), C);
2841    assume(n_GreaterZero(pGetCoeff(p), C)); // ??
2842//    if(!n_GreaterZero(pGetCoeff(p),C)) p = p_Neg(p,r);
2843    return start;
2844  }
2845#endif
2846
2847  if(1)
2848  {
2849    // get lcm of all denominators ----------------------------------
2850    h = n_Init(1,r->cf);
2851    while (p!=NULL)
2852    {
2853      n_Normalize(pGetCoeff(p),r->cf);
2854      d=n_NormalizeHelper(h,pGetCoeff(p),r->cf);
2855      n_Delete(&h,r->cf);
2856      h=d;
2857      pIter(p);
2858    }
2859    /* h now contains the 1/lcm of all denominators */
2860    if(!n_IsOne(h,r->cf))
2861    {
2862      // multiply by the lcm of all denominators
2863      p = start;
2864      while (p!=NULL)
2865      {
2866        d=n_Mult(h,pGetCoeff(p),r->cf);
2867        n_Normalize(d,r->cf);
2868        p_SetCoeff(p,d,r);
2869        pIter(p);
2870      }
2871    }
2872    n_Delete(&h,r->cf);
2873    p=start;
2874
2875    p_ContentForGB(p,r);
2876#ifdef HAVE_RATGRING
2877    if (rIsRatGRing(r))
2878    {
2879      /* quick unit detection in the rational case is done in gr_nc_bba */
2880      p_ContentRat(p, r);
2881      start=p;
2882    }
2883#endif
2884  }
2885
2886  if(!n_GreaterZero(pGetCoeff(p),C)) p = p_Neg(p,r);
2887
2888  return start;
2889}
2890
2891void p_Cleardenom_n(poly ph,const ring r,number &c)
2892{
2893  const coeffs C = r->cf;
2894  number d, h;
2895
2896  assume( ph != NULL );
2897
2898  poly p = ph;
2899
2900#if CLEARENUMERATORS
2901  if( 0 )
2902  {
2903    CPolyCoeffsEnumerator itr(ph);
2904
2905    n_ClearDenominators(itr, d, C); // multiply with common denom. d
2906    n_ClearContent(itr, h, C); // divide by the content h
2907
2908    c = n_Div(d, h, C); // d/h
2909
2910    n_Delete(&d, C);
2911    n_Delete(&h, C);
2912
2913    n_Test(c, C);
2914
2915    p_Test(ph, r); n_Test(pGetCoeff(ph), C);
2916    assume(n_GreaterZero(pGetCoeff(ph), C)); // ??
2917/*
2918    if(!n_GreaterZero(pGetCoeff(ph),C))
2919    {
2920      ph = p_Neg(ph,r);
2921      c = n_InpNeg(c, C);
2922    }
2923*/
2924    return;
2925  }
2926#endif
2927
2928
2929  if( pNext(p) == NULL )
2930  {
2931    if(!TEST_OPT_CONTENTSB)
2932    {
2933      c=n_Invers(pGetCoeff(p), C);
2934      p_SetCoeff(p, n_Init(1, C), r);
2935    }
2936    else
2937    {
2938      c=n_Init(1,C);
2939    }
2940
2941    if(!n_GreaterZero(pGetCoeff(ph),C))
2942    {
2943      ph = p_Neg(ph,r);
2944      c = n_InpNeg(c, C);
2945    }
2946
2947    return;
2948  }
2949  if (TEST_OPT_CONTENTSB) { c=n_Init(1,C); return; }
2950
2951  assume( pNext(p) != NULL );
2952
2953#if CLEARENUMERATORS
2954  if( nCoeff_is_Q(C) || nCoeff_is_Q_a(C) )
2955  {
2956    CPolyCoeffsEnumerator itr(ph);
2957
2958    n_ClearDenominators(itr, d, C); // multiply with common denom. d
2959    n_ClearContent(itr, h, C); // divide by the content h
2960
2961    c = n_Div(d, h, C); // d/h
2962
2963    n_Delete(&d, C);
2964    n_Delete(&h, C);
2965
2966    n_Test(c, C);
2967
2968    p_Test(ph, r); n_Test(pGetCoeff(ph), C);
2969    assume(n_GreaterZero(pGetCoeff(ph), C)); // ??
2970/*
2971    if(!n_GreaterZero(pGetCoeff(ph),C))
2972    {
2973      ph = p_Neg(ph,r);
2974      c = n_InpNeg(c, C);
2975    }
2976*/
2977    return;
2978  }
2979#endif
2980
2981
2982
2983
2984  if(1)
2985  {
2986    h = n_Init(1,r->cf);
2987    while (p!=NULL)
2988    {
2989      n_Normalize(pGetCoeff(p),r->cf);
2990      d=n_NormalizeHelper(h,pGetCoeff(p),r->cf);
2991      n_Delete(&h,r->cf);
2992      h=d;
2993      pIter(p);
2994    }
2995    c=h;
2996    /* contains the 1/lcm of all denominators */
2997    if(!n_IsOne(h,r->cf))
2998    {
2999      p = ph;
3000      while (p!=NULL)
3001      {
3002        /* should be: // NOTE: don't use ->coef!!!!
3003        * number hh;
3004        * nGetDenom(p->coef,&hh);
3005        * nMult(&h,&hh,&d);
3006        * nNormalize(d);
3007        * nDelete(&hh);
3008        * nMult(d,p->coef,&hh);
3009        * nDelete(&d);
3010        * nDelete(&(p->coef));
3011        * p->coef =hh;
3012        */
3013        d=n_Mult(h,pGetCoeff(p),r->cf);
3014        n_Normalize(d,r->cf);
3015        p_SetCoeff(p,d,r);
3016        pIter(p);
3017      }
3018      if (rField_is_Q_a(r))
3019      {
3020        loop
3021        {
3022          h = n_Init(1,r->cf);
3023          p=ph;
3024          while (p!=NULL)
3025          {
3026            d=n_NormalizeHelper(h,pGetCoeff(p),r->cf);
3027            n_Delete(&h,r->cf);
3028            h=d;
3029            pIter(p);
3030          }
3031          /* contains the 1/lcm of all denominators */
3032          if(!n_IsOne(h,r->cf))
3033          {
3034            p = ph;
3035            while (p!=NULL)
3036            {
3037              /* should be: // NOTE: don't use ->coef!!!!
3038              * number hh;
3039              * nGetDenom(p->coef,&hh);
3040              * nMult(&h,&hh,&d);
3041              * nNormalize(d);
3042              * nDelete(&hh);
3043              * nMult(d,p->coef,&hh);
3044              * nDelete(&d);
3045              * nDelete(&(p->coef));
3046              * p->coef =hh;
3047              */
3048              d=n_Mult(h,pGetCoeff(p),r->cf);
3049              n_Normalize(d,r->cf);
3050              p_SetCoeff(p,d,r);
3051              pIter(p);
3052            }
3053            number t=n_Mult(c,h,r->cf);
3054            n_Delete(&c,r->cf);
3055            c=t;
3056          }
3057          else
3058          {
3059            break;
3060          }
3061          n_Delete(&h,r->cf);
3062        }
3063      }
3064    }
3065  }
3066
3067  if(!n_GreaterZero(pGetCoeff(ph),C))
3068  {
3069    ph = p_Neg(ph,r);
3070    c = n_InpNeg(c, C);
3071  }
3072
3073}
3074
3075  // normalization: for poly over Q: make poly primitive, integral
3076  //                              Qa make poly integral with leading
3077  //                                  coefficient minimal in N
3078  //                            Q(t) make poly primitive, integral
3079
3080void p_ProjectiveUnique(poly ph, const ring r)
3081{
3082  if( ph == NULL )
3083    return;
3084
3085  assume( r != NULL ); assume( r->cf != NULL ); const coeffs C = r->cf;
3086
3087  number h;
3088  poly p;
3089
3090  if (rField_is_Ring(r))
3091  {
3092    p_ContentForGB(ph,r);
3093    if(!n_GreaterZero(pGetCoeff(ph),C)) ph = p_Neg(ph,r);
3094        assume( n_GreaterZero(pGetCoeff(ph),C) );
3095    return;
3096  }
3097
3098  if (rField_is_Zp(r) && TEST_OPT_INTSTRATEGY)
3099  {
3100    assume( n_GreaterZero(pGetCoeff(ph),C) );
3101    if(!n_GreaterZero(pGetCoeff(ph),C)) ph = p_Neg(ph,r);
3102    return;
3103  }
3104  p = ph;
3105
3106  assume(p != NULL);
3107
3108  if(pNext(p)==NULL) // a monomial
3109  {
3110    p_SetCoeff(p, n_Init(1, C), r);
3111    return;
3112  }
3113
3114  assume(pNext(p)!=NULL);
3115
3116  if(!rField_is_Q(r) && !nCoeff_is_transExt(C))
3117  {
3118    h = p_GetCoeff(p, C);
3119    number hInv = n_Invers(h, C);
3120    pIter(p);
3121    while (p!=NULL)
3122    {
3123      p_SetCoeff(p, n_Mult(p_GetCoeff(p, C), hInv, C), r);
3124      pIter(p);
3125    }
3126    n_Delete(&hInv, C);
3127    p = ph;
3128    p_SetCoeff(p, n_Init(1, C), r);
3129  }
3130
3131  p_Cleardenom(ph, r); //removes also Content
3132
3133
3134    /* normalize ph over a transcendental extension s.t.
3135       lead (ph) is > 0 if extRing->cf == Q
3136       or lead (ph) is monic if extRing->cf == Zp*/
3137  if (nCoeff_is_transExt(C))
3138  {
3139    p= ph;
3140    h= p_GetCoeff (p, C);
3141    fraction f = (fraction) h;
3142    number n=p_GetCoeff (NUM (f),C->extRing->cf);
3143    if (rField_is_Q (C->extRing))
3144    {
3145      if (!n_GreaterZero(n,C->extRing->cf))
3146      {
3147        p=p_Neg (p,r);
3148      }
3149    }
3150    else if (rField_is_Zp(C->extRing))
3151    {
3152      if (!n_IsOne (n, C->extRing->cf))
3153      {
3154        n=n_Invers (n,C->extRing->cf);
3155        nMapFunc nMap;
3156        nMap= n_SetMap (C->extRing->cf, C);
3157        number ninv= nMap (n,C->extRing->cf, C);
3158        p=__p_Mult_nn (p, ninv, r);
3159        n_Delete (&ninv, C);
3160        n_Delete (&n, C->extRing->cf);
3161      }
3162    }
3163    p= ph;
3164  }
3165
3166  return;
3167}
3168
3169#if 0   /*unused*/
3170number p_GetAllDenom(poly ph, const ring r)
3171{
3172  number d=n_Init(1,r->cf);
3173  poly p = ph;
3174
3175  while (p!=NULL)
3176  {
3177    number h=n_GetDenom(pGetCoeff(p),r->cf);
3178    if (!n_IsOne(h,r->cf))
3179    {
3180      number dd=n_Mult(d,h,r->cf);
3181      n_Delete(&d,r->cf);
3182      d=dd;
3183    }
3184    n_Delete(&h,r->cf);
3185    pIter(p);
3186  }
3187  return d;
3188}
3189#endif
3190
3191int p_Size(poly p, const ring r)
3192{
3193  int count = 0;
3194  if (r->cf->has_simple_Alloc)
3195    return pLength(p);
3196  while ( p != NULL )
3197  {
3198    count+= n_Size( pGetCoeff( p ), r->cf );
3199    pIter( p );
3200  }
3201  return count;
3202}
3203
3204/*2
3205*make p homogeneous by multiplying the monomials by powers of x_varnum
3206*assume: deg(var(varnum))==1
3207*/
3208poly p_Homogen (poly p, int varnum, const ring r)
3209{
3210  pFDegProc deg;
3211  if (r->pLexOrder && (r->order[0]==ringorder_lp))
3212    deg=p_Totaldegree;
3213  else
3214    deg=r->pFDeg;
3215
3216  poly q=NULL, qn;
3217  int  o,ii;
3218  sBucket_pt bp;
3219
3220  if (p!=NULL)
3221  {
3222    if ((varnum < 1) || (varnum > rVar(r)))
3223    {
3224      return NULL;
3225    }
3226    o=deg(p,r);
3227    q=pNext(p);
3228    while (q != NULL)
3229    {
3230      ii=deg(q,r);
3231      if (ii>o) o=ii;
3232      pIter(q);
3233    }
3234    q = p_Copy(p,r);
3235    bp = sBucketCreate(r);
3236    while (q != NULL)
3237    {
3238      ii = o-deg(q,r);
3239      if (ii!=0)
3240      {
3241        p_AddExp(q,varnum, (long)ii,r);
3242        p_Setm(q,r);
3243      }
3244      qn = pNext(q);
3245      pNext(q) = NULL;
3246      sBucket_Add_m(bp, q);
3247      q = qn;
3248    }
3249    sBucketDestroyAdd(bp, &q, &ii);
3250  }
3251  return q;
3252}
3253
3254/*2
3255*tests if p is homogeneous with respect to the actual weigths
3256*/
3257BOOLEAN p_IsHomogeneous (poly p, const ring r)
3258{
3259  poly qp=p;
3260  int o;
3261
3262  if ((p == NULL) || (pNext(p) == NULL)) return TRUE;
3263  pFDegProc d;
3264  if (r->pLexOrder && (r->order[0]==ringorder_lp))
3265    d=p_Totaldegree;
3266  else
3267    d=r->pFDeg;
3268  o = d(p,r);
3269  do
3270  {
3271    if (d(qp,r) != o) return FALSE;
3272    pIter(qp);
3273  }
3274  while (qp != NULL);
3275  return TRUE;
3276}
3277
3278/*----------utilities for syzygies--------------*/
3279BOOLEAN   p_VectorHasUnitB(poly p, int * k, const ring r)
3280{
3281  poly q=p,qq;
3282  int i;
3283
3284  while (q!=NULL)
3285  {
3286    if (p_LmIsConstantComp(q,r))
3287    {
3288      i = __p_GetComp(q,r);
3289      qq = p;
3290      while ((qq != q) && (__p_GetComp(qq,r) != i)) pIter(qq);
3291      if (qq == q)
3292      {
3293        *k = i;
3294        return TRUE;
3295      }
3296    }
3297    pIter(q);
3298  }
3299  return FALSE;
3300}
3301
3302void   p_VectorHasUnit(poly p, int * k, int * len, const ring r)
3303{
3304  poly q=p,qq;
3305  int i,j=0;
3306
3307  *len = 0;
3308  while (q!=NULL)
3309  {
3310    if (p_LmIsConstantComp(q,r))
3311    {
3312      i = __p_GetComp(q,r);
3313      qq = p;
3314      while ((qq != q) && (__p_GetComp(qq,r) != i)) pIter(qq);
3315      if (qq == q)
3316      {
3317       j = 0;
3318       while (qq!=NULL)
3319       {
3320         if (__p_GetComp(qq,r)==i) j++;
3321        pIter(qq);
3322       }
3323       if ((*len == 0) || (j<*len))
3324       {
3325         *len = j;
3326         *k = i;
3327       }
3328      }
3329    }
3330    pIter(q);
3331  }
3332}
3333
3334poly p_TakeOutComp1(poly * p, int k, const ring r)
3335{
3336  poly q = *p;
3337
3338  if (q==NULL) return NULL;
3339
3340  poly qq=NULL,result = NULL;
3341
3342  if (__p_GetComp(q,r)==k)
3343  {
3344    result = q; /* *p */
3345    while ((q!=NULL) && (__p_GetComp(q,r)==k))
3346    {
3347      p_SetComp(q,0,r);
3348      p_SetmComp(q,r);
3349      qq = q;
3350      pIter(q);
3351    }
3352    *p = q;
3353    pNext(qq) = NULL;
3354  }
3355  if (q==NULL) return result;
3356//  if (pGetComp(q) > k) pGetComp(q)--;
3357  while (pNext(q)!=NULL)
3358  {
3359    if (__p_GetComp(pNext(q),r)==k)
3360    {
3361      if (result==NULL)
3362      {
3363        result = pNext(q);
3364        qq = result;
3365      }
3366      else
3367      {
3368        pNext(qq) = pNext(q);
3369        pIter(qq);
3370      }
3371      pNext(q) = pNext(pNext(q));
3372      pNext(qq) =NULL;
3373      p_SetComp(qq,0,r);
3374      p_SetmComp(qq,r);
3375    }
3376    else
3377    {
3378      pIter(q);
3379//      if (pGetComp(q) > k) pGetComp(q)--;
3380    }
3381  }
3382  return result;
3383}
3384
3385poly p_TakeOutComp(poly * p, int k, const ring r)
3386{
3387  poly q = *p,qq=NULL,result = NULL;
3388
3389  if (q==NULL) return NULL;
3390  BOOLEAN use_setmcomp=rOrd_SetCompRequiresSetm(r);
3391  if (__p_GetComp(q,r)==k)
3392  {
3393    result = q;
3394    do
3395    {
3396      p_SetComp(q,0,r);
3397      if (use_setmcomp) p_SetmComp(q,r);
3398      qq = q;
3399      pIter(q);
3400    }
3401    while ((q!=NULL) && (__p_GetComp(q,r)==k));
3402    *p = q;
3403    pNext(qq) = NULL;
3404  }
3405  if (q==NULL) return result;
3406  if (__p_GetComp(q,r) > k)
3407  {
3408    p_SubComp(q,1,r);
3409    if (use_setmcomp) p_SetmComp(q,r);
3410  }
3411  poly pNext_q;
3412  while ((pNext_q=pNext(q))!=NULL)
3413  {
3414    if (__p_GetComp(pNext_q,r)==k)
3415    {
3416      if (result==NULL)
3417      {
3418        result = pNext_q;
3419        qq = result;
3420      }
3421      else
3422      {
3423        pNext(qq) = pNext_q;
3424        pIter(qq);
3425      }
3426      pNext(q) = pNext(pNext_q);
3427      pNext(qq) =NULL;
3428      p_SetComp(qq,0,r);
3429      if (use_setmcomp) p_SetmComp(qq,r);
3430    }
3431    else
3432    {
3433      /*pIter(q);*/ q=pNext_q;
3434      if (__p_GetComp(q,r) > k)
3435      {
3436        p_SubComp(q,1,r);
3437        if (use_setmcomp) p_SetmComp(q,r);
3438      }
3439    }
3440  }
3441  return result;
3442}
3443
3444// Splits *p into two polys: *q which consists of all monoms with
3445// component == comp and *p of all other monoms *lq == pLength(*q)
3446void p_TakeOutComp(poly *r_p, long comp, poly *r_q, int *lq, const ring r)
3447{
3448  spolyrec pp, qq;
3449  poly p, q, p_prev;
3450  int l = 0;
3451
3452#ifdef HAVE_ASSUME
3453  int lp = pLength(*r_p);
3454#endif
3455
3456  pNext(&pp) = *r_p;
3457  p = *r_p;
3458  p_prev = &pp;
3459  q = &qq;
3460
3461  while(p != NULL)
3462  {
3463    while (__p_GetComp(p,r) == comp)
3464    {
3465      pNext(q) = p;
3466      pIter(q);
3467      p_SetComp(p, 0,r);
3468      p_SetmComp(p,r);
3469      pIter(p);
3470      l++;
3471      if (p == NULL)
3472      {
3473        pNext(p_prev) = NULL;
3474        goto Finish;
3475      }
3476    }
3477    pNext(p_prev) = p;
3478    p_prev = p;
3479    pIter(p);
3480  }
3481
3482  Finish:
3483  pNext(q) = NULL;
3484  *r_p = pNext(&pp);
3485  *r_q = pNext(&qq);
3486  *lq = l;
3487#ifdef HAVE_ASSUME
3488  assume(pLength(*r_p) + pLength(*r_q) == lp);
3489#endif
3490  p_Test(*r_p,r);
3491  p_Test(*r_q,r);
3492}
3493
3494void p_DeleteComp(poly * p,int k, const ring r)
3495{
3496  poly q;
3497
3498  while ((*p!=NULL) && (__p_GetComp(*p,r)==k)) p_LmDelete(p,r);
3499  if (*p==NULL) return;
3500  q = *p;
3501  if (__p_GetComp(q,r)>k)
3502  {
3503    p_SubComp(q,1,r);
3504    p_SetmComp(q,r);
3505  }
3506  while (pNext(q)!=NULL)
3507  {
3508    if (__p_GetComp(pNext(q),r)==k)
3509      p_LmDelete(&(pNext(q)),r);
3510    else
3511    {
3512      pIter(q);
3513      if (__p_GetComp(q,r)>k)
3514      {
3515        p_SubComp(q,1,r);
3516        p_SetmComp(q,r);
3517      }
3518    }
3519  }
3520}
3521
3522/*2
3523* convert a vector to a set of polys,
3524* allocates the polyset, (entries 0..(*len)-1)
3525* the vector will not be changed
3526*/
3527void  p_Vec2Polys(poly v, poly* *p, int *len, const ring r)
3528{
3529  poly h;
3530  int k;
3531
3532  *len=p_MaxComp(v,r);
3533  if (*len==0) *len=1;
3534  *p=(poly*)omAlloc0((*len)*sizeof(poly));
3535  while (v!=NULL)
3536  {
3537    h=p_Head(v,r);
3538    k=__p_GetComp(h,r);
3539    p_SetComp(h,0,r);
3540    (*p)[k-1]=p_Add_q((*p)[k-1],h,r);
3541    pIter(v);
3542  }
3543}
3544
3545//
3546// resets the pFDeg and pLDeg: if pLDeg is not given, it is
3547// set to currRing->pLDegOrig, i.e. to the respective LDegProc which
3548// only uses pFDeg (and not p_Deg, or pTotalDegree, etc)
3549void pSetDegProcs(ring r, pFDegProc new_FDeg, pLDegProc new_lDeg)
3550{
3551  assume(new_FDeg != NULL);
3552  r->pFDeg = new_FDeg;
3553
3554  if (new_lDeg == NULL)
3555    new_lDeg = r->pLDegOrig;
3556
3557  r->pLDeg = new_lDeg;
3558}
3559
3560// restores pFDeg and pLDeg:
3561void pRestoreDegProcs(ring r, pFDegProc old_FDeg, pLDegProc old_lDeg)
3562{
3563  assume(old_FDeg != NULL && old_lDeg != NULL);
3564  r->pFDeg = old_FDeg;
3565  r->pLDeg = old_lDeg;
3566}
3567
3568/*-------- several access procedures to monomials -------------------- */
3569/*
3570* the module weights for std
3571*/
3572static pFDegProc pOldFDeg;
3573static pLDegProc pOldLDeg;
3574static BOOLEAN pOldLexOrder;
3575
3576static long pModDeg(poly p, ring r)
3577{
3578  long d=pOldFDeg(p, r);
3579  int c=__p_GetComp(p, r);
3580  if ((c>0) && ((r->pModW)->range(c-1))) d+= (*(r->pModW))[c-1];
3581  return d;
3582  //return pOldFDeg(p, r)+(*pModW)[p_GetComp(p, r)-1];
3583}
3584
3585void p_SetModDeg(intvec *w, ring r)
3586{
3587  if (w!=NULL)
3588  {
3589    r->pModW = w;
3590    pOldFDeg = r->pFDeg;
3591    pOldLDeg = r->pLDeg;
3592    pOldLexOrder = r->pLexOrder;
3593    pSetDegProcs(r,pModDeg);
3594    r->pLexOrder = TRUE;
3595  }
3596  else
3597  {
3598    r->pModW = NULL;
3599    pRestoreDegProcs(r,pOldFDeg, pOldLDeg);
3600    r->pLexOrder = pOldLexOrder;
3601  }
3602}
3603
3604/*2
3605* handle memory request for sets of polynomials (ideals)
3606* l is the length of *p, increment is the difference (may be negative)
3607*/
3608void pEnlargeSet(poly* *p, int l, int increment)
3609{
3610  poly* h;
3611
3612  if (*p==NULL)
3613  {
3614    if (increment==0) return;
3615    h=(poly*)omAlloc0(increment*sizeof(poly));
3616  }
3617  else
3618  {
3619    h=(poly*)omReallocSize((poly*)*p,l*sizeof(poly),(l+increment)*sizeof(poly));
3620    if (increment>0)
3621    {
3622      //for (i=l; i<l+increment; i++)
3623      //  h[i]=NULL;
3624      memset(&(h[l]),0,increment*sizeof(poly));
3625    }
3626  }
3627  *p=h;
3628}
3629
3630/*2
3631*divides p1 by its leading coefficient
3632*/
3633void p_Norm(poly p1, const ring r)
3634{
3635  if (rField_is_Ring(r))
3636  {
3637    if (!n_IsUnit(pGetCoeff(p1), r->cf)) return;
3638    // Werror("p_Norm not possible in the case of coefficient rings.");
3639  }
3640  else if (p1!=NULL)
3641  {
3642    if (pNext(p1)==NULL)
3643    {
3644      p_SetCoeff(p1,n_Init(1,r->cf),r);
3645      return;
3646    }
3647    poly h;
3648    if (!n_IsOne(pGetCoeff(p1),r->cf))
3649    {
3650      number k, c;
3651      n_Normalize(pGetCoeff(p1),r->cf);
3652      k = pGetCoeff(p1);
3653      c = n_Init(1,r->cf);
3654      pSetCoeff0(p1,c);
3655      h = pNext(p1);
3656      while (h!=NULL)
3657      {
3658        c=n_Div(pGetCoeff(h),k,r->cf);
3659        // no need to normalize: Z/p, R
3660        // normalize already in nDiv: Q_a, Z/p_a
3661        // remains: Q
3662        if (rField_is_Q(r) && (!n_IsOne(c,r->cf))) n_Normalize(c,r->cf);
3663        p_SetCoeff(h,c,r);
3664        pIter(h);
3665      }
3666      n_Delete(&k,r->cf);
3667    }
3668    else
3669    {
3670      //if (r->cf->cfNormalize != nDummy2) //TODO: OPTIMIZE
3671      {
3672        h = pNext(p1);
3673        while (h!=NULL)
3674        {
3675          n_Normalize(pGetCoeff(h),r->cf);
3676          pIter(h);
3677        }
3678      }
3679    }
3680  }
3681}
3682
3683/*2
3684*normalize all coefficients
3685*/
3686void p_Normalize(poly p,const ring r)
3687{
3688  if (rField_has_simple_inverse(r)) return; /* Z/p, GF(p,n), R, long R/C */
3689  while (p!=NULL)
3690  {
3691    // no test befor n_Normalize: n_Normalize should fix problems
3692    n_Normalize(pGetCoeff(p),r->cf);
3693    pIter(p);
3694  }
3695}
3696
3697// splits p into polys with Exp(n) == 0 and Exp(n) != 0
3698// Poly with Exp(n) != 0 is reversed
3699static void p_SplitAndReversePoly(poly p, int n, poly *non_zero, poly *zero, const ring r)
3700{
3701  if (p == NULL)
3702  {
3703    *non_zero = NULL;
3704    *zero = NULL;
3705    return;
3706  }
3707  spolyrec sz;
3708  poly z, n_z, next;
3709  z = &sz;
3710  n_z = NULL;
3711
3712  while(p != NULL)
3713  {
3714    next = pNext(p);
3715    if (p_GetExp(p, n,r) == 0)
3716    {
3717      pNext(z) = p;
3718      pIter(z);
3719    }
3720    else
3721    {
3722      pNext(p) = n_z;
3723      n_z = p;
3724    }
3725    p = next;
3726  }
3727  pNext(z) = NULL;
3728  *zero = pNext(&sz);
3729  *non_zero = n_z;
3730}
3731/*3
3732* substitute the n-th variable by 1 in p
3733* destroy p
3734*/
3735static poly p_Subst1 (poly p,int n, const ring r)
3736{
3737  poly qq=NULL, result = NULL;
3738  poly zero=NULL, non_zero=NULL;
3739
3740  // reverse, so that add is likely to be linear
3741  p_SplitAndReversePoly(p, n, &non_zero, &zero,r);
3742
3743  while (non_zero != NULL)
3744  {
3745    assume(p_GetExp(non_zero, n,r) != 0);
3746    qq = non_zero;
3747    pIter(non_zero);
3748    qq->next = NULL;
3749    p_SetExp(qq,n,0,r);
3750    p_Setm(qq,r);
3751    result = p_Add_q(result,qq,r);
3752  }
3753  p = p_Add_q(result, zero,r);
3754  p_Test(p,r);
3755  return p;
3756}
3757
3758/*3
3759* substitute the n-th variable by number e in p
3760* destroy p
3761*/
3762static poly p_Subst2 (poly p,int n, number e, const ring r)
3763{
3764  assume( ! n_IsZero(e,r->cf) );
3765  poly qq,result = NULL;
3766  number nn, nm;
3767  poly zero, non_zero;
3768
3769  // reverse, so that add is likely to be linear
3770  p_SplitAndReversePoly(p, n, &non_zero, &zero,r);
3771
3772  while (non_zero != NULL)
3773  {
3774    assume(p_GetExp(non_zero, n, r) != 0);
3775    qq = non_zero;
3776    pIter(non_zero);
3777    qq->next = NULL;
3778    n_Power(e, p_GetExp(qq, n, r), &nn,r->cf);
3779    nm = n_Mult(nn, pGetCoeff(qq),r->cf);
3780#ifdef HAVE_RINGS
3781    if (n_IsZero(nm,r->cf))
3782    {
3783      p_LmFree(&qq,r);
3784      n_Delete(&nm,r->cf);
3785    }
3786    else
3787#endif
3788    {
3789      p_SetCoeff(qq, nm,r);
3790      p_SetExp(qq, n, 0,r);
3791      p_Setm(qq,r);
3792      result = p_Add_q(result,qq,r);
3793    }
3794    n_Delete(&nn,r->cf);
3795  }
3796  p = p_Add_q(result, zero,r);
3797  p_Test(p,r);
3798  return p;
3799}
3800
3801
3802/* delete monoms whose n-th exponent is different from zero */
3803static poly p_Subst0(poly p, int n, const ring r)
3804{
3805  spolyrec res;
3806  poly h = &res;
3807  pNext(h) = p;
3808
3809  while (pNext(h)!=NULL)
3810  {
3811    if (p_GetExp(pNext(h),n,r)!=0)
3812    {
3813      p_LmDelete(&pNext(h),r);
3814    }
3815    else
3816    {
3817      pIter(h);
3818    }
3819  }
3820  p_Test(pNext(&res),r);
3821  return pNext(&res);
3822}
3823
3824/*2
3825* substitute the n-th variable by e in p
3826* destroy p
3827*/
3828poly p_Subst(poly p, int n, poly e, const ring r)
3829{
3830  if (e == NULL) return p_Subst0(p, n,r);
3831
3832  if (p_IsConstant(e,r))
3833  {
3834    if (n_IsOne(pGetCoeff(e),r->cf)) return p_Subst1(p,n,r);
3835    else return p_Subst2(p, n, pGetCoeff(e),r);
3836  }
3837
3838#ifdef HAVE_PLURAL
3839  if (rIsPluralRing(r))
3840  {
3841    return nc_pSubst(p,n,e,r);
3842  }
3843#endif
3844
3845  int exponent,i;
3846  poly h, res, m;
3847  int *me,*ee;
3848  number nu,nu1;
3849
3850  me=(int *)omAlloc((rVar(r)+1)*sizeof(int));
3851  ee=(int *)omAlloc((rVar(r)+1)*sizeof(int));
3852  if (e!=NULL) p_GetExpV(e,ee,r);
3853  res=NULL;
3854  h=p;
3855  while (h!=NULL)
3856  {
3857    if ((e!=NULL) || (p_GetExp(h,n,r)==0))
3858    {
3859      m=p_Head(h,r);
3860      p_GetExpV(m,me,r);
3861      exponent=me[n];
3862      me[n]=0;
3863      for(i=rVar(r);i>0;i--)
3864        me[i]+=exponent*ee[i];
3865      p_SetExpV(m,me,r);
3866      if (e!=NULL)
3867      {
3868        n_Power(pGetCoeff(e),exponent,&nu,r->cf);
3869        nu1=n_Mult(pGetCoeff(m),nu,r->cf);
3870        n_Delete(&nu,r->cf);
3871        p_SetCoeff(m,nu1,r);
3872      }
3873      res=p_Add_q(res,m,r);
3874    }
3875    p_LmDelete(&h,r);
3876  }
3877  omFreeSize((ADDRESS)me,(rVar(r)+1)*sizeof(int));
3878  omFreeSize((ADDRESS)ee,(rVar(r)+1)*sizeof(int));
3879  return res;
3880}
3881
3882/*2
3883 * returns a re-ordered convertion of a number as a polynomial,
3884 * with permutation of parameters
3885 * NOTE: this only works for Frank's alg. & trans. fields
3886 */
3887poly n_PermNumber(const number z, const int *par_perm, const int , const ring src, const ring dst)
3888{
3889#if 0
3890  PrintS("\nSource Ring: \n");
3891  rWrite(src);
3892
3893  if(0)
3894  {
3895    number zz = n_Copy(z, src->cf);
3896    PrintS("z: "); n_Write(zz, src);
3897    n_Delete(&zz, src->cf);
3898  }
3899
3900  PrintS("\nDestination Ring: \n");
3901  rWrite(dst);
3902
3903  /*Print("\nOldPar: %d\n", OldPar);
3904  for( int i = 1; i <= OldPar; i++ )
3905  {
3906    Print("par(%d) -> par/var (%d)\n", i, par_perm[i-1]);
3907  }*/
3908#endif
3909  if( z == NULL )
3910     return NULL;
3911
3912  const coeffs srcCf = src->cf;
3913  assume( srcCf != NULL );
3914
3915  assume( !nCoeff_is_GF(srcCf) );
3916  assume( src->cf->extRing!=NULL );
3917
3918  poly zz = NULL;
3919
3920  const ring srcExtRing = srcCf->extRing;
3921  assume( srcExtRing != NULL );
3922
3923  const coeffs dstCf = dst->cf;
3924  assume( dstCf != NULL );
3925
3926  if( nCoeff_is_algExt(srcCf) ) // nCoeff_is_GF(srcCf)?
3927  {
3928    zz = (poly) z;
3929    if( zz == NULL ) return NULL;
3930  }
3931  else if (nCoeff_is_transExt(srcCf))
3932  {
3933    assume( !IS0(z) );
3934
3935    zz = NUM((fraction)z);
3936    p_Test (zz, srcExtRing);
3937
3938    if( zz == NULL ) return NULL;
3939    if( !DENIS1((fraction)z) )
3940    {
3941      if (!p_IsConstant(DEN((fraction)z),srcExtRing))
3942        WarnS("Not defined: Cannot map a rational fraction and make a polynomial out of it! Ignoring the denominator.");
3943    }
3944  }
3945  else
3946  {
3947    assume (FALSE);
3948    WerrorS("Number permutation is not implemented for this data yet!");
3949    return NULL;
3950  }
3951
3952  assume( zz != NULL );
3953  p_Test (zz, srcExtRing);
3954
3955  nMapFunc nMap = n_SetMap(srcExtRing->cf, dstCf);
3956
3957  assume( nMap != NULL );
3958
3959  poly qq;
3960  if ((par_perm == NULL) && (rPar(dst) != 0 && rVar (srcExtRing) > 0))
3961  {
3962    int* perm;
3963    perm=(int *)omAlloc0((rVar(srcExtRing)+1)*sizeof(int));
3964    perm[0]= 0;
3965    for(int i=si_min(rVar(srcExtRing),rPar(dst));i>0;i--)
3966      perm[i]=-i;
3967    qq = p_PermPoly(zz, perm, srcExtRing, dst, nMap, NULL, rVar(srcExtRing)-1);
3968    omFreeSize ((ADDRESS)perm, (rVar(srcExtRing)+1)*sizeof(int));
3969  }
3970  else
3971    qq = p_PermPoly(zz, par_perm-1, srcExtRing, dst, nMap, NULL, rVar (srcExtRing)-1);
3972
3973  if(nCoeff_is_transExt(srcCf)
3974  && (!DENIS1((fraction)z))
3975  && p_IsConstant(DEN((fraction)z),srcExtRing))
3976  {
3977    number n=nMap(pGetCoeff(DEN((fraction)z)),srcExtRing->cf, dstCf);
3978    qq=p_Div_nn(qq,n,dst);
3979    n_Delete(&n,dstCf);
3980    p_Normalize(qq,dst);
3981  }
3982  p_Test (qq, dst);
3983
3984  return qq;
3985}
3986
3987
3988/*2
3989*returns a re-ordered copy of a polynomial, with permutation of the variables
3990*/
3991poly p_PermPoly (poly p, const int * perm, const ring oldRing, const ring dst,
3992       nMapFunc nMap, const int *par_perm, int OldPar, BOOLEAN use_mult)
3993{
3994#if 0
3995    p_Test(p, oldRing);
3996    PrintS("p_PermPoly::p: "); p_Write(p, oldRing, oldRing);
3997#endif
3998  const int OldpVariables = rVar(oldRing);
3999  poly result = NULL;
4000  poly result_last = NULL;
4001  poly aq = NULL; /* the map coefficient */
4002  poly qq; /* the mapped monomial */
4003  assume(dst != NULL);
4004  assume(dst->cf != NULL);
4005  #ifdef HAVE_PLURAL
4006  poly tmp_mm=p_One(dst);
4007  #endif
4008  while (p != NULL)
4009  {
4010    // map the coefficient
4011    if ( ((OldPar == 0) || (par_perm == NULL) || rField_is_GF(oldRing) || (nMap==ndCopyMap))
4012    && (nMap != NULL) )
4013    {
4014      qq = p_Init(dst);
4015      assume( nMap != NULL );
4016      number n = nMap(p_GetCoeff(p, oldRing), oldRing->cf, dst->cf);
4017      n_Test (n,dst->cf);
4018      if ( nCoeff_is_algExt(dst->cf) )
4019        n_Normalize(n, dst->cf);
4020      p_GetCoeff(qq, dst) = n;// Note: n can be a ZERO!!!
4021    }
4022    else
4023    {
4024      qq = p_One(dst);
4025//      aq = naPermNumber(p_GetCoeff(p, oldRing), par_perm, OldPar, oldRing); // no dst???
4026//      poly    n_PermNumber(const number z, const int *par_perm, const int P, const ring src, const ring dst)
4027      aq = n_PermNumber(p_GetCoeff(p, oldRing), par_perm, OldPar, oldRing, dst);
4028      p_Test(aq, dst);
4029      if ( nCoeff_is_algExt(dst->cf) )
4030        p_Normalize(aq,dst);
4031      if (aq == NULL)
4032        p_SetCoeff(qq, n_Init(0, dst->cf),dst); // Very dirty trick!!!
4033      p_Test(aq, dst);
4034    }
4035    if (rRing_has_Comp(dst))
4036       p_SetComp(qq, p_GetComp(p, oldRing), dst);
4037    if ( n_IsZero(pGetCoeff(qq), dst->cf) )
4038    {
4039      p_LmDelete(&qq,dst);
4040      qq = NULL;
4041    }
4042    else
4043    {
4044      // map pars:
4045      int mapped_to_par = 0;
4046      for(int i = 1; i <= OldpVariables; i++)
4047      {
4048        int e = p_GetExp(p, i, oldRing);
4049        if (e != 0)
4050        {
4051          if (perm==NULL)
4052            p_SetExp(qq, i, e, dst);
4053          else if (perm[i]>0)
4054          {
4055            #ifdef HAVE_PLURAL
4056            if(use_mult)
4057            {
4058              p_SetExp(tmp_mm,perm[i],e,dst);
4059              p_Setm(tmp_mm,dst);
4060              qq=p_Mult_mm(qq,tmp_mm,dst);
4061              p_SetExp(tmp_mm,perm[i],0,dst);
4062
4063            }
4064            else
4065            #endif
4066            p_AddExp(qq,perm[i], e/*p_GetExp( p,i,oldRing)*/, dst);
4067          }
4068          else if (perm[i]<0)
4069          {
4070            number c = p_GetCoeff(qq, dst);
4071            if (rField_is_GF(dst))
4072            {
4073              assume( dst->cf->extRing == NULL );
4074              number ee = n_Param(1, dst);
4075              number eee;
4076              n_Power(ee, e, &eee, dst->cf); //nfDelete(ee,dst);
4077              ee = n_Mult(c, eee, dst->cf);
4078              //nfDelete(c,dst);nfDelete(eee,dst);
4079              pSetCoeff0(qq,ee);
4080            }
4081            else if (nCoeff_is_Extension(dst->cf))
4082            {
4083              const int par = -perm[i];
4084              assume( par > 0 );
4085//              WarnS("longalg missing 3");
4086#if 1
4087              const coeffs C = dst->cf;
4088              assume( C != NULL );
4089              const ring R = C->extRing;
4090              assume( R != NULL );
4091              assume( par <= rVar(R) );
4092              poly pcn; // = (number)c
4093              assume( !n_IsZero(c, C) );
4094              if( nCoeff_is_algExt(C) )
4095                 pcn = (poly) c;
4096               else //            nCoeff_is_transExt(C)
4097                 pcn = NUM((fraction)c);
4098              if (pNext(pcn) == NULL) // c->z
4099                p_AddExp(pcn, -perm[i], e, R);
4100              else /* more difficult: we have really to multiply: */
4101              {
4102                poly mmc = p_ISet(1, R);
4103                p_SetExp(mmc, -perm[i], e, R);
4104                p_Setm(mmc, R);
4105                number nnc;
4106                // convert back to a number: number nnc = mmc;
4107                if( nCoeff_is_algExt(C) )
4108                   nnc = (number) mmc;
4109                else //            nCoeff_is_transExt(C)
4110                  nnc = ntInit(mmc, C);
4111                p_GetCoeff(qq, dst) = n_Mult((number)c, nnc, C);
4112                n_Delete((number *)&c, C);
4113                n_Delete((number *)&nnc, C);
4114              }
4115              mapped_to_par=1;
4116#endif
4117            }
4118          }
4119          else
4120          {
4121            /* this variable maps to 0 !*/
4122            p_LmDelete(&qq, dst);
4123            break;
4124          }
4125        }
4126      }
4127      if ( mapped_to_par && (qq!= NULL) && nCoeff_is_algExt(dst->cf) )
4128      {
4129        number n = p_GetCoeff(qq, dst);
4130        n_Normalize(n, dst->cf);
4131        p_GetCoeff(qq, dst) = n;
4132      }
4133    }
4134    pIter(p);
4135
4136#if 0
4137    p_Test(aq,dst);
4138    PrintS("aq: "); p_Write(aq, dst, dst);
4139#endif
4140
4141
4142#if 1
4143    if (qq!=NULL)
4144    {
4145      p_Setm(qq,dst);
4146
4147      p_Test(aq,dst);
4148      p_Test(qq,dst);
4149
4150#if 0
4151    PrintS("qq: "); p_Write(qq, dst, dst);
4152#endif
4153
4154      if (aq!=NULL)
4155         qq=p_Mult_q(aq,qq,dst);
4156      aq = qq;
4157      while (pNext(aq) != NULL) pIter(aq);
4158      if (result_last==NULL)
4159      {
4160        result=qq;
4161      }
4162      else
4163      {
4164        pNext(result_last)=qq;
4165      }
4166      result_last=aq;
4167      aq = NULL;
4168    }
4169    else if (aq!=NULL)
4170    {
4171      p_Delete(&aq,dst);
4172    }
4173  }
4174  result=p_SortAdd(result,dst);
4175#else
4176  //  if (qq!=NULL)
4177  //  {
4178  //    pSetm(qq);
4179  //    pTest(qq);
4180  //    pTest(aq);
4181  //    if (aq!=NULL) qq=pMult(aq,qq);
4182  //    aq = qq;
4183  //    while (pNext(aq) != NULL) pIter(aq);
4184  //    pNext(aq) = result;
4185  //    aq = NULL;
4186  //    result = qq;
4187  //  }
4188  //  else if (aq!=NULL)
4189  //  {
4190  //    pDelete(&aq);
4191  //  }
4192  //}
4193  //p = result;
4194  //result = NULL;
4195  //while (p != NULL)
4196  //{
4197  //  qq = p;
4198  //  pIter(p);
4199  //  qq->next = NULL;
4200  //  result = pAdd(result, qq);
4201  //}
4202#endif
4203  p_Test(result,dst);
4204#if 0
4205  p_Test(result,dst);
4206  PrintS("result: "); p_Write(result,dst,dst);
4207#endif
4208  #ifdef HAVE_PLURAL
4209  p_LmDelete(&tmp_mm,dst);
4210  #endif
4211  return result;
4212}
4213/**************************************************************
4214 *
4215 * Jet
4216 *
4217 **************************************************************/
4218
4219poly pp_Jet(poly p, int m, const ring R)
4220{
4221  poly r=NULL;
4222  poly t=NULL;
4223
4224  while (p!=NULL)
4225  {
4226    if (p_Totaldegree(p,R)<=m)
4227    {
4228      if (r==NULL)
4229        r=p_Head(p,R);
4230      else
4231      if (t==NULL)
4232      {
4233        pNext(r)=p_Head(p,R);
4234        t=pNext(r);
4235      }
4236      else
4237      {
4238        pNext(t)=p_Head(p,R);
4239        pIter(t);
4240      }
4241    }
4242    pIter(p);
4243  }
4244  return r;
4245}
4246
4247poly p_Jet(poly p, int m,const ring R)
4248{
4249  while((p!=NULL) && (p_Totaldegree(p,R)>m)) p_LmDelete(&p,R);
4250  if (p==NULL) return NULL;
4251  poly r=p;
4252  while (pNext(p)!=NULL)
4253  {
4254    if (p_Totaldegree(pNext(p),R)>m)
4255    {
4256      p_LmDelete(&pNext(p),R);
4257    }
4258    else
4259      pIter(p);
4260  }
4261  return r;
4262}
4263
4264poly pp_JetW(poly p, int m, short *w, const ring R)
4265{
4266  poly r=NULL;
4267  poly t=NULL;
4268  while (p!=NULL)
4269  {
4270    if (totaldegreeWecart_IV(p,R,w)<=m)
4271    {
4272      if (r==NULL)
4273        r=p_Head(p,R);
4274      else
4275      if (t==NULL)
4276      {
4277        pNext(r)=p_Head(p,R);
4278        t=pNext(r);
4279      }
4280      else
4281      {
4282        pNext(t)=p_Head(p,R);
4283        pIter(t);
4284      }
4285    }
4286    pIter(p);
4287  }
4288  return r;
4289}
4290
4291poly p_JetW(poly p, int m, short *w, const ring R)
4292{
4293  while((p!=NULL) && (totaldegreeWecart_IV(p,R,w)>m)) p_LmDelete(&p,R);
4294  if (p==NULL) return NULL;
4295  poly r=p;
4296  while (pNext(p)!=NULL)
4297  {
4298    if (totaldegreeWecart_IV(pNext(p),R,w)>m)
4299    {
4300      p_LmDelete(&pNext(p),R);
4301    }
4302    else
4303      pIter(p);
4304  }
4305  return r;
4306}
4307
4308/*************************************************************/
4309int p_MinDeg(poly p,intvec *w, const ring R)
4310{
4311  if(p==NULL)
4312    return -1;
4313  int d=-1;
4314  while(p!=NULL)
4315  {
4316    int d0=0;
4317    for(int j=0;j<rVar(R);j++)
4318      if(w==NULL||j>=w->length())
4319        d0+=p_GetExp(p,j+1,R);
4320      else
4321        d0+=(*w)[j]*p_GetExp(p,j+1,R);
4322    if(d0<d||d==-1)
4323      d=d0;
4324    pIter(p);
4325  }
4326  return d;
4327}
4328
4329/***************************************************************/
4330static poly p_Invers(int n,poly u,intvec *w, const ring R)
4331{
4332  if(n<0)
4333    return NULL;
4334  number u0=n_Invers(pGetCoeff(u),R->cf);
4335  poly v=p_NSet(u0,R);
4336  if(n==0)
4337    return v;
4338  short *ww=iv2array(w,R);
4339  poly u1=p_JetW(p_Sub(p_One(R),__p_Mult_nn(u,u0,R),R),n,ww,R);
4340  if(u1==NULL)
4341  {
4342    omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
4343    return v;
4344  }
4345  poly v1=__p_Mult_nn(p_Copy(u1,R),u0,R);
4346  v=p_Add_q(v,p_Copy(v1,R),R);
4347  for(int i=n/p_MinDeg(u1,w,R);i>1;i--)
4348  {
4349    v1=p_JetW(p_Mult_q(v1,p_Copy(u1,R),R),n,ww,R);
4350    v=p_Add_q(v,p_Copy(v1,R),R);
4351  }
4352  p_Delete(&u1,R);
4353  p_Delete(&v1,R);
4354  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
4355  return v;
4356}
4357
4358
4359poly p_Series(int n,poly p,poly u, intvec *w, const ring R)
4360{
4361  short *ww=iv2array(w,R);
4362  if(p!=NULL)
4363  {
4364    if(u==NULL)
4365      p=p_JetW(p,n,ww,R);
4366    else
4367      p=p_JetW(p_Mult_q(p,p_Invers(n-p_MinDeg(p,w,R),u,w,R),R),n,ww,R);
4368  }
4369  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
4370  return p;
4371}
4372
4373BOOLEAN p_EqualPolys(poly p1,poly p2, const ring r)
4374{
4375  while ((p1 != NULL) && (p2 != NULL))
4376  {
4377    if (! p_LmEqual(p1, p2,r))
4378      return FALSE;
4379    if (! n_Equal(p_GetCoeff(p1,r), p_GetCoeff(p2,r),r->cf ))
4380      return FALSE;
4381    pIter(p1);
4382    pIter(p2);
4383  }
4384  return (p1==p2);
4385}
4386
4387static inline BOOLEAN p_ExpVectorEqual(poly p1, poly p2, const ring r1, const ring r2)
4388{
4389  assume( r1 == r2 || rSamePolyRep(r1, r2) );
4390
4391  p_LmCheckPolyRing1(p1, r1);
4392  p_LmCheckPolyRing1(p2, r2);
4393
4394  int i = r1->ExpL_Size;
4395
4396  assume( r1->ExpL_Size == r2->ExpL_Size );
4397
4398  unsigned long *ep = p1->exp;
4399  unsigned long *eq = p2->exp;
4400
4401  do
4402  {
4403    i--;
4404    if (ep[i] != eq[i]) return FALSE;
4405  }
4406  while (i);
4407
4408  return TRUE;
4409}
4410
4411BOOLEAN p_EqualPolys(poly p1,poly p2, const ring r1, const ring r2)
4412{
4413  assume( r1 == r2 || rSamePolyRep(r1, r2) ); // will be used in rEqual!
4414  assume( r1->cf == r2->cf );
4415
4416  while ((p1 != NULL) && (p2 != NULL))
4417  {
4418    // returns 1 if ExpVector(p)==ExpVector(q): does not compare numbers !!
4419    // #define p_LmEqual(p1, p2, r) p_ExpVectorEqual(p1, p2, r)
4420
4421    if (! p_ExpVectorEqual(p1, p2, r1, r2))
4422      return FALSE;
4423
4424    if (! n_Equal(p_GetCoeff(p1,r1), p_GetCoeff(p2,r2), r1->cf ))
4425      return FALSE;
4426
4427    pIter(p1);
4428    pIter(p2);
4429  }
4430  return (p1==p2);
4431}
4432
4433/*2
4434*returns TRUE if p1 is a skalar multiple of p2
4435*assume p1 != NULL and p2 != NULL
4436*/
4437BOOLEAN p_ComparePolys(poly p1,poly p2, const ring r)
4438{
4439  number n,nn;
4440  pAssume(p1 != NULL && p2 != NULL);
4441
4442  if (!p_LmEqual(p1,p2,r)) //compare leading mons
4443      return FALSE;
4444  if ((pNext(p1)==NULL) && (pNext(p2)!=NULL))
4445     return FALSE;
4446  if ((pNext(p2)==NULL) && (pNext(p1)!=NULL))
4447     return FALSE;
4448  if (pLength(p1) != pLength(p2))
4449    return FALSE;
4450  #ifdef HAVE_RINGS
4451  if (rField_is_Ring(r))
4452  {
4453    if (!n_DivBy(pGetCoeff(p1), pGetCoeff(p2), r->cf)) return FALSE;
4454  }
4455  #endif
4456  n=n_Div(pGetCoeff(p1),pGetCoeff(p2),r->cf);
4457  while ((p1 != NULL) /*&& (p2 != NULL)*/)
4458  {
4459    if ( ! p_LmEqual(p1, p2,r))
4460    {
4461        n_Delete(&n, r->cf);
4462        return FALSE;
4463    }
4464    if (!n_Equal(pGetCoeff(p1), nn = n_Mult(pGetCoeff(p2),n, r->cf), r->cf))
4465    {
4466      n_Delete(&n, r->cf);
4467      n_Delete(&nn, r->cf);
4468      return FALSE;
4469    }
4470    n_Delete(&nn, r->cf);
4471    pIter(p1);
4472    pIter(p2);
4473  }
4474  n_Delete(&n, r->cf);
4475  return TRUE;
4476}
4477
4478/*2
4479* returns the length of a (numbers of monomials)
4480* respect syzComp
4481*/
4482poly p_Last(const poly p, int &l, const ring r)
4483{
4484  if (p == NULL)
4485  {
4486    l = 0;
4487    return NULL;
4488  }
4489  l = 1;
4490  poly a = p;
4491  if (! rIsSyzIndexRing(r))
4492  {
4493    poly next = pNext(a);
4494    while (next!=NULL)
4495    {
4496      a = next;
4497      next = pNext(a);
4498      l++;
4499    }
4500  }
4501  else
4502  {
4503    int curr_limit = rGetCurrSyzLimit(r);
4504    poly pp = a;
4505    while ((a=pNext(a))!=NULL)
4506    {
4507      if (__p_GetComp(a,r)<=curr_limit/*syzComp*/)
4508        l++;
4509      else break;
4510      pp = a;
4511    }
4512    a=pp;
4513  }
4514  return a;
4515}
4516
4517int p_Var(poly m,const ring r)
4518{
4519  if (m==NULL) return 0;
4520  if (pNext(m)!=NULL) return 0;
4521  int i,e=0;
4522  for (i=rVar(r); i>0; i--)
4523  {
4524    int exp=p_GetExp(m,i,r);
4525    if (exp==1)
4526    {
4527      if (e==0) e=i;
4528      else return 0;
4529    }
4530    else if (exp!=0)
4531    {
4532      return 0;
4533    }
4534  }
4535  return e;
4536}
4537
4538/*2
4539*the minimal index of used variables - 1
4540*/
4541int p_LowVar (poly p, const ring r)
4542{
4543  int k,l,lex;
4544
4545  if (p == NULL) return -1;
4546
4547  k = 32000;/*a very large dummy value*/
4548  while (p != NULL)
4549  {
4550    l = 1;
4551    lex = p_GetExp(p,l,r);
4552    while ((l < (rVar(r))) && (lex == 0))
4553    {
4554      l++;
4555      lex = p_GetExp(p,l,r);
4556    }
4557    l--;
4558    if (l < k) k = l;
4559    pIter(p);
4560  }
4561  return k;
4562}
4563
4564/*2
4565* verschiebt die Indizees der Modulerzeugenden um i
4566*/
4567void p_Shift (poly * p,int i, const ring r)
4568{
4569  poly qp1 = *p,qp2 = *p;/*working pointers*/
4570  int     j = p_MaxComp(*p,r),k = p_MinComp(*p,r);
4571
4572  if (j+i < 0) return ;
4573  BOOLEAN toPoly= ((j == -i) && (j == k));
4574  while (qp1 != NULL)
4575  {
4576    if (toPoly || (__p_GetComp(qp1,r)+i > 0))
4577    {
4578      p_AddComp(qp1,i,r);
4579      p_SetmComp(qp1,r);
4580      qp2 = qp1;
4581      pIter(qp1);
4582    }
4583    else
4584    {
4585      if (qp2 == *p)
4586      {
4587        pIter(*p);
4588        p_LmDelete(&qp2,r);
4589        qp2 = *p;
4590        qp1 = *p;
4591      }
4592      else
4593      {
4594        qp2->next = qp1->next;
4595        if (qp1!=NULL) p_LmDelete(&qp1,r);
4596        qp1 = qp2->next;
4597      }
4598    }
4599  }
4600}
4601
4602/***************************************************************
4603 *
4604 * Storage Managament Routines
4605 *
4606 ***************************************************************/
4607
4608
4609static inline unsigned long GetBitFields(const long e,
4610                                         const unsigned int s, const unsigned int n)
4611{
4612#define Sy_bit_L(x)     (((unsigned long)1L)<<(x))
4613  unsigned int i = 0;
4614  unsigned long  ev = 0L;
4615  assume(n > 0 && s < BIT_SIZEOF_LONG);
4616  do
4617  {
4618    assume(s+i < BIT_SIZEOF_LONG);
4619    if (e > (long) i) ev |= Sy_bit_L(s+i);
4620    else break;
4621    i++;
4622  }
4623  while (i < n);
4624  return ev;
4625}
4626
4627// Short Exponent Vectors are used for fast divisibility tests
4628// ShortExpVectors "squeeze" an exponent vector into one word as follows:
4629// Let n = BIT_SIZEOF_LONG / pVariables.
4630// If n == 0 (i.e. pVariables > BIT_SIZE_OF_LONG), let m == the number
4631// of non-zero exponents. If (m>BIT_SIZEOF_LONG), then sev = ~0, else
4632// first m bits of sev are set to 1.
4633// Otherwise (i.e. pVariables <= BIT_SIZE_OF_LONG)
4634// represented by a bit-field of length n (resp. n+1 for some
4635// exponents). If the value of an exponent is greater or equal to n, then
4636// all of its respective n bits are set to 1. If the value of an exponent
4637// is smaller than n, say m, then only the first m bits of the respective
4638// n bits are set to 1, the others are set to 0.
4639// This way, we have:
4640// exp1 / exp2 ==> (ev1 & ~ev2) == 0, i.e.,
4641// if (ev1 & ~ev2) then exp1 does not divide exp2
4642unsigned long p_GetShortExpVector(const poly p, const ring r)
4643{
4644  assume(p != NULL);
4645  unsigned long ev = 0; // short exponent vector
4646  unsigned int n = BIT_SIZEOF_LONG / r->N; // number of bits per exp
4647  unsigned int m1; // highest bit which is filled with (n+1)
4648  int i=0,j=1;
4649
4650  if (n == 0)
4651  {
4652    if (r->N <2*BIT_SIZEOF_LONG)
4653    {
4654      n=1;
4655      m1=0;
4656    }
4657    else
4658    {
4659      for (; j<=r->N; j++)
4660      {
4661        if (p_GetExp(p,j,r) > 0) i++;
4662        if (i == BIT_SIZEOF_LONG) break;
4663      }
4664      if (i>0)
4665        ev = ~(0UL) >> (BIT_SIZEOF_LONG - i);
4666      return ev;
4667    }
4668  }
4669  else
4670  {
4671    m1 = (n+1)*(BIT_SIZEOF_LONG - n*r->N);
4672  }
4673
4674  n++;
4675  while (i<m1)
4676  {
4677    ev |= GetBitFields(p_GetExp(p, j,r), i, n);
4678    i += n;
4679    j++;
4680  }
4681
4682  n--;
4683  while (i<BIT_SIZEOF_LONG)
4684  {
4685    ev |= GetBitFields(p_GetExp(p, j,r), i, n);
4686    i += n;
4687    j++;
4688  }
4689  return ev;
4690}
4691
4692
4693///  p_GetShortExpVector of p * pp
4694unsigned long p_GetShortExpVector(const poly p, const poly pp, const ring r)
4695{
4696  assume(p != NULL);
4697  assume(pp != NULL);
4698
4699  unsigned long ev = 0; // short exponent vector
4700  unsigned int n = BIT_SIZEOF_LONG / r->N; // number of bits per exp
4701  unsigned int m1; // highest bit which is filled with (n+1)
4702  int j=1;
4703  unsigned long i = 0L;
4704
4705  if (n == 0)
4706  {
4707    if (r->N <2*BIT_SIZEOF_LONG)
4708    {
4709      n=1;
4710      m1=0;
4711    }
4712    else
4713    {
4714      for (; j<=r->N; j++)
4715      {
4716        if (p_GetExp(p,j,r) > 0 || p_GetExp(pp,j,r) > 0) i++;
4717        if (i == BIT_SIZEOF_LONG) break;
4718      }
4719      if (i>0)
4720        ev = ~(0UL) >> (BIT_SIZEOF_LONG - i);
4721      return ev;
4722    }
4723  }
4724  else
4725  {
4726    m1 = (n+1)*(BIT_SIZEOF_LONG - n*r->N);
4727  }
4728
4729  n++;
4730  while (i<m1)
4731  {
4732    ev |= GetBitFields(p_GetExp(p, j,r) + p_GetExp(pp, j,r), i, n);
4733    i += n;
4734    j++;
4735  }
4736
4737  n--;
4738  while (i<BIT_SIZEOF_LONG)
4739  {
4740    ev |= GetBitFields(p_GetExp(p, j,r) + p_GetExp(pp, j,r), i, n);
4741    i += n;
4742    j++;
4743  }
4744  return ev;
4745}
4746
4747
4748
4749/***************************************************************
4750 *
4751 * p_ShallowDelete
4752 *
4753 ***************************************************************/
4754#undef LINKAGE
4755#define LINKAGE
4756#undef p_Delete__T
4757#define p_Delete__T p_ShallowDelete
4758#undef n_Delete__T
4759#define n_Delete__T(n, r) do {} while (0)
4760
4761#include "polys/templates/p_Delete__T.cc"
4762
4763/***************************************************************/
4764/*
4765* compare a and b
4766*/
4767int p_Compare(const poly a, const poly b, const ring R)
4768{
4769  int r=p_Cmp(a,b,R);
4770  if ((r==0)&&(a!=NULL))
4771  {
4772    number h=n_Sub(pGetCoeff(a),pGetCoeff(b),R->cf);
4773    /* compare lead coeffs */
4774    r = -1+n_IsZero(h,R->cf)+2*n_GreaterZero(h,R->cf); /* -1: <, 0:==, 1: > */
4775    n_Delete(&h,R->cf);
4776  }
4777  else if (a==NULL)
4778  {
4779    if (b==NULL)
4780    {
4781      /* compare 0, 0 */
4782      r=0;
4783    }
4784    else if(p_IsConstant(b,R))
4785    {
4786      /* compare 0, const */
4787      r = 1-2*n_GreaterZero(pGetCoeff(b),R->cf); /* -1: <, 1: > */
4788    }
4789  }
4790  else if (b==NULL)
4791  {
4792    if (p_IsConstant(a,R))
4793    {
4794      /* compare const, 0 */
4795      r = -1+2*n_GreaterZero(pGetCoeff(a),R->cf); /* -1: <, 1: > */
4796    }
4797  }
4798  return(r);
4799}
4800
4801poly p_GcdMon(poly f, poly g, const ring r)
4802{
4803  assume(f!=NULL);
4804  assume(g!=NULL);
4805  assume(pNext(f)==NULL);
4806  poly G=p_Head(f,r);
4807  poly h=g;
4808  int *mf=(int*)omAlloc((r->N+1)*sizeof(int));
4809  p_GetExpV(f,mf,r);
4810  int *mh=(int*)omAlloc((r->N+1)*sizeof(int));
4811  BOOLEAN const_mon;
4812  BOOLEAN one_coeff=n_IsOne(pGetCoeff(G),r->cf);
4813  loop
4814  {
4815    if (h==NULL) break;
4816    if(!one_coeff)
4817    {
4818      number n=n_SubringGcd(pGetCoeff(G),pGetCoeff(h),r->cf);
4819      one_coeff=n_IsOne(n,r->cf);
4820      p_SetCoeff(G,n,r);
4821    }
4822    p_GetExpV(h,mh,r);
4823    const_mon=TRUE;
4824    for(unsigned j=r->N;j!=0;j--)
4825    {
4826      if (mh[j]<mf[j]) mf[j]=mh[j];
4827      if (mf[j]>0) const_mon=FALSE;
4828    }
4829    if (one_coeff && const_mon) break;
4830    pIter(h);
4831  }
4832  mf[0]=0;
4833  p_SetExpV(G,mf,r); // included is p_SetComp, p_Setm
4834  omFreeSize(mf,(r->N+1)*sizeof(int));
4835  omFreeSize(mh,(r->N+1)*sizeof(int));
4836  return G;
4837}
Note: See TracBrowser for help on using the repository browser.