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

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