source: git/libpolys/polys/monomials/p_polys.cc @ 86ff333

spielwiese
Last change on this file since 86ff333 was 86ff333, checked in by Hans Schoenemann <hannes@…>, 6 years ago
add: allow interrupt with partial results in std(bba+mora), removed ADIDEBUG
  • 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                                                                   */
2236static number p_InitContent(poly ph, const ring r);
2237
2238void p_Content(poly ph, const ring r)
2239{
2240  if (ph==NULL) return;
2241  if (pNext(ph)==NULL)
2242  {
2243    p_SetCoeff(ph,n_Init(1,r->cf),r);
2244  }
2245  if (r->cf->cfSubringGcd==ndGcd) /* trivial gcd*/ return;
2246  number h=p_InitContent(ph,r); /* first guess of a gcd of all coeffs */
2247  poly p=ph;
2248  // take the SubringGcd of all coeffs
2249  while (p!=NULL)
2250  {
2251    n_Normalize(pGetCoeff(p),r->cf);
2252    number d=n_SubringGcd(h,pGetCoeff(p),r->cf);
2253    n_Delete(&h,r->cf);
2254    h = d;
2255    if(n_IsOne(h,r->cf))
2256    {
2257      break;
2258    }
2259    pIter(p);
2260  }
2261  // if foundi<>1, divide by it
2262  if(!n_IsOne(h,r->cf))
2263  {
2264    p = ph;
2265    while (p!=NULL)
2266    {
2267      number d = n_ExactDiv(pGetCoeff(p),h,r->cf);
2268      p_SetCoeff(p,d,r);
2269      pIter(p);
2270    }
2271  }
2272  n_Delete(&h,r->cf);
2273  // and last: check leading sign:
2274  if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2275}
2276
2277#define CLEARENUMERATORS 1
2278
2279void p_ContentForGB(poly ph, const ring r)
2280{
2281  if(TEST_OPT_CONTENTSB) return;
2282  assume( ph != NULL );
2283
2284  assume( r != NULL ); assume( r->cf != NULL );
2285
2286
2287#if CLEARENUMERATORS
2288  if( 0 )
2289  {
2290    const coeffs C = r->cf;
2291      // experimentall (recursive enumerator treatment) of alg. Ext!
2292    CPolyCoeffsEnumerator itr(ph);
2293    n_ClearContent(itr, r->cf);
2294
2295    p_Test(ph, r); n_Test(pGetCoeff(ph), C);
2296    assume(n_GreaterZero(pGetCoeff(ph), C)); // ??
2297
2298      // if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2299    return;
2300  }
2301#endif
2302
2303
2304#ifdef HAVE_RINGS
2305  if (rField_is_Ring(r))
2306  {
2307    if (rField_has_Units(r))
2308    {
2309      number k = n_GetUnit(pGetCoeff(ph),r->cf);
2310      if (!n_IsOne(k,r->cf))
2311      {
2312        number tmpGMP = k;
2313        k = n_Invers(k,r->cf);
2314        n_Delete(&tmpGMP,r->cf);
2315        poly h = pNext(ph);
2316        p_SetCoeff(ph, n_Mult(pGetCoeff(ph), k,r->cf),r);
2317        while (h != NULL)
2318        {
2319          p_SetCoeff(h, n_Mult(pGetCoeff(h), k,r->cf),r);
2320          pIter(h);
2321        }
2322//        assume( n_GreaterZero(pGetCoeff(ph),r->cf) );
2323//        if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2324      }
2325      n_Delete(&k,r->cf);
2326    }
2327    return;
2328  }
2329#endif
2330  number h,d;
2331  poly p;
2332
2333  if(pNext(ph)==NULL)
2334  {
2335    p_SetCoeff(ph,n_Init(1,r->cf),r);
2336  }
2337  else
2338  {
2339    assume( pNext(ph) != NULL );
2340#if CLEARENUMERATORS
2341    if( nCoeff_is_Q(r->cf) )
2342    {
2343      // experimentall (recursive enumerator treatment) of alg. Ext!
2344      CPolyCoeffsEnumerator itr(ph);
2345      n_ClearContent(itr, r->cf);
2346
2347      p_Test(ph, r); n_Test(pGetCoeff(ph), r->cf);
2348      assume(n_GreaterZero(pGetCoeff(ph), r->cf)); // ??
2349
2350      // if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2351      return;
2352    }
2353#endif
2354
2355    n_Normalize(pGetCoeff(ph),r->cf);
2356    if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2357    if (rField_is_Q(r)||(getCoeffType(r->cf)==n_transExt)) // should not be used anymore if CLEARENUMERATORS is 1
2358    {
2359      h=p_InitContent(ph,r);
2360      p=ph;
2361    }
2362    else
2363    {
2364      h=n_Copy(pGetCoeff(ph),r->cf);
2365      p = pNext(ph);
2366    }
2367    while (p!=NULL)
2368    {
2369      n_Normalize(pGetCoeff(p),r->cf);
2370      d=n_SubringGcd(h,pGetCoeff(p),r->cf);
2371      n_Delete(&h,r->cf);
2372      h = d;
2373      if(n_IsOne(h,r->cf))
2374      {
2375        break;
2376      }
2377      pIter(p);
2378    }
2379    //number tmp;
2380    if(!n_IsOne(h,r->cf))
2381    {
2382      p = ph;
2383      while (p!=NULL)
2384      {
2385        //d = nDiv(pGetCoeff(p),h);
2386        //tmp = nExactDiv(pGetCoeff(p),h);
2387        //if (!nEqual(d,tmp))
2388        //{
2389        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
2390        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
2391        //  nWrite(tmp);Print(StringEndS("\n")); // NOTE/TODO: use StringAppendS("\n"); omFree(s);
2392        //}
2393        //nDelete(&tmp);
2394        d = n_ExactDiv(pGetCoeff(p),h,r->cf);
2395        p_SetCoeff(p,d,r);
2396        pIter(p);
2397      }
2398    }
2399    n_Delete(&h,r->cf);
2400    if (rField_is_Q_a(r))
2401    {
2402      // special handling for alg. ext.:
2403      if (getCoeffType(r->cf)==n_algExt)
2404      {
2405        h = n_Init(1, r->cf->extRing->cf);
2406        p=ph;
2407        while (p!=NULL)
2408        { // each monom: coeff in Q_a
2409          poly c_n_n=(poly)pGetCoeff(p);
2410          poly c_n=c_n_n;
2411          while (c_n!=NULL)
2412          { // each monom: coeff in Q
2413            d=n_NormalizeHelper(h,pGetCoeff(c_n),r->cf->extRing->cf);
2414            n_Delete(&h,r->cf->extRing->cf);
2415            h=d;
2416            pIter(c_n);
2417          }
2418          pIter(p);
2419        }
2420        /* h contains the 1/lcm of all denominators in c_n_n*/
2421        //n_Normalize(h,r->cf->extRing->cf);
2422        if(!n_IsOne(h,r->cf->extRing->cf))
2423        {
2424          p=ph;
2425          while (p!=NULL)
2426          { // each monom: coeff in Q_a
2427            poly c_n=(poly)pGetCoeff(p);
2428            while (c_n!=NULL)
2429            { // each monom: coeff in Q
2430              d=n_Mult(h,pGetCoeff(c_n),r->cf->extRing->cf);
2431              n_Normalize(d,r->cf->extRing->cf);
2432              n_Delete(&pGetCoeff(c_n),r->cf->extRing->cf);
2433              pGetCoeff(c_n)=d;
2434              pIter(c_n);
2435            }
2436            pIter(p);
2437          }
2438        }
2439        n_Delete(&h,r->cf->extRing->cf);
2440      }
2441      /*else
2442      {
2443      // special handling for rat. functions.:
2444        number hzz =NULL;
2445        p=ph;
2446        while (p!=NULL)
2447        { // each monom: coeff in Q_a (Z_a)
2448          fraction f=(fraction)pGetCoeff(p);
2449          poly c_n=NUM(f);
2450          if (hzz==NULL)
2451          {
2452            hzz=n_Copy(pGetCoeff(c_n),r->cf->extRing->cf);
2453            pIter(c_n);
2454          }
2455          while ((c_n!=NULL)&&(!n_IsOne(hzz,r->cf->extRing->cf)))
2456          { // each monom: coeff in Q (Z)
2457            d=n_Gcd(hzz,pGetCoeff(c_n),r->cf->extRing->cf);
2458            n_Delete(&hzz,r->cf->extRing->cf);
2459            hzz=d;
2460            pIter(c_n);
2461          }
2462          pIter(p);
2463        }
2464        // hzz contains the gcd of all numerators in f
2465        h=n_Invers(hzz,r->cf->extRing->cf);
2466        n_Delete(&hzz,r->cf->extRing->cf);
2467        n_Normalize(h,r->cf->extRing->cf);
2468        if(!n_IsOne(h,r->cf->extRing->cf))
2469        {
2470          p=ph;
2471          while (p!=NULL)
2472          { // each monom: coeff in Q_a (Z_a)
2473            fraction f=(fraction)pGetCoeff(p);
2474            NUM(f)=__p_Mult_nn(NUM(f),h,r->cf->extRing);
2475            p_Normalize(NUM(f),r->cf->extRing);
2476            pIter(p);
2477          }
2478        }
2479        n_Delete(&h,r->cf->extRing->cf);
2480      }*/
2481    }
2482  }
2483  if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2484}
2485
2486// Not yet?
2487#if 1 // currently only used by Singular/janet
2488void p_SimpleContent(poly ph, int smax, const ring r)
2489{
2490  if(TEST_OPT_CONTENTSB) return;
2491  if (ph==NULL) return;
2492  if (pNext(ph)==NULL)
2493  {
2494    p_SetCoeff(ph,n_Init(1,r->cf),r);
2495    return;
2496  }
2497  if ((pNext(pNext(ph))==NULL)||(!rField_is_Q(r)))
2498  {
2499    return;
2500  }
2501  number d=p_InitContent(ph,r);
2502  if (n_Size(d,r->cf)<=smax)
2503  {
2504    //if (TEST_OPT_PROT) PrintS("G");
2505    return;
2506  }
2507
2508  poly p=ph;
2509  number h=d;
2510  if (smax==1) smax=2;
2511  while (p!=NULL)
2512  {
2513#if 0
2514    d=n_Gcd(h,pGetCoeff(p),r->cf);
2515    n_Delete(&h,r->cf);
2516    h = d;
2517#else
2518    STATISTIC(n_Gcd); nlInpGcd(h,pGetCoeff(p),r->cf);
2519#endif
2520    if(n_Size(h,r->cf)<smax)
2521    {
2522      //if (TEST_OPT_PROT) PrintS("g");
2523      return;
2524    }
2525    pIter(p);
2526  }
2527  p = ph;
2528  if (!n_GreaterZero(pGetCoeff(p),r->cf)) h=n_InpNeg(h,r->cf);
2529  if(n_IsOne(h,r->cf)) return;
2530  //if (TEST_OPT_PROT) PrintS("c");
2531  while (p!=NULL)
2532  {
2533#if 1
2534    d = n_ExactDiv(pGetCoeff(p),h,r->cf);
2535    p_SetCoeff(p,d,r);
2536#else
2537    STATISTIC(n_ExactDiv); nlInpExactDiv(pGetCoeff(p),h,r->cf); // no such function... ?
2538#endif
2539    pIter(p);
2540  }
2541  n_Delete(&h,r->cf);
2542}
2543#endif
2544
2545static number p_InitContent(poly ph, const ring r)
2546// only for coefficients in Q and rational functions
2547#if 0
2548{
2549  assume(!TEST_OPT_CONTENTSB);
2550  assume(ph!=NULL);
2551  assume(pNext(ph)!=NULL);
2552  assume(rField_is_Q(r));
2553  if (pNext(pNext(ph))==NULL)
2554  {
2555    return n_GetNumerator(pGetCoeff(pNext(ph)),r->cf);
2556  }
2557  poly p=ph;
2558  number n1=n_GetNumerator(pGetCoeff(p),r->cf);
2559  pIter(p);
2560  number n2=n_GetNumerator(pGetCoeff(p),r->cf);
2561  pIter(p);
2562  number d;
2563  number t;
2564  loop
2565  {
2566    nlNormalize(pGetCoeff(p),r->cf);
2567    t=n_GetNumerator(pGetCoeff(p),r->cf);
2568    if (nlGreaterZero(t,r->cf))
2569      d=nlAdd(n1,t,r->cf);
2570    else
2571      d=nlSub(n1,t,r->cf);
2572    nlDelete(&t,r->cf);
2573    nlDelete(&n1,r->cf);
2574    n1=d;
2575    pIter(p);
2576    if (p==NULL) break;
2577    nlNormalize(pGetCoeff(p),r->cf);
2578    t=n_GetNumerator(pGetCoeff(p),r->cf);
2579    if (nlGreaterZero(t,r->cf))
2580      d=nlAdd(n2,t,r->cf);
2581    else
2582      d=nlSub(n2,t,r->cf);
2583    nlDelete(&t,r->cf);
2584    nlDelete(&n2,r->cf);
2585    n2=d;
2586    pIter(p);
2587    if (p==NULL) break;
2588  }
2589  d=nlGcd(n1,n2,r->cf);
2590  nlDelete(&n1,r->cf);
2591  nlDelete(&n2,r->cf);
2592  return d;
2593}
2594#else
2595{
2596  number d=pGetCoeff(ph);
2597  int s;
2598  int s2=-1;
2599  if(rField_is_Q(r))
2600  {
2601    if  (SR_HDL(d)&SR_INT) return d;
2602    s=mpz_size1(d->z);
2603  }
2604  else
2605    s=n_Size(d,r->cf);
2606  number d2=d;
2607  loop
2608  {
2609    pIter(ph);
2610    if(ph==NULL)
2611    {
2612      if (s2==-1) return n_Copy(d,r->cf);
2613      break;
2614    }
2615    if (rField_is_Q(r))
2616    {
2617      if (SR_HDL(pGetCoeff(ph))&SR_INT)
2618      {
2619        s2=s;
2620        d2=d;
2621        s=0;
2622        d=pGetCoeff(ph);
2623        if (s2==0) break;
2624      }
2625      else if (mpz_size1((pGetCoeff(ph)->z))<=s)
2626      {
2627        s2=s;
2628        d2=d;
2629        d=pGetCoeff(ph);
2630        s=mpz_size1(d->z);
2631      }
2632    }
2633    else
2634    {
2635      int ns=n_Size(pGetCoeff(ph),r->cf);
2636      if (ns<=3)
2637      {
2638        s2=s;
2639        d2=d;
2640        d=pGetCoeff(ph);
2641        s=ns;
2642        if (s2<=3) break;
2643      }
2644      else if (ns<s)
2645      {
2646        s2=s;
2647        d2=d;
2648        d=pGetCoeff(ph);
2649        s=ns;
2650      }
2651    }
2652  }
2653  return n_SubringGcd(d,d2,r->cf);
2654}
2655#endif
2656
2657//void pContent(poly ph)
2658//{
2659//  number h,d;
2660//  poly p;
2661//
2662//  p = ph;
2663//  if(pNext(p)==NULL)
2664//  {
2665//    pSetCoeff(p,nInit(1));
2666//  }
2667//  else
2668//  {
2669//#ifdef PDEBUG
2670//    if (!pTest(p)) return;
2671//#endif
2672//    nNormalize(pGetCoeff(p));
2673//    if(!nGreaterZero(pGetCoeff(ph)))
2674//    {
2675//      ph = pNeg(ph);
2676//      nNormalize(pGetCoeff(p));
2677//    }
2678//    h=pGetCoeff(p);
2679//    pIter(p);
2680//    while (p!=NULL)
2681//    {
2682//      nNormalize(pGetCoeff(p));
2683//      if (nGreater(h,pGetCoeff(p))) h=pGetCoeff(p);
2684//      pIter(p);
2685//    }
2686//    h=nCopy(h);
2687//    p=ph;
2688//    while (p!=NULL)
2689//    {
2690//      d=n_Gcd(h,pGetCoeff(p));
2691//      nDelete(&h);
2692//      h = d;
2693//      if(nIsOne(h))
2694//      {
2695//        break;
2696//      }
2697//      pIter(p);
2698//    }
2699//    p = ph;
2700//    //number tmp;
2701//    if(!nIsOne(h))
2702//    {
2703//      while (p!=NULL)
2704//      {
2705//        d = nExactDiv(pGetCoeff(p),h);
2706//        pSetCoeff(p,d);
2707//        pIter(p);
2708//      }
2709//    }
2710//    nDelete(&h);
2711//    if ( (nGetChar() == 1) || (nGetChar() < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
2712//    {
2713//      pTest(ph);
2714//      singclap_divide_content(ph);
2715//      pTest(ph);
2716//    }
2717//  }
2718//}
2719#if 0
2720void p_Content(poly ph, const ring r)
2721{
2722  number h,d;
2723  poly p;
2724
2725  if(pNext(ph)==NULL)
2726  {
2727    p_SetCoeff(ph,n_Init(1,r->cf),r);
2728  }
2729  else
2730  {
2731    n_Normalize(pGetCoeff(ph),r->cf);
2732    if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2733    h=n_Copy(pGetCoeff(ph),r->cf);
2734    p = pNext(ph);
2735    while (p!=NULL)
2736    {
2737      n_Normalize(pGetCoeff(p),r->cf);
2738      d=n_Gcd(h,pGetCoeff(p),r->cf);
2739      n_Delete(&h,r->cf);
2740      h = d;
2741      if(n_IsOne(h,r->cf))
2742      {
2743        break;
2744      }
2745      pIter(p);
2746    }
2747    p = ph;
2748    //number tmp;
2749    if(!n_IsOne(h,r->cf))
2750    {
2751      while (p!=NULL)
2752      {
2753        //d = nDiv(pGetCoeff(p),h);
2754        //tmp = nExactDiv(pGetCoeff(p),h);
2755        //if (!nEqual(d,tmp))
2756        //{
2757        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
2758        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
2759        //  nWrite(tmp);Print(StringEndS("\n")); // NOTE/TODO: use StringAppendS("\n"); omFree(s);
2760        //}
2761        //nDelete(&tmp);
2762        d = n_ExactDiv(pGetCoeff(p),h,r->cf);
2763        p_SetCoeff(p,d,r->cf);
2764        pIter(p);
2765      }
2766    }
2767    n_Delete(&h,r->cf);
2768    //if ( (n_GetChar(r) == 1) || (n_GetChar(r) < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
2769    //{
2770    //  singclap_divide_content(ph);
2771    //  if(!n_GreaterZero(pGetCoeff(ph),r)) ph = p_Neg(ph,r);
2772    //}
2773  }
2774}
2775#endif
2776/* ---------------------------------------------------------------------------*/
2777/* cleardenom suff                                                           */
2778poly p_Cleardenom(poly p, const ring r)
2779{
2780  if( p == NULL )
2781    return NULL;
2782
2783  assume( r != NULL ); assume( r->cf != NULL ); const coeffs C = r->cf;
2784
2785#if CLEARENUMERATORS
2786  if( 0 )
2787  {
2788    CPolyCoeffsEnumerator itr(p);
2789    n_ClearDenominators(itr, C);
2790    n_ClearContent(itr, C); // divide out the content
2791    p_Test(p, r); n_Test(pGetCoeff(p), C);
2792    assume(n_GreaterZero(pGetCoeff(p), C)); // ??
2793//    if(!n_GreaterZero(pGetCoeff(p),C)) p = p_Neg(p,r);
2794    return p;
2795  }
2796#endif
2797
2798  number d, h;
2799
2800  if (rField_is_Ring(r))
2801  {
2802    p_ContentForGB(p,r);
2803    if(!n_GreaterZero(pGetCoeff(p),C)) p = p_Neg(p,r);
2804    return p;
2805  }
2806
2807  if (rField_is_Zp(r) && TEST_OPT_INTSTRATEGY)
2808  {
2809    if(!n_GreaterZero(pGetCoeff(p),C)) p = p_Neg(p,r);
2810    return p;
2811  }
2812
2813  assume(p != NULL);
2814
2815  if(pNext(p)==NULL)
2816  {
2817    if (!TEST_OPT_CONTENTSB
2818    && !rField_is_Ring(r))
2819      p_SetCoeff(p,n_Init(1,r->cf),r);
2820    else if(!n_GreaterZero(pGetCoeff(p),C))
2821      p = p_Neg(p,r);
2822    return p;
2823  }
2824
2825  assume(pNext(p)!=NULL);
2826  poly start=p;
2827
2828#if 0 && CLEARENUMERATORS
2829//CF: does not seem to work that well..
2830
2831  if( nCoeff_is_Q(C) || nCoeff_is_Q_a(C) )
2832  {
2833    CPolyCoeffsEnumerator itr(p);
2834    n_ClearDenominators(itr, C);
2835    n_ClearContent(itr, C); // divide out the content
2836    p_Test(p, r); n_Test(pGetCoeff(p), C);
2837    assume(n_GreaterZero(pGetCoeff(p), C)); // ??
2838//    if(!n_GreaterZero(pGetCoeff(p),C)) p = p_Neg(p,r);
2839    return start;
2840  }
2841#endif
2842
2843  if(1)
2844  {
2845    // get lcm of all denominators ----------------------------------
2846    h = n_Init(1,r->cf);
2847    while (p!=NULL)
2848    {
2849      n_Normalize(pGetCoeff(p),r->cf);
2850      d=n_NormalizeHelper(h,pGetCoeff(p),r->cf);
2851      n_Delete(&h,r->cf);
2852      h=d;
2853      pIter(p);
2854    }
2855    /* h now contains the 1/lcm of all denominators */
2856    if(!n_IsOne(h,r->cf))
2857    {
2858      // multiply by the lcm of all denominators
2859      p = start;
2860      while (p!=NULL)
2861      {
2862        d=n_Mult(h,pGetCoeff(p),r->cf);
2863        n_Normalize(d,r->cf);
2864        p_SetCoeff(p,d,r);
2865        pIter(p);
2866      }
2867    }
2868    n_Delete(&h,r->cf);
2869    p=start;
2870
2871    p_ContentForGB(p,r);
2872#ifdef HAVE_RATGRING
2873    if (rIsRatGRing(r))
2874    {
2875      /* quick unit detection in the rational case is done in gr_nc_bba */
2876      p_ContentRat(p, r);
2877      start=p;
2878    }
2879#endif
2880  }
2881
2882  if(!n_GreaterZero(pGetCoeff(p),C)) p = p_Neg(p,r);
2883
2884  return start;
2885}
2886
2887void p_Cleardenom_n(poly ph,const ring r,number &c)
2888{
2889  const coeffs C = r->cf;
2890  number d, h;
2891
2892  assume( ph != NULL );
2893
2894  poly p = ph;
2895
2896#if CLEARENUMERATORS
2897  if( 0 )
2898  {
2899    CPolyCoeffsEnumerator itr(ph);
2900
2901    n_ClearDenominators(itr, d, C); // multiply with common denom. d
2902    n_ClearContent(itr, h, C); // divide by the content h
2903
2904    c = n_Div(d, h, C); // d/h
2905
2906    n_Delete(&d, C);
2907    n_Delete(&h, C);
2908
2909    n_Test(c, C);
2910
2911    p_Test(ph, r); n_Test(pGetCoeff(ph), C);
2912    assume(n_GreaterZero(pGetCoeff(ph), C)); // ??
2913/*
2914    if(!n_GreaterZero(pGetCoeff(ph),C))
2915    {
2916      ph = p_Neg(ph,r);
2917      c = n_InpNeg(c, C);
2918    }
2919*/
2920    return;
2921  }
2922#endif
2923
2924
2925  if( pNext(p) == NULL )
2926  {
2927    if(!TEST_OPT_CONTENTSB)
2928    {
2929      c=n_Invers(pGetCoeff(p), C);
2930      p_SetCoeff(p, n_Init(1, C), r);
2931    }
2932    else
2933    {
2934      c=n_Init(1,C);
2935    }
2936
2937    if(!n_GreaterZero(pGetCoeff(ph),C))
2938    {
2939      ph = p_Neg(ph,r);
2940      c = n_InpNeg(c, C);
2941    }
2942
2943    return;
2944  }
2945  if (TEST_OPT_CONTENTSB) { c=n_Init(1,C); return; }
2946
2947  assume( pNext(p) != NULL );
2948
2949#if CLEARENUMERATORS
2950  if( nCoeff_is_Q(C) || nCoeff_is_Q_a(C) )
2951  {
2952    CPolyCoeffsEnumerator itr(ph);
2953
2954    n_ClearDenominators(itr, d, C); // multiply with common denom. d
2955    n_ClearContent(itr, h, C); // divide by the content h
2956
2957    c = n_Div(d, h, C); // d/h
2958
2959    n_Delete(&d, C);
2960    n_Delete(&h, C);
2961
2962    n_Test(c, C);
2963
2964    p_Test(ph, r); n_Test(pGetCoeff(ph), C);
2965    assume(n_GreaterZero(pGetCoeff(ph), C)); // ??
2966/*
2967    if(!n_GreaterZero(pGetCoeff(ph),C))
2968    {
2969      ph = p_Neg(ph,r);
2970      c = n_InpNeg(c, C);
2971    }
2972*/
2973    return;
2974  }
2975#endif
2976
2977
2978
2979
2980  if(1)
2981  {
2982    h = n_Init(1,r->cf);
2983    while (p!=NULL)
2984    {
2985      n_Normalize(pGetCoeff(p),r->cf);
2986      d=n_NormalizeHelper(h,pGetCoeff(p),r->cf);
2987      n_Delete(&h,r->cf);
2988      h=d;
2989      pIter(p);
2990    }
2991    c=h;
2992    /* contains the 1/lcm of all denominators */
2993    if(!n_IsOne(h,r->cf))
2994    {
2995      p = ph;
2996      while (p!=NULL)
2997      {
2998        /* should be: // NOTE: don't use ->coef!!!!
2999        * number hh;
3000        * nGetDenom(p->coef,&hh);
3001        * nMult(&h,&hh,&d);
3002        * nNormalize(d);
3003        * nDelete(&hh);
3004        * nMult(d,p->coef,&hh);
3005        * nDelete(&d);
3006        * nDelete(&(p->coef));
3007        * p->coef =hh;
3008        */
3009        d=n_Mult(h,pGetCoeff(p),r->cf);
3010        n_Normalize(d,r->cf);
3011        p_SetCoeff(p,d,r);
3012        pIter(p);
3013      }
3014      if (rField_is_Q_a(r))
3015      {
3016        loop
3017        {
3018          h = n_Init(1,r->cf);
3019          p=ph;
3020          while (p!=NULL)
3021          {
3022            d=n_NormalizeHelper(h,pGetCoeff(p),r->cf);
3023            n_Delete(&h,r->cf);
3024            h=d;
3025            pIter(p);
3026          }
3027          /* contains the 1/lcm of all denominators */
3028          if(!n_IsOne(h,r->cf))
3029          {
3030            p = ph;
3031            while (p!=NULL)
3032            {
3033              /* should be: // NOTE: don't use ->coef!!!!
3034              * number hh;
3035              * nGetDenom(p->coef,&hh);
3036              * nMult(&h,&hh,&d);
3037              * nNormalize(d);
3038              * nDelete(&hh);
3039              * nMult(d,p->coef,&hh);
3040              * nDelete(&d);
3041              * nDelete(&(p->coef));
3042              * p->coef =hh;
3043              */
3044              d=n_Mult(h,pGetCoeff(p),r->cf);
3045              n_Normalize(d,r->cf);
3046              p_SetCoeff(p,d,r);
3047              pIter(p);
3048            }
3049            number t=n_Mult(c,h,r->cf);
3050            n_Delete(&c,r->cf);
3051            c=t;
3052          }
3053          else
3054          {
3055            break;
3056          }
3057          n_Delete(&h,r->cf);
3058        }
3059      }
3060    }
3061  }
3062
3063  if(!n_GreaterZero(pGetCoeff(ph),C))
3064  {
3065    ph = p_Neg(ph,r);
3066    c = n_InpNeg(c, C);
3067  }
3068
3069}
3070
3071  // normalization: for poly over Q: make poly primitive, integral
3072  //                              Qa make poly integral with leading
3073  //                                  coefficient minimal in N
3074  //                            Q(t) make poly primitive, integral
3075
3076void p_ProjectiveUnique(poly ph, const ring r)
3077{
3078  if( ph == NULL )
3079    return;
3080
3081  assume( r != NULL ); assume( r->cf != NULL ); const coeffs C = r->cf;
3082
3083  number h;
3084  poly p;
3085
3086  if (rField_is_Ring(r))
3087  {
3088    p_ContentForGB(ph,r);
3089    if(!n_GreaterZero(pGetCoeff(ph),C)) ph = p_Neg(ph,r);
3090        assume( n_GreaterZero(pGetCoeff(ph),C) );
3091    return;
3092  }
3093
3094  if (rField_is_Zp(r) && TEST_OPT_INTSTRATEGY)
3095  {
3096    assume( n_GreaterZero(pGetCoeff(ph),C) );
3097    if(!n_GreaterZero(pGetCoeff(ph),C)) ph = p_Neg(ph,r);
3098    return;
3099  }
3100  p = ph;
3101
3102  assume(p != NULL);
3103
3104  if(pNext(p)==NULL) // a monomial
3105  {
3106    p_SetCoeff(p, n_Init(1, C), r);
3107    return;
3108  }
3109
3110  assume(pNext(p)!=NULL);
3111
3112  if(!rField_is_Q(r) && !nCoeff_is_transExt(C))
3113  {
3114    h = p_GetCoeff(p, C);
3115    number hInv = n_Invers(h, C);
3116    pIter(p);
3117    while (p!=NULL)
3118    {
3119      p_SetCoeff(p, n_Mult(p_GetCoeff(p, C), hInv, C), r);
3120      pIter(p);
3121    }
3122    n_Delete(&hInv, C);
3123    p = ph;
3124    p_SetCoeff(p, n_Init(1, C), r);
3125  }
3126
3127  p_Cleardenom(ph, r); //removes also Content
3128
3129
3130    /* normalize ph over a transcendental extension s.t.
3131       lead (ph) is > 0 if extRing->cf == Q
3132       or lead (ph) is monic if extRing->cf == Zp*/
3133  if (nCoeff_is_transExt(C))
3134  {
3135    p= ph;
3136    h= p_GetCoeff (p, C);
3137    fraction f = (fraction) h;
3138    number n=p_GetCoeff (NUM (f),C->extRing->cf);
3139    if (rField_is_Q (C->extRing))
3140    {
3141      if (!n_GreaterZero(n,C->extRing->cf))
3142      {
3143        p=p_Neg (p,r);
3144      }
3145    }
3146    else if (rField_is_Zp(C->extRing))
3147    {
3148      if (!n_IsOne (n, C->extRing->cf))
3149      {
3150        n=n_Invers (n,C->extRing->cf);
3151        nMapFunc nMap;
3152        nMap= n_SetMap (C->extRing->cf, C);
3153        number ninv= nMap (n,C->extRing->cf, C);
3154        p=__p_Mult_nn (p, ninv, r);
3155        n_Delete (&ninv, C);
3156        n_Delete (&n, C->extRing->cf);
3157      }
3158    }
3159    p= ph;
3160  }
3161
3162  return;
3163}
3164
3165#if 0   /*unused*/
3166number p_GetAllDenom(poly ph, const ring r)
3167{
3168  number d=n_Init(1,r->cf);
3169  poly p = ph;
3170
3171  while (p!=NULL)
3172  {
3173    number h=n_GetDenom(pGetCoeff(p),r->cf);
3174    if (!n_IsOne(h,r->cf))
3175    {
3176      number dd=n_Mult(d,h,r->cf);
3177      n_Delete(&d,r->cf);
3178      d=dd;
3179    }
3180    n_Delete(&h,r->cf);
3181    pIter(p);
3182  }
3183  return d;
3184}
3185#endif
3186
3187int p_Size(poly p, const ring r)
3188{
3189  int count = 0;
3190  if (r->cf->has_simple_Alloc)
3191    return pLength(p);
3192  while ( p != NULL )
3193  {
3194    count+= n_Size( pGetCoeff( p ), r->cf );
3195    pIter( p );
3196  }
3197  return count;
3198}
3199
3200/*2
3201*make p homogeneous by multiplying the monomials by powers of x_varnum
3202*assume: deg(var(varnum))==1
3203*/
3204poly p_Homogen (poly p, int varnum, const ring r)
3205{
3206  pFDegProc deg;
3207  if (r->pLexOrder && (r->order[0]==ringorder_lp))
3208    deg=p_Totaldegree;
3209  else
3210    deg=r->pFDeg;
3211
3212  poly q=NULL, qn;
3213  int  o,ii;
3214  sBucket_pt bp;
3215
3216  if (p!=NULL)
3217  {
3218    if ((varnum < 1) || (varnum > rVar(r)))
3219    {
3220      return NULL;
3221    }
3222    o=deg(p,r);
3223    q=pNext(p);
3224    while (q != NULL)
3225    {
3226      ii=deg(q,r);
3227      if (ii>o) o=ii;
3228      pIter(q);
3229    }
3230    q = p_Copy(p,r);
3231    bp = sBucketCreate(r);
3232    while (q != NULL)
3233    {
3234      ii = o-deg(q,r);
3235      if (ii!=0)
3236      {
3237        p_AddExp(q,varnum, (long)ii,r);
3238        p_Setm(q,r);
3239      }
3240      qn = pNext(q);
3241      pNext(q) = NULL;
3242      sBucket_Add_m(bp, q);
3243      q = qn;
3244    }
3245    sBucketDestroyAdd(bp, &q, &ii);
3246  }
3247  return q;
3248}
3249
3250/*2
3251*tests if p is homogeneous with respect to the actual weigths
3252*/
3253BOOLEAN p_IsHomogeneous (poly p, const ring r)
3254{
3255  poly qp=p;
3256  int o;
3257
3258  if ((p == NULL) || (pNext(p) == NULL)) return TRUE;
3259  pFDegProc d;
3260  if (r->pLexOrder && (r->order[0]==ringorder_lp))
3261    d=p_Totaldegree;
3262  else
3263    d=r->pFDeg;
3264  o = d(p,r);
3265  do
3266  {
3267    if (d(qp,r) != o) return FALSE;
3268    pIter(qp);
3269  }
3270  while (qp != NULL);
3271  return TRUE;
3272}
3273
3274/*----------utilities for syzygies--------------*/
3275BOOLEAN   p_VectorHasUnitB(poly p, int * k, const ring r)
3276{
3277  poly q=p,qq;
3278  int i;
3279
3280  while (q!=NULL)
3281  {
3282    if (p_LmIsConstantComp(q,r))
3283    {
3284      i = __p_GetComp(q,r);
3285      qq = p;
3286      while ((qq != q) && (__p_GetComp(qq,r) != i)) pIter(qq);
3287      if (qq == q)
3288      {
3289        *k = i;
3290        return TRUE;
3291      }
3292    }
3293    pIter(q);
3294  }
3295  return FALSE;
3296}
3297
3298void   p_VectorHasUnit(poly p, int * k, int * len, const ring r)
3299{
3300  poly q=p,qq;
3301  int i,j=0;
3302
3303  *len = 0;
3304  while (q!=NULL)
3305  {
3306    if (p_LmIsConstantComp(q,r))
3307    {
3308      i = __p_GetComp(q,r);
3309      qq = p;
3310      while ((qq != q) && (__p_GetComp(qq,r) != i)) pIter(qq);
3311      if (qq == q)
3312      {
3313       j = 0;
3314       while (qq!=NULL)
3315       {
3316         if (__p_GetComp(qq,r)==i) j++;
3317        pIter(qq);
3318       }
3319       if ((*len == 0) || (j<*len))
3320       {
3321         *len = j;
3322         *k = i;
3323       }
3324      }
3325    }
3326    pIter(q);
3327  }
3328}
3329
3330poly p_TakeOutComp1(poly * p, int k, const ring r)
3331{
3332  poly q = *p;
3333
3334  if (q==NULL) return NULL;
3335
3336  poly qq=NULL,result = NULL;
3337
3338  if (__p_GetComp(q,r)==k)
3339  {
3340    result = q; /* *p */
3341    while ((q!=NULL) && (__p_GetComp(q,r)==k))
3342    {
3343      p_SetComp(q,0,r);
3344      p_SetmComp(q,r);
3345      qq = q;
3346      pIter(q);
3347    }
3348    *p = q;
3349    pNext(qq) = NULL;
3350  }
3351  if (q==NULL) return result;
3352//  if (pGetComp(q) > k) pGetComp(q)--;
3353  while (pNext(q)!=NULL)
3354  {
3355    if (__p_GetComp(pNext(q),r)==k)
3356    {
3357      if (result==NULL)
3358      {
3359        result = pNext(q);
3360        qq = result;
3361      }
3362      else
3363      {
3364        pNext(qq) = pNext(q);
3365        pIter(qq);
3366      }
3367      pNext(q) = pNext(pNext(q));
3368      pNext(qq) =NULL;
3369      p_SetComp(qq,0,r);
3370      p_SetmComp(qq,r);
3371    }
3372    else
3373    {
3374      pIter(q);
3375//      if (pGetComp(q) > k) pGetComp(q)--;
3376    }
3377  }
3378  return result;
3379}
3380
3381poly p_TakeOutComp(poly * p, int k, const ring r)
3382{
3383  poly q = *p,qq=NULL,result = NULL;
3384
3385  if (q==NULL) return NULL;
3386  BOOLEAN use_setmcomp=rOrd_SetCompRequiresSetm(r);
3387  if (__p_GetComp(q,r)==k)
3388  {
3389    result = q;
3390    do
3391    {
3392      p_SetComp(q,0,r);
3393      if (use_setmcomp) p_SetmComp(q,r);
3394      qq = q;
3395      pIter(q);
3396    }
3397    while ((q!=NULL) && (__p_GetComp(q,r)==k));
3398    *p = q;
3399    pNext(qq) = NULL;
3400  }
3401  if (q==NULL) return result;
3402  if (__p_GetComp(q,r) > k)
3403  {
3404    p_SubComp(q,1,r);
3405    if (use_setmcomp) p_SetmComp(q,r);
3406  }
3407  poly pNext_q;
3408  while ((pNext_q=pNext(q))!=NULL)
3409  {
3410    if (__p_GetComp(pNext_q,r)==k)
3411    {
3412      if (result==NULL)
3413      {
3414        result = pNext_q;
3415        qq = result;
3416      }
3417      else
3418      {
3419        pNext(qq) = pNext_q;
3420        pIter(qq);
3421      }
3422      pNext(q) = pNext(pNext_q);
3423      pNext(qq) =NULL;
3424      p_SetComp(qq,0,r);
3425      if (use_setmcomp) p_SetmComp(qq,r);
3426    }
3427    else
3428    {
3429      /*pIter(q);*/ q=pNext_q;
3430      if (__p_GetComp(q,r) > k)
3431      {
3432        p_SubComp(q,1,r);
3433        if (use_setmcomp) p_SetmComp(q,r);
3434      }
3435    }
3436  }
3437  return result;
3438}
3439
3440// Splits *p into two polys: *q which consists of all monoms with
3441// component == comp and *p of all other monoms *lq == pLength(*q)
3442void p_TakeOutComp(poly *r_p, long comp, poly *r_q, int *lq, const ring r)
3443{
3444  spolyrec pp, qq;
3445  poly p, q, p_prev;
3446  int l = 0;
3447
3448#ifdef HAVE_ASSUME
3449  int lp = pLength(*r_p);
3450#endif
3451
3452  pNext(&pp) = *r_p;
3453  p = *r_p;
3454  p_prev = &pp;
3455  q = &qq;
3456
3457  while(p != NULL)
3458  {
3459    while (__p_GetComp(p,r) == comp)
3460    {
3461      pNext(q) = p;
3462      pIter(q);
3463      p_SetComp(p, 0,r);
3464      p_SetmComp(p,r);
3465      pIter(p);
3466      l++;
3467      if (p == NULL)
3468      {
3469        pNext(p_prev) = NULL;
3470        goto Finish;
3471      }
3472    }
3473    pNext(p_prev) = p;
3474    p_prev = p;
3475    pIter(p);
3476  }
3477
3478  Finish:
3479  pNext(q) = NULL;
3480  *r_p = pNext(&pp);
3481  *r_q = pNext(&qq);
3482  *lq = l;
3483#ifdef HAVE_ASSUME
3484  assume(pLength(*r_p) + pLength(*r_q) == lp);
3485#endif
3486  p_Test(*r_p,r);
3487  p_Test(*r_q,r);
3488}
3489
3490void p_DeleteComp(poly * p,int k, const ring r)
3491{
3492  poly q;
3493
3494  while ((*p!=NULL) && (__p_GetComp(*p,r)==k)) p_LmDelete(p,r);
3495  if (*p==NULL) return;
3496  q = *p;
3497  if (__p_GetComp(q,r)>k)
3498  {
3499    p_SubComp(q,1,r);
3500    p_SetmComp(q,r);
3501  }
3502  while (pNext(q)!=NULL)
3503  {
3504    if (__p_GetComp(pNext(q),r)==k)
3505      p_LmDelete(&(pNext(q)),r);
3506    else
3507    {
3508      pIter(q);
3509      if (__p_GetComp(q,r)>k)
3510      {
3511        p_SubComp(q,1,r);
3512        p_SetmComp(q,r);
3513      }
3514    }
3515  }
3516}
3517
3518/*2
3519* convert a vector to a set of polys,
3520* allocates the polyset, (entries 0..(*len)-1)
3521* the vector will not be changed
3522*/
3523void  p_Vec2Polys(poly v, poly* *p, int *len, const ring r)
3524{
3525  poly h;
3526  int k;
3527
3528  *len=p_MaxComp(v,r);
3529  if (*len==0) *len=1;
3530  *p=(poly*)omAlloc0((*len)*sizeof(poly));
3531  while (v!=NULL)
3532  {
3533    h=p_Head(v,r);
3534    k=__p_GetComp(h,r);
3535    p_SetComp(h,0,r);
3536    (*p)[k-1]=p_Add_q((*p)[k-1],h,r);
3537    pIter(v);
3538  }
3539}
3540
3541//
3542// resets the pFDeg and pLDeg: if pLDeg is not given, it is
3543// set to currRing->pLDegOrig, i.e. to the respective LDegProc which
3544// only uses pFDeg (and not p_Deg, or pTotalDegree, etc)
3545void pSetDegProcs(ring r, pFDegProc new_FDeg, pLDegProc new_lDeg)
3546{
3547  assume(new_FDeg != NULL);
3548  r->pFDeg = new_FDeg;
3549
3550  if (new_lDeg == NULL)
3551    new_lDeg = r->pLDegOrig;
3552
3553  r->pLDeg = new_lDeg;
3554}
3555
3556// restores pFDeg and pLDeg:
3557void pRestoreDegProcs(ring r, pFDegProc old_FDeg, pLDegProc old_lDeg)
3558{
3559  assume(old_FDeg != NULL && old_lDeg != NULL);
3560  r->pFDeg = old_FDeg;
3561  r->pLDeg = old_lDeg;
3562}
3563
3564/*-------- several access procedures to monomials -------------------- */
3565/*
3566* the module weights for std
3567*/
3568static pFDegProc pOldFDeg;
3569static pLDegProc pOldLDeg;
3570static BOOLEAN pOldLexOrder;
3571
3572static long pModDeg(poly p, ring r)
3573{
3574  long d=pOldFDeg(p, r);
3575  int c=__p_GetComp(p, r);
3576  if ((c>0) && ((r->pModW)->range(c-1))) d+= (*(r->pModW))[c-1];
3577  return d;
3578  //return pOldFDeg(p, r)+(*pModW)[p_GetComp(p, r)-1];
3579}
3580
3581void p_SetModDeg(intvec *w, ring r)
3582{
3583  if (w!=NULL)
3584  {
3585    r->pModW = w;
3586    pOldFDeg = r->pFDeg;
3587    pOldLDeg = r->pLDeg;
3588    pOldLexOrder = r->pLexOrder;
3589    pSetDegProcs(r,pModDeg);
3590    r->pLexOrder = TRUE;
3591  }
3592  else
3593  {
3594    r->pModW = NULL;
3595    pRestoreDegProcs(r,pOldFDeg, pOldLDeg);
3596    r->pLexOrder = pOldLexOrder;
3597  }
3598}
3599
3600/*2
3601* handle memory request for sets of polynomials (ideals)
3602* l is the length of *p, increment is the difference (may be negative)
3603*/
3604void pEnlargeSet(poly* *p, int l, int increment)
3605{
3606  poly* h;
3607
3608  if (*p==NULL)
3609  {
3610    if (increment==0) return;
3611    h=(poly*)omAlloc0(increment*sizeof(poly));
3612  }
3613  else
3614  {
3615    h=(poly*)omReallocSize((poly*)*p,l*sizeof(poly),(l+increment)*sizeof(poly));
3616    if (increment>0)
3617    {
3618      //for (i=l; i<l+increment; i++)
3619      //  h[i]=NULL;
3620      memset(&(h[l]),0,increment*sizeof(poly));
3621    }
3622  }
3623  *p=h;
3624}
3625
3626/*2
3627*divides p1 by its leading coefficient
3628*/
3629void p_Norm(poly p1, const ring r)
3630{
3631  if (rField_is_Ring(r))
3632  {
3633    if (!n_IsUnit(pGetCoeff(p1), r->cf)) return;
3634    // Werror("p_Norm not possible in the case of coefficient rings.");
3635  }
3636  else if (p1!=NULL)
3637  {
3638    if (pNext(p1)==NULL)
3639    {
3640      p_SetCoeff(p1,n_Init(1,r->cf),r);
3641      return;
3642    }
3643    poly h;
3644    if (!n_IsOne(pGetCoeff(p1),r->cf))
3645    {
3646      number k, c;
3647      n_Normalize(pGetCoeff(p1),r->cf);
3648      k = pGetCoeff(p1);
3649      c = n_Init(1,r->cf);
3650      pSetCoeff0(p1,c);
3651      h = pNext(p1);
3652      while (h!=NULL)
3653      {
3654        c=n_Div(pGetCoeff(h),k,r->cf);
3655        // no need to normalize: Z/p, R
3656        // normalize already in nDiv: Q_a, Z/p_a
3657        // remains: Q
3658        if (rField_is_Q(r) && (!n_IsOne(c,r->cf))) n_Normalize(c,r->cf);
3659        p_SetCoeff(h,c,r);
3660        pIter(h);
3661      }
3662      n_Delete(&k,r->cf);
3663    }
3664    else
3665    {
3666      //if (r->cf->cfNormalize != nDummy2) //TODO: OPTIMIZE
3667      {
3668        h = pNext(p1);
3669        while (h!=NULL)
3670        {
3671          n_Normalize(pGetCoeff(h),r->cf);
3672          pIter(h);
3673        }
3674      }
3675    }
3676  }
3677}
3678
3679/*2
3680*normalize all coefficients
3681*/
3682void p_Normalize(poly p,const ring r)
3683{
3684  if (rField_has_simple_inverse(r)) return; /* Z/p, GF(p,n), R, long R/C */
3685  while (p!=NULL)
3686  {
3687    // no test befor n_Normalize: n_Normalize should fix problems
3688    n_Normalize(pGetCoeff(p),r->cf);
3689    pIter(p);
3690  }
3691}
3692
3693// splits p into polys with Exp(n) == 0 and Exp(n) != 0
3694// Poly with Exp(n) != 0 is reversed
3695static void p_SplitAndReversePoly(poly p, int n, poly *non_zero, poly *zero, const ring r)
3696{
3697  if (p == NULL)
3698  {
3699    *non_zero = NULL;
3700    *zero = NULL;
3701    return;
3702  }
3703  spolyrec sz;
3704  poly z, n_z, next;
3705  z = &sz;
3706  n_z = NULL;
3707
3708  while(p != NULL)
3709  {
3710    next = pNext(p);
3711    if (p_GetExp(p, n,r) == 0)
3712    {
3713      pNext(z) = p;
3714      pIter(z);
3715    }
3716    else
3717    {
3718      pNext(p) = n_z;
3719      n_z = p;
3720    }
3721    p = next;
3722  }
3723  pNext(z) = NULL;
3724  *zero = pNext(&sz);
3725  *non_zero = n_z;
3726}
3727/*3
3728* substitute the n-th variable by 1 in p
3729* destroy p
3730*/
3731static poly p_Subst1 (poly p,int n, const ring r)
3732{
3733  poly qq=NULL, result = NULL;
3734  poly zero=NULL, non_zero=NULL;
3735
3736  // reverse, so that add is likely to be linear
3737  p_SplitAndReversePoly(p, n, &non_zero, &zero,r);
3738
3739  while (non_zero != NULL)
3740  {
3741    assume(p_GetExp(non_zero, n,r) != 0);
3742    qq = non_zero;
3743    pIter(non_zero);
3744    qq->next = NULL;
3745    p_SetExp(qq,n,0,r);
3746    p_Setm(qq,r);
3747    result = p_Add_q(result,qq,r);
3748  }
3749  p = p_Add_q(result, zero,r);
3750  p_Test(p,r);
3751  return p;
3752}
3753
3754/*3
3755* substitute the n-th variable by number e in p
3756* destroy p
3757*/
3758static poly p_Subst2 (poly p,int n, number e, const ring r)
3759{
3760  assume( ! n_IsZero(e,r->cf) );
3761  poly qq,result = NULL;
3762  number nn, nm;
3763  poly zero, non_zero;
3764
3765  // reverse, so that add is likely to be linear
3766  p_SplitAndReversePoly(p, n, &non_zero, &zero,r);
3767
3768  while (non_zero != NULL)
3769  {
3770    assume(p_GetExp(non_zero, n, r) != 0);
3771    qq = non_zero;
3772    pIter(non_zero);
3773    qq->next = NULL;
3774    n_Power(e, p_GetExp(qq, n, r), &nn,r->cf);
3775    nm = n_Mult(nn, pGetCoeff(qq),r->cf);
3776#ifdef HAVE_RINGS
3777    if (n_IsZero(nm,r->cf))
3778    {
3779      p_LmFree(&qq,r);
3780      n_Delete(&nm,r->cf);
3781    }
3782    else
3783#endif
3784    {
3785      p_SetCoeff(qq, nm,r);
3786      p_SetExp(qq, n, 0,r);
3787      p_Setm(qq,r);
3788      result = p_Add_q(result,qq,r);
3789    }
3790    n_Delete(&nn,r->cf);
3791  }
3792  p = p_Add_q(result, zero,r);
3793  p_Test(p,r);
3794  return p;
3795}
3796
3797
3798/* delete monoms whose n-th exponent is different from zero */
3799static poly p_Subst0(poly p, int n, const ring r)
3800{
3801  spolyrec res;
3802  poly h = &res;
3803  pNext(h) = p;
3804
3805  while (pNext(h)!=NULL)
3806  {
3807    if (p_GetExp(pNext(h),n,r)!=0)
3808    {
3809      p_LmDelete(&pNext(h),r);
3810    }
3811    else
3812    {
3813      pIter(h);
3814    }
3815  }
3816  p_Test(pNext(&res),r);
3817  return pNext(&res);
3818}
3819
3820/*2
3821* substitute the n-th variable by e in p
3822* destroy p
3823*/
3824poly p_Subst(poly p, int n, poly e, const ring r)
3825{
3826  if (e == NULL) return p_Subst0(p, n,r);
3827
3828  if (p_IsConstant(e,r))
3829  {
3830    if (n_IsOne(pGetCoeff(e),r->cf)) return p_Subst1(p,n,r);
3831    else return p_Subst2(p, n, pGetCoeff(e),r);
3832  }
3833
3834#ifdef HAVE_PLURAL
3835  if (rIsPluralRing(r))
3836  {
3837    return nc_pSubst(p,n,e,r);
3838  }
3839#endif
3840
3841  int exponent,i;
3842  poly h, res, m;
3843  int *me,*ee;
3844  number nu,nu1;
3845
3846  me=(int *)omAlloc((rVar(r)+1)*sizeof(int));
3847  ee=(int *)omAlloc((rVar(r)+1)*sizeof(int));
3848  if (e!=NULL) p_GetExpV(e,ee,r);
3849  res=NULL;
3850  h=p;
3851  while (h!=NULL)
3852  {
3853    if ((e!=NULL) || (p_GetExp(h,n,r)==0))
3854    {
3855      m=p_Head(h,r);
3856      p_GetExpV(m,me,r);
3857      exponent=me[n];
3858      me[n]=0;
3859      for(i=rVar(r);i>0;i--)
3860        me[i]+=exponent*ee[i];
3861      p_SetExpV(m,me,r);
3862      if (e!=NULL)
3863      {
3864        n_Power(pGetCoeff(e),exponent,&nu,r->cf);
3865        nu1=n_Mult(pGetCoeff(m),nu,r->cf);
3866        n_Delete(&nu,r->cf);
3867        p_SetCoeff(m,nu1,r);
3868      }
3869      res=p_Add_q(res,m,r);
3870    }
3871    p_LmDelete(&h,r);
3872  }
3873  omFreeSize((ADDRESS)me,(rVar(r)+1)*sizeof(int));
3874  omFreeSize((ADDRESS)ee,(rVar(r)+1)*sizeof(int));
3875  return res;
3876}
3877
3878/*2
3879 * returns a re-ordered convertion of a number as a polynomial,
3880 * with permutation of parameters
3881 * NOTE: this only works for Frank's alg. & trans. fields
3882 */
3883poly n_PermNumber(const number z, const int *par_perm, const int , const ring src, const ring dst)
3884{
3885#if 0
3886  PrintS("\nSource Ring: \n");
3887  rWrite(src);
3888
3889  if(0)
3890  {
3891    number zz = n_Copy(z, src->cf);
3892    PrintS("z: "); n_Write(zz, src);
3893    n_Delete(&zz, src->cf);
3894  }
3895
3896  PrintS("\nDestination Ring: \n");
3897  rWrite(dst);
3898
3899  /*Print("\nOldPar: %d\n", OldPar);
3900  for( int i = 1; i <= OldPar; i++ )
3901  {
3902    Print("par(%d) -> par/var (%d)\n", i, par_perm[i-1]);
3903  }*/
3904#endif
3905  if( z == NULL )
3906     return NULL;
3907
3908  const coeffs srcCf = src->cf;
3909  assume( srcCf != NULL );
3910
3911  assume( !nCoeff_is_GF(srcCf) );
3912  assume( src->cf->extRing!=NULL );
3913
3914  poly zz = NULL;
3915
3916  const ring srcExtRing = srcCf->extRing;
3917  assume( srcExtRing != NULL );
3918
3919  const coeffs dstCf = dst->cf;
3920  assume( dstCf != NULL );
3921
3922  if( nCoeff_is_algExt(srcCf) ) // nCoeff_is_GF(srcCf)?
3923  {
3924    zz = (poly) z;
3925    if( zz == NULL ) return NULL;
3926  }
3927  else if (nCoeff_is_transExt(srcCf))
3928  {
3929    assume( !IS0(z) );
3930
3931    zz = NUM((fraction)z);
3932    p_Test (zz, srcExtRing);
3933
3934    if( zz == NULL ) return NULL;
3935    if( !DENIS1((fraction)z) )
3936    {
3937      if (!p_IsConstant(DEN((fraction)z),srcExtRing))
3938        WarnS("Not defined: Cannot map a rational fraction and make a polynomial out of it! Ignoring the denominator.");
3939    }
3940  }
3941  else
3942  {
3943    assume (FALSE);
3944    WerrorS("Number permutation is not implemented for this data yet!");
3945    return NULL;
3946  }
3947
3948  assume( zz != NULL );
3949  p_Test (zz, srcExtRing);
3950
3951  nMapFunc nMap = n_SetMap(srcExtRing->cf, dstCf);
3952
3953  assume( nMap != NULL );
3954
3955  poly qq;
3956  if ((par_perm == NULL) && (rPar(dst) != 0 && rVar (srcExtRing) > 0))
3957  {
3958    int* perm;
3959    perm=(int *)omAlloc0((rVar(srcExtRing)+1)*sizeof(int));
3960    perm[0]= 0;
3961    for(int i=si_min(rVar(srcExtRing),rPar(dst));i>0;i--)
3962      perm[i]=-i;
3963    qq = p_PermPoly(zz, perm, srcExtRing, dst, nMap, NULL, rVar(srcExtRing)-1);
3964    omFreeSize ((ADDRESS)perm, (rVar(srcExtRing)+1)*sizeof(int));
3965  }
3966  else
3967    qq = p_PermPoly(zz, par_perm-1, srcExtRing, dst, nMap, NULL, rVar (srcExtRing)-1);
3968
3969  if(nCoeff_is_transExt(srcCf)
3970  && (!DENIS1((fraction)z))
3971  && p_IsConstant(DEN((fraction)z),srcExtRing))
3972  {
3973    number n=nMap(pGetCoeff(DEN((fraction)z)),srcExtRing->cf, dstCf);
3974    qq=p_Div_nn(qq,n,dst);
3975    n_Delete(&n,dstCf);
3976    p_Normalize(qq,dst);
3977  }
3978  p_Test (qq, dst);
3979
3980  return qq;
3981}
3982
3983
3984/*2
3985*returns a re-ordered copy of a polynomial, with permutation of the variables
3986*/
3987poly p_PermPoly (poly p, const int * perm, const ring oldRing, const ring dst,
3988       nMapFunc nMap, const int *par_perm, int OldPar, BOOLEAN use_mult)
3989{
3990#if 0
3991    p_Test(p, oldRing);
3992    PrintS("p_PermPoly::p: "); p_Write(p, oldRing, oldRing);
3993#endif
3994  const int OldpVariables = rVar(oldRing);
3995  poly result = NULL;
3996  poly result_last = NULL;
3997  poly aq = NULL; /* the map coefficient */
3998  poly qq; /* the mapped monomial */
3999  assume(dst != NULL);
4000  assume(dst->cf != NULL);
4001  #ifdef HAVE_PLURAL
4002  poly tmp_mm=p_One(dst);
4003  #endif
4004  while (p != NULL)
4005  {
4006    // map the coefficient
4007    if ( ((OldPar == 0) || (par_perm == NULL) || rField_is_GF(oldRing) || (nMap==ndCopyMap))
4008    && (nMap != NULL) )
4009    {
4010      qq = p_Init(dst);
4011      assume( nMap != NULL );
4012      number n = nMap(p_GetCoeff(p, oldRing), oldRing->cf, dst->cf);
4013      n_Test (n,dst->cf);
4014      if ( nCoeff_is_algExt(dst->cf) )
4015        n_Normalize(n, dst->cf);
4016      p_GetCoeff(qq, dst) = n;// Note: n can be a ZERO!!!
4017    }
4018    else
4019    {
4020      qq = p_One(dst);
4021//      aq = naPermNumber(p_GetCoeff(p, oldRing), par_perm, OldPar, oldRing); // no dst???
4022//      poly    n_PermNumber(const number z, const int *par_perm, const int P, const ring src, const ring dst)
4023      aq = n_PermNumber(p_GetCoeff(p, oldRing), par_perm, OldPar, oldRing, dst);
4024      p_Test(aq, dst);
4025      if ( nCoeff_is_algExt(dst->cf) )
4026        p_Normalize(aq,dst);
4027      if (aq == NULL)
4028        p_SetCoeff(qq, n_Init(0, dst->cf),dst); // Very dirty trick!!!
4029      p_Test(aq, dst);
4030    }
4031    if (rRing_has_Comp(dst))
4032       p_SetComp(qq, p_GetComp(p, oldRing), dst);
4033    if ( n_IsZero(pGetCoeff(qq), dst->cf) )
4034    {
4035      p_LmDelete(&qq,dst);
4036      qq = NULL;
4037    }
4038    else
4039    {
4040      // map pars:
4041      int mapped_to_par = 0;
4042      for(int i = 1; i <= OldpVariables; i++)
4043      {
4044        int e = p_GetExp(p, i, oldRing);
4045        if (e != 0)
4046        {
4047          if (perm==NULL)
4048            p_SetExp(qq, i, e, dst);
4049          else if (perm[i]>0)
4050          {
4051            #ifdef HAVE_PLURAL
4052            if(use_mult)
4053            {
4054              p_SetExp(tmp_mm,perm[i],e,dst);
4055              p_Setm(tmp_mm,dst);
4056              qq=p_Mult_mm(qq,tmp_mm,dst);
4057              p_SetExp(tmp_mm,perm[i],0,dst);
4058
4059            }
4060            else
4061            #endif
4062            p_AddExp(qq,perm[i], e/*p_GetExp( p,i,oldRing)*/, dst);
4063          }
4064          else if (perm[i]<0)
4065          {
4066            number c = p_GetCoeff(qq, dst);
4067            if (rField_is_GF(dst))
4068            {
4069              assume( dst->cf->extRing == NULL );
4070              number ee = n_Param(1, dst);
4071              number eee;
4072              n_Power(ee, e, &eee, dst->cf); //nfDelete(ee,dst);
4073              ee = n_Mult(c, eee, dst->cf);
4074              //nfDelete(c,dst);nfDelete(eee,dst);
4075              pSetCoeff0(qq,ee);
4076            }
4077            else if (nCoeff_is_Extension(dst->cf))
4078            {
4079              const int par = -perm[i];
4080              assume( par > 0 );
4081//              WarnS("longalg missing 3");
4082#if 1
4083              const coeffs C = dst->cf;
4084              assume( C != NULL );
4085              const ring R = C->extRing;
4086              assume( R != NULL );
4087              assume( par <= rVar(R) );
4088              poly pcn; // = (number)c
4089              assume( !n_IsZero(c, C) );
4090              if( nCoeff_is_algExt(C) )
4091                 pcn = (poly) c;
4092               else //            nCoeff_is_transExt(C)
4093                 pcn = NUM((fraction)c);
4094              if (pNext(pcn) == NULL) // c->z
4095                p_AddExp(pcn, -perm[i], e, R);
4096              else /* more difficult: we have really to multiply: */
4097              {
4098                poly mmc = p_ISet(1, R);
4099                p_SetExp(mmc, -perm[i], e, R);
4100                p_Setm(mmc, R);
4101                number nnc;
4102                // convert back to a number: number nnc = mmc;
4103                if( nCoeff_is_algExt(C) )
4104                   nnc = (number) mmc;
4105                else //            nCoeff_is_transExt(C)
4106                  nnc = ntInit(mmc, C);
4107                p_GetCoeff(qq, dst) = n_Mult((number)c, nnc, C);
4108                n_Delete((number *)&c, C);
4109                n_Delete((number *)&nnc, C);
4110              }
4111              mapped_to_par=1;
4112#endif
4113            }
4114          }
4115          else
4116          {
4117            /* this variable maps to 0 !*/
4118            p_LmDelete(&qq, dst);
4119            break;
4120          }
4121        }
4122      }
4123      if ( mapped_to_par && (qq!= NULL) && nCoeff_is_algExt(dst->cf) )
4124      {
4125        number n = p_GetCoeff(qq, dst);
4126        n_Normalize(n, dst->cf);
4127        p_GetCoeff(qq, dst) = n;
4128      }
4129    }
4130    pIter(p);
4131
4132#if 0
4133    p_Test(aq,dst);
4134    PrintS("aq: "); p_Write(aq, dst, dst);
4135#endif
4136
4137
4138#if 1
4139    if (qq!=NULL)
4140    {
4141      p_Setm(qq,dst);
4142
4143      p_Test(aq,dst);
4144      p_Test(qq,dst);
4145
4146#if 0
4147    PrintS("qq: "); p_Write(qq, dst, dst);
4148#endif
4149
4150      if (aq!=NULL)
4151         qq=p_Mult_q(aq,qq,dst);
4152      aq = qq;
4153      while (pNext(aq) != NULL) pIter(aq);
4154      if (result_last==NULL)
4155      {
4156        result=qq;
4157      }
4158      else
4159      {
4160        pNext(result_last)=qq;
4161      }
4162      result_last=aq;
4163      aq = NULL;
4164    }
4165    else if (aq!=NULL)
4166    {
4167      p_Delete(&aq,dst);
4168    }
4169  }
4170  result=p_SortAdd(result,dst);
4171#else
4172  //  if (qq!=NULL)
4173  //  {
4174  //    pSetm(qq);
4175  //    pTest(qq);
4176  //    pTest(aq);
4177  //    if (aq!=NULL) qq=pMult(aq,qq);
4178  //    aq = qq;
4179  //    while (pNext(aq) != NULL) pIter(aq);
4180  //    pNext(aq) = result;
4181  //    aq = NULL;
4182  //    result = qq;
4183  //  }
4184  //  else if (aq!=NULL)
4185  //  {
4186  //    pDelete(&aq);
4187  //  }
4188  //}
4189  //p = result;
4190  //result = NULL;
4191  //while (p != NULL)
4192  //{
4193  //  qq = p;
4194  //  pIter(p);
4195  //  qq->next = NULL;
4196  //  result = pAdd(result, qq);
4197  //}
4198#endif
4199  p_Test(result,dst);
4200#if 0
4201  p_Test(result,dst);
4202  PrintS("result: "); p_Write(result,dst,dst);
4203#endif
4204  #ifdef HAVE_PLURAL
4205  p_LmDelete(&tmp_mm,dst);
4206  #endif
4207  return result;
4208}
4209/**************************************************************
4210 *
4211 * Jet
4212 *
4213 **************************************************************/
4214
4215poly pp_Jet(poly p, int m, const ring R)
4216{
4217  poly r=NULL;
4218  poly t=NULL;
4219
4220  while (p!=NULL)
4221  {
4222    if (p_Totaldegree(p,R)<=m)
4223    {
4224      if (r==NULL)
4225        r=p_Head(p,R);
4226      else
4227      if (t==NULL)
4228      {
4229        pNext(r)=p_Head(p,R);
4230        t=pNext(r);
4231      }
4232      else
4233      {
4234        pNext(t)=p_Head(p,R);
4235        pIter(t);
4236      }
4237    }
4238    pIter(p);
4239  }
4240  return r;
4241}
4242
4243poly p_Jet(poly p, int m,const ring R)
4244{
4245  while((p!=NULL) && (p_Totaldegree(p,R)>m)) p_LmDelete(&p,R);
4246  if (p==NULL) return NULL;
4247  poly r=p;
4248  while (pNext(p)!=NULL)
4249  {
4250    if (p_Totaldegree(pNext(p),R)>m)
4251    {
4252      p_LmDelete(&pNext(p),R);
4253    }
4254    else
4255      pIter(p);
4256  }
4257  return r;
4258}
4259
4260poly pp_JetW(poly p, int m, short *w, const ring R)
4261{
4262  poly r=NULL;
4263  poly t=NULL;
4264  while (p!=NULL)
4265  {
4266    if (totaldegreeWecart_IV(p,R,w)<=m)
4267    {
4268      if (r==NULL)
4269        r=p_Head(p,R);
4270      else
4271      if (t==NULL)
4272      {
4273        pNext(r)=p_Head(p,R);
4274        t=pNext(r);
4275      }
4276      else
4277      {
4278        pNext(t)=p_Head(p,R);
4279        pIter(t);
4280      }
4281    }
4282    pIter(p);
4283  }
4284  return r;
4285}
4286
4287poly p_JetW(poly p, int m, short *w, const ring R)
4288{
4289  while((p!=NULL) && (totaldegreeWecart_IV(p,R,w)>m)) p_LmDelete(&p,R);
4290  if (p==NULL) return NULL;
4291  poly r=p;
4292  while (pNext(p)!=NULL)
4293  {
4294    if (totaldegreeWecart_IV(pNext(p),R,w)>m)
4295    {
4296      p_LmDelete(&pNext(p),R);
4297    }
4298    else
4299      pIter(p);
4300  }
4301  return r;
4302}
4303
4304/*************************************************************/
4305int p_MinDeg(poly p,intvec *w, const ring R)
4306{
4307  if(p==NULL)
4308    return -1;
4309  int d=-1;
4310  while(p!=NULL)
4311  {
4312    int d0=0;
4313    for(int j=0;j<rVar(R);j++)
4314      if(w==NULL||j>=w->length())
4315        d0+=p_GetExp(p,j+1,R);
4316      else
4317        d0+=(*w)[j]*p_GetExp(p,j+1,R);
4318    if(d0<d||d==-1)
4319      d=d0;
4320    pIter(p);
4321  }
4322  return d;
4323}
4324
4325/***************************************************************/
4326static poly p_Invers(int n,poly u,intvec *w, const ring R)
4327{
4328  if(n<0)
4329    return NULL;
4330  number u0=n_Invers(pGetCoeff(u),R->cf);
4331  poly v=p_NSet(u0,R);
4332  if(n==0)
4333    return v;
4334  short *ww=iv2array(w,R);
4335  poly u1=p_JetW(p_Sub(p_One(R),__p_Mult_nn(u,u0,R),R),n,ww,R);
4336  if(u1==NULL)
4337  {
4338    omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
4339    return v;
4340  }
4341  poly v1=__p_Mult_nn(p_Copy(u1,R),u0,R);
4342  v=p_Add_q(v,p_Copy(v1,R),R);
4343  for(int i=n/p_MinDeg(u1,w,R);i>1;i--)
4344  {
4345    v1=p_JetW(p_Mult_q(v1,p_Copy(u1,R),R),n,ww,R);
4346    v=p_Add_q(v,p_Copy(v1,R),R);
4347  }
4348  p_Delete(&u1,R);
4349  p_Delete(&v1,R);
4350  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
4351  return v;
4352}
4353
4354
4355poly p_Series(int n,poly p,poly u, intvec *w, const ring R)
4356{
4357  short *ww=iv2array(w,R);
4358  if(p!=NULL)
4359  {
4360    if(u==NULL)
4361      p=p_JetW(p,n,ww,R);
4362    else
4363      p=p_JetW(p_Mult_q(p,p_Invers(n-p_MinDeg(p,w,R),u,w,R),R),n,ww,R);
4364  }
4365  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
4366  return p;
4367}
4368
4369BOOLEAN p_EqualPolys(poly p1,poly p2, const ring r)
4370{
4371  while ((p1 != NULL) && (p2 != NULL))
4372  {
4373    if (! p_LmEqual(p1, p2,r))
4374      return FALSE;
4375    if (! n_Equal(p_GetCoeff(p1,r), p_GetCoeff(p2,r),r->cf ))
4376      return FALSE;
4377    pIter(p1);
4378    pIter(p2);
4379  }
4380  return (p1==p2);
4381}
4382
4383static inline BOOLEAN p_ExpVectorEqual(poly p1, poly p2, const ring r1, const ring r2)
4384{
4385  assume( r1 == r2 || rSamePolyRep(r1, r2) );
4386
4387  p_LmCheckPolyRing1(p1, r1);
4388  p_LmCheckPolyRing1(p2, r2);
4389
4390  int i = r1->ExpL_Size;
4391
4392  assume( r1->ExpL_Size == r2->ExpL_Size );
4393
4394  unsigned long *ep = p1->exp;
4395  unsigned long *eq = p2->exp;
4396
4397  do
4398  {
4399    i--;
4400    if (ep[i] != eq[i]) return FALSE;
4401  }
4402  while (i);
4403
4404  return TRUE;
4405}
4406
4407BOOLEAN p_EqualPolys(poly p1,poly p2, const ring r1, const ring r2)
4408{
4409  assume( r1 == r2 || rSamePolyRep(r1, r2) ); // will be used in rEqual!
4410  assume( r1->cf == r2->cf );
4411
4412  while ((p1 != NULL) && (p2 != NULL))
4413  {
4414    // returns 1 if ExpVector(p)==ExpVector(q): does not compare numbers !!
4415    // #define p_LmEqual(p1, p2, r) p_ExpVectorEqual(p1, p2, r)
4416
4417    if (! p_ExpVectorEqual(p1, p2, r1, r2))
4418      return FALSE;
4419
4420    if (! n_Equal(p_GetCoeff(p1,r1), p_GetCoeff(p2,r2), r1->cf ))
4421      return FALSE;
4422
4423    pIter(p1);
4424    pIter(p2);
4425  }
4426  return (p1==p2);
4427}
4428
4429/*2
4430*returns TRUE if p1 is a skalar multiple of p2
4431*assume p1 != NULL and p2 != NULL
4432*/
4433BOOLEAN p_ComparePolys(poly p1,poly p2, const ring r)
4434{
4435  number n,nn;
4436  pAssume(p1 != NULL && p2 != NULL);
4437
4438  if (!p_LmEqual(p1,p2,r)) //compare leading mons
4439      return FALSE;
4440  if ((pNext(p1)==NULL) && (pNext(p2)!=NULL))
4441     return FALSE;
4442  if ((pNext(p2)==NULL) && (pNext(p1)!=NULL))
4443     return FALSE;
4444  if (pLength(p1) != pLength(p2))
4445    return FALSE;
4446  #ifdef HAVE_RINGS
4447  if (rField_is_Ring(r))
4448  {
4449    if (!n_DivBy(pGetCoeff(p1), pGetCoeff(p2), r->cf)) return FALSE;
4450  }
4451  #endif
4452  n=n_Div(pGetCoeff(p1),pGetCoeff(p2),r->cf);
4453  while ((p1 != NULL) /*&& (p2 != NULL)*/)
4454  {
4455    if ( ! p_LmEqual(p1, p2,r))
4456    {
4457        n_Delete(&n, r->cf);
4458        return FALSE;
4459    }
4460    if (!n_Equal(pGetCoeff(p1), nn = n_Mult(pGetCoeff(p2),n, r->cf), r->cf))
4461    {
4462      n_Delete(&n, r->cf);
4463      n_Delete(&nn, r->cf);
4464      return FALSE;
4465    }
4466    n_Delete(&nn, r->cf);
4467    pIter(p1);
4468    pIter(p2);
4469  }
4470  n_Delete(&n, r->cf);
4471  return TRUE;
4472}
4473
4474/*2
4475* returns the length of a (numbers of monomials)
4476* respect syzComp
4477*/
4478poly p_Last(const poly p, int &l, const ring r)
4479{
4480  if (p == NULL)
4481  {
4482    l = 0;
4483    return NULL;
4484  }
4485  l = 1;
4486  poly a = p;
4487  if (! rIsSyzIndexRing(r))
4488  {
4489    poly next = pNext(a);
4490    while (next!=NULL)
4491    {
4492      a = next;
4493      next = pNext(a);
4494      l++;
4495    }
4496  }
4497  else
4498  {
4499    int curr_limit = rGetCurrSyzLimit(r);
4500    poly pp = a;
4501    while ((a=pNext(a))!=NULL)
4502    {
4503      if (__p_GetComp(a,r)<=curr_limit/*syzComp*/)
4504        l++;
4505      else break;
4506      pp = a;
4507    }
4508    a=pp;
4509  }
4510  return a;
4511}
4512
4513int p_Var(poly m,const ring r)
4514{
4515  if (m==NULL) return 0;
4516  if (pNext(m)!=NULL) return 0;
4517  int i,e=0;
4518  for (i=rVar(r); i>0; i--)
4519  {
4520    int exp=p_GetExp(m,i,r);
4521    if (exp==1)
4522    {
4523      if (e==0) e=i;
4524      else return 0;
4525    }
4526    else if (exp!=0)
4527    {
4528      return 0;
4529    }
4530  }
4531  return e;
4532}
4533
4534/*2
4535*the minimal index of used variables - 1
4536*/
4537int p_LowVar (poly p, const ring r)
4538{
4539  int k,l,lex;
4540
4541  if (p == NULL) return -1;
4542
4543  k = 32000;/*a very large dummy value*/
4544  while (p != NULL)
4545  {
4546    l = 1;
4547    lex = p_GetExp(p,l,r);
4548    while ((l < (rVar(r))) && (lex == 0))
4549    {
4550      l++;
4551      lex = p_GetExp(p,l,r);
4552    }
4553    l--;
4554    if (l < k) k = l;
4555    pIter(p);
4556  }
4557  return k;
4558}
4559
4560/*2
4561* verschiebt die Indizees der Modulerzeugenden um i
4562*/
4563void p_Shift (poly * p,int i, const ring r)
4564{
4565  poly qp1 = *p,qp2 = *p;/*working pointers*/
4566  int     j = p_MaxComp(*p,r),k = p_MinComp(*p,r);
4567
4568  if (j+i < 0) return ;
4569  BOOLEAN toPoly= ((j == -i) && (j == k));
4570  while (qp1 != NULL)
4571  {
4572    if (toPoly || (__p_GetComp(qp1,r)+i > 0))
4573    {
4574      p_AddComp(qp1,i,r);
4575      p_SetmComp(qp1,r);
4576      qp2 = qp1;
4577      pIter(qp1);
4578    }
4579    else
4580    {
4581      if (qp2 == *p)
4582      {
4583        pIter(*p);
4584        p_LmDelete(&qp2,r);
4585        qp2 = *p;
4586        qp1 = *p;
4587      }
4588      else
4589      {
4590        qp2->next = qp1->next;
4591        if (qp1!=NULL) p_LmDelete(&qp1,r);
4592        qp1 = qp2->next;
4593      }
4594    }
4595  }
4596}
4597
4598/***************************************************************
4599 *
4600 * Storage Managament Routines
4601 *
4602 ***************************************************************/
4603
4604
4605static inline unsigned long GetBitFields(const long e,
4606                                         const unsigned int s, const unsigned int n)
4607{
4608#define Sy_bit_L(x)     (((unsigned long)1L)<<(x))
4609  unsigned int i = 0;
4610  unsigned long  ev = 0L;
4611  assume(n > 0 && s < BIT_SIZEOF_LONG);
4612  do
4613  {
4614    assume(s+i < BIT_SIZEOF_LONG);
4615    if (e > (long) i) ev |= Sy_bit_L(s+i);
4616    else break;
4617    i++;
4618  }
4619  while (i < n);
4620  return ev;
4621}
4622
4623// Short Exponent Vectors are used for fast divisibility tests
4624// ShortExpVectors "squeeze" an exponent vector into one word as follows:
4625// Let n = BIT_SIZEOF_LONG / pVariables.
4626// If n == 0 (i.e. pVariables > BIT_SIZE_OF_LONG), let m == the number
4627// of non-zero exponents. If (m>BIT_SIZEOF_LONG), then sev = ~0, else
4628// first m bits of sev are set to 1.
4629// Otherwise (i.e. pVariables <= BIT_SIZE_OF_LONG)
4630// represented by a bit-field of length n (resp. n+1 for some
4631// exponents). If the value of an exponent is greater or equal to n, then
4632// all of its respective n bits are set to 1. If the value of an exponent
4633// is smaller than n, say m, then only the first m bits of the respective
4634// n bits are set to 1, the others are set to 0.
4635// This way, we have:
4636// exp1 / exp2 ==> (ev1 & ~ev2) == 0, i.e.,
4637// if (ev1 & ~ev2) then exp1 does not divide exp2
4638unsigned long p_GetShortExpVector(const poly p, const ring r)
4639{
4640  assume(p != NULL);
4641  unsigned long ev = 0; // short exponent vector
4642  unsigned int n = BIT_SIZEOF_LONG / r->N; // number of bits per exp
4643  unsigned int m1; // highest bit which is filled with (n+1)
4644  int i=0,j=1;
4645
4646  if (n == 0)
4647  {
4648    if (r->N <2*BIT_SIZEOF_LONG)
4649    {
4650      n=1;
4651      m1=0;
4652    }
4653    else
4654    {
4655      for (; j<=r->N; j++)
4656      {
4657        if (p_GetExp(p,j,r) > 0) i++;
4658        if (i == BIT_SIZEOF_LONG) break;
4659      }
4660      if (i>0)
4661        ev = ~(0UL) >> (BIT_SIZEOF_LONG - i);
4662      return ev;
4663    }
4664  }
4665  else
4666  {
4667    m1 = (n+1)*(BIT_SIZEOF_LONG - n*r->N);
4668  }
4669
4670  n++;
4671  while (i<m1)
4672  {
4673    ev |= GetBitFields(p_GetExp(p, j,r), i, n);
4674    i += n;
4675    j++;
4676  }
4677
4678  n--;
4679  while (i<BIT_SIZEOF_LONG)
4680  {
4681    ev |= GetBitFields(p_GetExp(p, j,r), i, n);
4682    i += n;
4683    j++;
4684  }
4685  return ev;
4686}
4687
4688
4689///  p_GetShortExpVector of p * pp
4690unsigned long p_GetShortExpVector(const poly p, const poly pp, const ring r)
4691{
4692  assume(p != NULL);
4693  assume(pp != NULL);
4694
4695  unsigned long ev = 0; // short exponent vector
4696  unsigned int n = BIT_SIZEOF_LONG / r->N; // number of bits per exp
4697  unsigned int m1; // highest bit which is filled with (n+1)
4698  int j=1;
4699  unsigned long i = 0L;
4700
4701  if (n == 0)
4702  {
4703    if (r->N <2*BIT_SIZEOF_LONG)
4704    {
4705      n=1;
4706      m1=0;
4707    }
4708    else
4709    {
4710      for (; j<=r->N; j++)
4711      {
4712        if (p_GetExp(p,j,r) > 0 || p_GetExp(pp,j,r) > 0) i++;
4713        if (i == BIT_SIZEOF_LONG) break;
4714      }
4715      if (i>0)
4716        ev = ~(0UL) >> (BIT_SIZEOF_LONG - i);
4717      return ev;
4718    }
4719  }
4720  else
4721  {
4722    m1 = (n+1)*(BIT_SIZEOF_LONG - n*r->N);
4723  }
4724
4725  n++;
4726  while (i<m1)
4727  {
4728    ev |= GetBitFields(p_GetExp(p, j,r) + p_GetExp(pp, j,r), i, n);
4729    i += n;
4730    j++;
4731  }
4732
4733  n--;
4734  while (i<BIT_SIZEOF_LONG)
4735  {
4736    ev |= GetBitFields(p_GetExp(p, j,r) + p_GetExp(pp, j,r), i, n);
4737    i += n;
4738    j++;
4739  }
4740  return ev;
4741}
4742
4743
4744
4745/***************************************************************
4746 *
4747 * p_ShallowDelete
4748 *
4749 ***************************************************************/
4750#undef LINKAGE
4751#define LINKAGE
4752#undef p_Delete__T
4753#define p_Delete__T p_ShallowDelete
4754#undef n_Delete__T
4755#define n_Delete__T(n, r) do {} while (0)
4756
4757#include "polys/templates/p_Delete__T.cc"
4758
4759/***************************************************************/
4760/*
4761* compare a and b
4762*/
4763int p_Compare(const poly a, const poly b, const ring R)
4764{
4765  int r=p_Cmp(a,b,R);
4766  if ((r==0)&&(a!=NULL))
4767  {
4768    number h=n_Sub(pGetCoeff(a),pGetCoeff(b),R->cf);
4769    /* compare lead coeffs */
4770    r = -1+n_IsZero(h,R->cf)+2*n_GreaterZero(h,R->cf); /* -1: <, 0:==, 1: > */
4771    n_Delete(&h,R->cf);
4772  }
4773  else if (a==NULL)
4774  {
4775    if (b==NULL)
4776    {
4777      /* compare 0, 0 */
4778      r=0;
4779    }
4780    else if(p_IsConstant(b,R))
4781    {
4782      /* compare 0, const */
4783      r = 1-2*n_GreaterZero(pGetCoeff(b),R->cf); /* -1: <, 1: > */
4784    }
4785  }
4786  else if (b==NULL)
4787  {
4788    if (p_IsConstant(a,R))
4789    {
4790      /* compare const, 0 */
4791      r = -1+2*n_GreaterZero(pGetCoeff(a),R->cf); /* -1: <, 1: > */
4792    }
4793  }
4794  return(r);
4795}
4796
4797poly p_GcdMon(poly f, poly g, const ring r)
4798{
4799  assume(f!=NULL);
4800  assume(g!=NULL);
4801  assume(pNext(f)==NULL);
4802  poly G=p_Head(f,r);
4803  poly h=g;
4804  int *mf=(int*)omAlloc((r->N+1)*sizeof(int));
4805  p_GetExpV(f,mf,r);
4806  int *mh=(int*)omAlloc((r->N+1)*sizeof(int));
4807  BOOLEAN const_mon;
4808  BOOLEAN one_coeff=n_IsOne(pGetCoeff(G),r->cf);
4809  loop
4810  {
4811    if (h==NULL) break;
4812    if(!one_coeff)
4813    {
4814      number n=n_SubringGcd(pGetCoeff(G),pGetCoeff(h),r->cf);
4815      one_coeff=n_IsOne(n,r->cf);
4816      p_SetCoeff(G,n,r);
4817    }
4818    p_GetExpV(h,mh,r);
4819    const_mon=TRUE;
4820    for(unsigned j=r->N;j!=0;j--)
4821    {
4822      if (mh[j]<mf[j]) mf[j]=mh[j];
4823      if (mf[j]>0) const_mon=FALSE;
4824    }
4825    if (one_coeff && const_mon) break;
4826    pIter(h);
4827  }
4828  mf[0]=0;
4829  p_SetExpV(G,mf,r); // included is p_SetComp, p_Setm
4830  omFreeSize(mf,(r->N+1)*sizeof(int));
4831  omFreeSize(mh,(r->N+1)*sizeof(int));
4832  return G;
4833}
Note: See TracBrowser for help on using the repository browser.