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

spielwiese
Last change on this file since a241bd was a241bd, checked in by Hans Schoenemann <hannes@…>, 4 years ago
polynomail division via syz for nc-rings
  • Property mode set to 100644
File size: 104.1 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 "misc/auxiliary.h"
14
15#include "misc/options.h"
16#include "misc/intvec.h"
17
18
19#include "coeffs/longrat.h" // snumber is needed...
20#include "coeffs/numbers.h" // ndCopyMap
21
22#include "polys/PolyEnumerator.h"
23
24#define TRANSEXT_PRIVATES
25
26#include "polys/ext_fields/transext.h"
27#include "polys/ext_fields/algext.h"
28
29#include "polys/weight.h"
30#include "polys/simpleideals.h"
31
32#include "ring.h"
33#include "p_polys.h"
34
35#include "polys/templates/p_MemCmp.h"
36#include "polys/templates/p_MemAdd.h"
37#include "polys/templates/p_MemCopy.h"
38
39
40#ifdef HAVE_PLURAL
41#include "nc/nc.h"
42#include "nc/sca.h"
43#endif
44
45#ifdef HAVE_SHIFTBBA
46#include "polys/shiftop.h"
47#endif
48
49#include "clapsing.h"
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_VAR int* _components = NULL;
145STATIC_VAR long* _componentsShifted = NULL;
146STATIC_VAR int _componentsExternal = 0;
147
148VAR BOOLEAN 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
1339BOOLEAN p_HasNotCFRing(poly p1, poly p2, const ring r)
1340{
1341
1342  if (p_GetComp(p1,r) > 0 || p_GetComp(p2,r) > 0)
1343    return FALSE;
1344  int i = rVar(r);
1345  loop
1346  {
1347    if ((p_GetExp(p1, i, r) > 0) && (p_GetExp(p2, i, r) > 0))
1348      return FALSE;
1349    i--;
1350    if (i == 0) {
1351      if (n_DivBy(pGetCoeff(p1), pGetCoeff(p2), r->cf) ||
1352          n_DivBy(pGetCoeff(p2), pGetCoeff(p1), r->cf)) {
1353        return FALSE;
1354      } else {
1355        return TRUE;
1356      }
1357    }
1358  }
1359}
1360
1361/*2
1362* convert monomial given as string to poly, e.g. 1x3y5z
1363*/
1364const char * p_Read(const char *st, poly &rc, const ring r)
1365{
1366  if (r==NULL) { rc=NULL;return st;}
1367  int i,j;
1368  rc = p_Init(r);
1369  const char *s = n_Read(st,&(p_GetCoeff(rc, r)),r->cf);
1370  if (s==st)
1371  /* i.e. it does not start with a coeff: test if it is a ringvar*/
1372  {
1373    j = r_IsRingVar(s,r->names,r->N);
1374    if (j >= 0)
1375    {
1376      p_IncrExp(rc,1+j,r);
1377      while (*s!='\0') s++;
1378      goto done;
1379    }
1380  }
1381  while (*s!='\0')
1382  {
1383    char ss[2];
1384    ss[0] = *s++;
1385    ss[1] = '\0';
1386    j = r_IsRingVar(ss,r->names,r->N);
1387    if (j >= 0)
1388    {
1389      const char *s_save=s;
1390      s = eati(s,&i);
1391      if (((unsigned long)i) >  r->bitmask/2)
1392      {
1393        // exponent to large: it is not a monomial
1394        p_LmDelete(&rc,r);
1395        return s_save;
1396      }
1397      p_AddExp(rc,1+j, (long)i, r);
1398    }
1399    else
1400    {
1401      // 1st char of is not a varname
1402      // We return the parsed polynomial nevertheless. This is needed when
1403      // we are parsing coefficients in a rational function field.
1404      s--;
1405      break;
1406    }
1407  }
1408done:
1409  if (n_IsZero(pGetCoeff(rc),r->cf)) p_LmDelete(&rc,r);
1410  else
1411  {
1412#ifdef HAVE_PLURAL
1413    // in super-commutative ring
1414    // squares of anti-commutative variables are zeroes!
1415    if(rIsSCA(r))
1416    {
1417      const unsigned int iFirstAltVar = scaFirstAltVar(r);
1418      const unsigned int iLastAltVar  = scaLastAltVar(r);
1419
1420      assume(rc != NULL);
1421
1422      for(unsigned int k = iFirstAltVar; k <= iLastAltVar; k++)
1423        if( p_GetExp(rc, k, r) > 1 )
1424        {
1425          p_LmDelete(&rc, r);
1426          goto finish;
1427        }
1428    }
1429#endif
1430
1431    p_Setm(rc,r);
1432  }
1433finish:
1434  return s;
1435}
1436poly p_mInit(const char *st, BOOLEAN &ok, const ring r)
1437{
1438  poly p;
1439  const char *s=p_Read(st,p,r);
1440  if (*s!='\0')
1441  {
1442    if ((s!=st)&&isdigit(st[0]))
1443    {
1444      errorreported=TRUE;
1445    }
1446    ok=FALSE;
1447    p_Delete(&p,r);
1448    return NULL;
1449  }
1450  p_Test(p,r);
1451  ok=!errorreported;
1452  return p;
1453}
1454
1455/*2
1456* returns a polynomial representing the number n
1457* destroys n
1458*/
1459poly p_NSet(number n, const ring r)
1460{
1461  if (n_IsZero(n,r->cf))
1462  {
1463    n_Delete(&n, r->cf);
1464    return NULL;
1465  }
1466  else
1467  {
1468    poly rc = p_Init(r);
1469    pSetCoeff0(rc,n);
1470    return rc;
1471  }
1472}
1473/*2
1474* assumes that LM(a) = LM(b)*m, for some monomial m,
1475* returns the multiplicant m,
1476* leaves a and b unmodified
1477*/
1478poly p_MDivide(poly a, poly b, const ring r)
1479{
1480  assume((p_GetComp(a,r)==p_GetComp(b,r)) || (p_GetComp(b,r)==0));
1481  int i;
1482  poly result = p_Init(r);
1483
1484  for(i=(int)r->N; i; i--)
1485    p_SetExp(result,i, p_GetExp(a,i,r)- p_GetExp(b,i,r),r);
1486  p_SetComp(result, p_GetComp(a,r) - p_GetComp(b,r),r);
1487  p_Setm(result,r);
1488  return result;
1489}
1490
1491poly p_Div_nn(poly p, const number n, const ring r)
1492{
1493  pAssume(!n_IsZero(n,r->cf));
1494  p_Test(p, r);
1495  poly result = p;
1496  poly prev = NULL;
1497  while (p!=NULL)
1498  {
1499    number nc = n_Div(pGetCoeff(p),n,r->cf);
1500    if (!n_IsZero(nc,r->cf))
1501    {
1502      p_SetCoeff(p,nc,r);
1503      prev=p;
1504      pIter(p);
1505    }
1506    else
1507    {
1508      if (prev==NULL)
1509      {
1510        p_LmDelete(&result,r);
1511        p=result;
1512      }
1513      else
1514      {
1515        p_LmDelete(&pNext(prev),r);
1516        p=pNext(prev);
1517      }
1518    }
1519  }
1520  p_Test(result,r);
1521  return(result);
1522}
1523
1524poly p_Div_mm(poly p, const poly m, const ring r)
1525{
1526  p_Test(p, r);
1527  p_Test(m, r);
1528  poly result = p;
1529  poly prev = NULL;
1530  number n=pGetCoeff(m);
1531  while (p!=NULL)
1532  {
1533    number nc = n_Div(pGetCoeff(p),n,r->cf);
1534    n_Normalize(nc,r->cf);
1535    if (!n_IsZero(nc,r->cf))
1536    {
1537      p_SetCoeff(p,nc,r);
1538      prev=p;
1539      p_ExpVectorSub(p,m,r);
1540      pIter(p);
1541    }
1542    else
1543    {
1544      if (prev==NULL)
1545      {
1546        p_LmDelete(&result,r);
1547        p=result;
1548      }
1549      else
1550      {
1551        p_LmDelete(&pNext(prev),r);
1552        p=pNext(prev);
1553      }
1554    }
1555  }
1556  p_Test(result,r);
1557  return(result);
1558}
1559
1560/*2
1561* divides a by the monomial b, ignores monomials which are not divisible
1562* assumes that b is not NULL, destroyes b
1563*/
1564poly p_DivideM(poly a, poly b, const ring r)
1565{
1566  if (a==NULL) { p_Delete(&b,r); return NULL; }
1567  poly result=a;
1568
1569  if(!p_IsConstant(b,r))
1570  {
1571    if (rIsNCRing(r))
1572    {
1573      WerrorS("p_DivideM not implemented for non-commuative rings");
1574      return NULL;
1575    }
1576    poly prev=NULL;
1577    while (a!=NULL)
1578    {
1579      if (p_DivisibleBy(b,a,r))
1580      {
1581        p_ExpVectorSub(a,b,r);
1582        prev=a;
1583        pIter(a);
1584      }
1585      else
1586      {
1587        if (prev==NULL)
1588        {
1589          p_LmDelete(&result,r);
1590          a=result;
1591        }
1592        else
1593        {
1594          p_LmDelete(&pNext(prev),r);
1595          a=pNext(prev);
1596        }
1597      }
1598    }
1599  }
1600  if (result!=NULL)
1601  {
1602    number inv=pGetCoeff(b);
1603    //if ((!rField_is_Ring(r)) || n_IsUnit(inv,r->cf))
1604    if (rField_is_Zp(r))
1605    {
1606      inv = n_Invers(inv,r->cf);
1607      __p_Mult_nn(result,inv,r);
1608      n_Delete(&inv, r->cf);
1609    }
1610    else
1611    {
1612      result = p_Div_nn(result,inv,r);
1613    }
1614  }
1615  p_Delete(&b, r);
1616  return result;
1617}
1618
1619poly pp_DivideM(poly a, poly b, const ring r)
1620{
1621  if (a==NULL) { return NULL; }
1622  // TODO: better implementation without copying a,b
1623  return p_DivideM(p_Copy(a,r),p_Head(b,r),r);
1624}
1625
1626#ifdef HAVE_RINGS
1627/* TRUE iff LT(f) | LT(g) */
1628BOOLEAN p_DivisibleByRingCase(poly f, poly g, const ring r)
1629{
1630  int exponent;
1631  for(int i = (int)rVar(r); i>0; i--)
1632  {
1633    exponent = p_GetExp(g, i, r) - p_GetExp(f, i, r);
1634    if (exponent < 0) return FALSE;
1635  }
1636  return n_DivBy(pGetCoeff(g), pGetCoeff(f), r->cf);
1637}
1638#endif
1639
1640// returns the LCM of the head terms of a and b in *m
1641void p_Lcm(const poly a, const poly b, poly m, const ring r)
1642{
1643  for (int i=r->N; i; --i)
1644    p_SetExp(m,i, si_max( p_GetExp(a,i,r), p_GetExp(b,i,r)),r);
1645
1646  p_SetComp(m, si_max(p_GetComp(a,r), p_GetComp(b,r)),r);
1647  /* Don't do a pSetm here, otherwise hres/lres chockes */
1648}
1649
1650poly p_Lcm(const poly a, const poly b, const ring r)
1651{
1652  poly m=p_Init(r);
1653  p_Lcm(a, b, m, r);
1654  p_Setm(m,r);
1655  return(m);
1656}
1657
1658#ifdef HAVE_RATGRING
1659/*2
1660* returns the rational LCM of the head terms of a and b
1661* without coefficient!!!
1662*/
1663poly p_LcmRat(const poly a, const poly b, const long lCompM, const ring r)
1664{
1665  poly m = // p_One( r);
1666          p_Init(r);
1667
1668//  const int (currRing->N) = r->N;
1669
1670  //  for (int i = (currRing->N); i>=r->real_var_start; i--)
1671  for (int i = r->real_var_end; i>=r->real_var_start; i--)
1672  {
1673    const int lExpA = p_GetExp (a, i, r);
1674    const int lExpB = p_GetExp (b, i, r);
1675
1676    p_SetExp (m, i, si_max(lExpA, lExpB), r);
1677  }
1678
1679  p_SetComp (m, lCompM, r);
1680  p_Setm(m,r);
1681  n_New(&(p_GetCoeff(m, r)), r);
1682
1683  return(m);
1684};
1685
1686void p_LmDeleteAndNextRat(poly *p, int ishift, ring r)
1687{
1688  /* modifies p*/
1689  //  Print("start: "); Print(" "); p_wrp(*p,r);
1690  p_LmCheckPolyRing2(*p, r);
1691  poly q = p_Head(*p,r);
1692  const long cmp = p_GetComp(*p, r);
1693  while ( ( (*p)!=NULL ) && ( p_Comp_k_n(*p, q, ishift+1, r) ) && (p_GetComp(*p, r) == cmp) )
1694  {
1695    p_LmDelete(p,r);
1696    //    Print("while: ");p_wrp(*p,r);Print(" ");
1697  }
1698  //  p_wrp(*p,r);Print(" ");
1699  //  PrintS("end\n");
1700  p_LmDelete(&q,r);
1701}
1702
1703
1704/* returns x-coeff of p, i.e. a poly in x, s.t. corresponding xd-monomials
1705have the same D-part and the component 0
1706does not destroy p
1707*/
1708poly p_GetCoeffRat(poly p, int ishift, ring r)
1709{
1710  poly q   = pNext(p);
1711  poly res; // = p_Head(p,r);
1712  res = p_GetExp_k_n(p, ishift+1, r->N, r); // does pSetm internally
1713  p_SetCoeff(res,n_Copy(p_GetCoeff(p,r),r),r);
1714  poly s;
1715  long cmp = p_GetComp(p, r);
1716  while ( (q!= NULL) && (p_Comp_k_n(p, q, ishift+1, r)) && (p_GetComp(q, r) == cmp) )
1717  {
1718    s   = p_GetExp_k_n(q, ishift+1, r->N, r);
1719    p_SetCoeff(s,n_Copy(p_GetCoeff(q,r),r),r);
1720    res = p_Add_q(res,s,r);
1721    q   = pNext(q);
1722  }
1723  cmp = 0;
1724  p_SetCompP(res,cmp,r);
1725  return res;
1726}
1727
1728
1729
1730void p_ContentRat(poly &ph, const ring r)
1731// changes ph
1732// for rat coefficients in K(x1,..xN)
1733{
1734  // init array of RatLeadCoeffs
1735  //  poly p_GetCoeffRat(poly p, int ishift, ring r);
1736
1737  int len=pLength(ph);
1738  poly *C = (poly *)omAlloc0((len+1)*sizeof(poly));  //rat coeffs
1739  poly *LM = (poly *)omAlloc0((len+1)*sizeof(poly));  // rat lead terms
1740  int *D = (int *)omAlloc0((len+1)*sizeof(int));  //degrees of coeffs
1741  int *L = (int *)omAlloc0((len+1)*sizeof(int));  //lengths of coeffs
1742  int k = 0;
1743  poly p = p_Copy(ph, r); // ph will be needed below
1744  int mintdeg = p_Totaldegree(p, r);
1745  int minlen = len;
1746  int dd = 0; int i;
1747  int HasConstantCoef = 0;
1748  int is = r->real_var_start - 1;
1749  while (p!=NULL)
1750  {
1751    LM[k] = p_GetExp_k_n(p,1,is, r); // need LmRat istead of  p_HeadRat(p, is, currRing); !
1752    C[k] = p_GetCoeffRat(p, is, r);
1753    D[k] =  p_Totaldegree(C[k], r);
1754    mintdeg = si_min(mintdeg,D[k]);
1755    L[k] = pLength(C[k]);
1756    minlen = si_min(minlen,L[k]);
1757    if (p_IsConstant(C[k], r))
1758    {
1759      // C[k] = const, so the content will be numerical
1760      HasConstantCoef = 1;
1761      // smth like goto cleanup and return(pContent(p));
1762    }
1763    p_LmDeleteAndNextRat(&p, is, r);
1764    k++;
1765  }
1766
1767  // look for 1 element of minimal degree and of minimal length
1768  k--;
1769  poly d;
1770  int mindeglen = len;
1771  if (k<=0) // this poly is not a ratgring poly -> pContent
1772  {
1773    p_Delete(&C[0], r);
1774    p_Delete(&LM[0], r);
1775    p_ContentForGB(ph, r);
1776    goto cleanup;
1777  }
1778
1779  int pmindeglen;
1780  for(i=0; i<=k; i++)
1781  {
1782    if (D[i] == mintdeg)
1783    {
1784      if (L[i] < mindeglen)
1785      {
1786        mindeglen=L[i];
1787        pmindeglen = i;
1788      }
1789    }
1790  }
1791  d = p_Copy(C[pmindeglen], r);
1792  // there are dd>=1 mindeg elements
1793  // and pmideglen is the coordinate of one of the smallest among them
1794
1795  //  poly g = singclap_gcd(p_Copy(p,r),p_Copy(q,r));
1796  //  return naGcd(d,d2,currRing);
1797
1798  // adjoin pContentRat here?
1799  for(i=0; i<=k; i++)
1800  {
1801    d=singclap_gcd(d,p_Copy(C[i], r), r);
1802    if (p_Totaldegree(d, r)==0)
1803    {
1804      // cleanup, pContent, return
1805      p_Delete(&d, r);
1806      for(;k>=0;k--)
1807      {
1808        p_Delete(&C[k], r);
1809        p_Delete(&LM[k], r);
1810      }
1811      p_ContentForGB(ph, r);
1812      goto cleanup;
1813    }
1814  }
1815  for(i=0; i<=k; i++)
1816  {
1817    poly h=singclap_pdivide(C[i],d, r);
1818    p_Delete(&C[i], r);
1819    C[i]=h;
1820  }
1821
1822  // zusammensetzen,
1823  p=NULL; // just to be sure
1824  for(i=0; i<=k; i++)
1825  {
1826    p = p_Add_q(p, p_Mult_q(C[i],LM[i], r), r);
1827    C[i]=NULL; LM[i]=NULL;
1828  }
1829  p_Delete(&ph, r); // do not need it anymore
1830  ph = p;
1831  // aufraeumen, return
1832cleanup:
1833  omFree(C);
1834  omFree(LM);
1835  omFree(D);
1836  omFree(L);
1837}
1838
1839
1840#endif
1841
1842
1843/* assumes that p and divisor are univariate polynomials in r,
1844   mentioning the same variable;
1845   assumes divisor != NULL;
1846   p may be NULL;
1847   assumes a global monomial ordering in r;
1848   performs polynomial division of p by divisor:
1849     - afterwards p contains the remainder of the division, i.e.,
1850       p_before = result * divisor + p_afterwards;
1851     - if needResult == TRUE, then the method computes and returns 'result',
1852       otherwise NULL is returned (This parametrization can be used when
1853       one is only interested in the remainder of the division. In this
1854       case, the method will be slightly faster.)
1855   leaves divisor unmodified */
1856poly      p_PolyDiv(poly &p, const poly divisor, const BOOLEAN needResult, const ring r)
1857{
1858  assume(divisor != NULL);
1859  if (p == NULL) return NULL;
1860
1861  poly result = NULL;
1862  number divisorLC = p_GetCoeff(divisor, r);
1863  int divisorLE = p_GetExp(divisor, 1, r);
1864  while ((p != NULL) && (p_Deg(p, r) >= p_Deg(divisor, r)))
1865  {
1866    /* determine t = LT(p) / LT(divisor) */
1867    poly t = p_ISet(1, r);
1868    number c = n_Div(p_GetCoeff(p, r), divisorLC, r->cf);
1869    n_Normalize(c,r->cf);
1870    p_SetCoeff(t, c, r);
1871    int e = p_GetExp(p, 1, r) - divisorLE;
1872    p_SetExp(t, 1, e, r);
1873    p_Setm(t, r);
1874    if (needResult) result = p_Add_q(result, p_Copy(t, r), r);
1875    p = p_Add_q(p, p_Neg(p_Mult_q(t, p_Copy(divisor, r), r), r), r);
1876  }
1877  return result;
1878}
1879
1880/*2
1881* returns the partial differentiate of a by the k-th variable
1882* does not destroy the input
1883*/
1884poly p_Diff(poly a, int k, const ring r)
1885{
1886  poly res, f, last;
1887  number t;
1888
1889  last = res = NULL;
1890  while (a!=NULL)
1891  {
1892    if (p_GetExp(a,k,r)!=0)
1893    {
1894      f = p_LmInit(a,r);
1895      t = n_Init(p_GetExp(a,k,r),r->cf);
1896      pSetCoeff0(f,n_Mult(t,pGetCoeff(a),r->cf));
1897      n_Delete(&t,r->cf);
1898      if (n_IsZero(pGetCoeff(f),r->cf))
1899        p_LmDelete(&f,r);
1900      else
1901      {
1902        p_DecrExp(f,k,r);
1903        p_Setm(f,r);
1904        if (res==NULL)
1905        {
1906          res=last=f;
1907        }
1908        else
1909        {
1910          pNext(last)=f;
1911          last=f;
1912        }
1913      }
1914    }
1915    pIter(a);
1916  }
1917  return res;
1918}
1919
1920static poly p_DiffOpM(poly a, poly b,BOOLEAN multiply, const ring r)
1921{
1922  int i,j,s;
1923  number n,h,hh;
1924  poly p=p_One(r);
1925  n=n_Mult(pGetCoeff(a),pGetCoeff(b),r->cf);
1926  for(i=rVar(r);i>0;i--)
1927  {
1928    s=p_GetExp(b,i,r);
1929    if (s<p_GetExp(a,i,r))
1930    {
1931      n_Delete(&n,r->cf);
1932      p_LmDelete(&p,r);
1933      return NULL;
1934    }
1935    if (multiply)
1936    {
1937      for(j=p_GetExp(a,i,r); j>0;j--)
1938      {
1939        h = n_Init(s,r->cf);
1940        hh=n_Mult(n,h,r->cf);
1941        n_Delete(&h,r->cf);
1942        n_Delete(&n,r->cf);
1943        n=hh;
1944        s--;
1945      }
1946      p_SetExp(p,i,s,r);
1947    }
1948    else
1949    {
1950      p_SetExp(p,i,s-p_GetExp(a,i,r),r);
1951    }
1952  }
1953  p_Setm(p,r);
1954  /*if (multiply)*/ p_SetCoeff(p,n,r);
1955  if (n_IsZero(n,r->cf))  p=p_LmDeleteAndNext(p,r); // return NULL as p is a monomial
1956  return p;
1957}
1958
1959poly p_DiffOp(poly a, poly b,BOOLEAN multiply, const ring r)
1960{
1961  poly result=NULL;
1962  poly h;
1963  for(;a!=NULL;pIter(a))
1964  {
1965    for(h=b;h!=NULL;pIter(h))
1966    {
1967      result=p_Add_q(result,p_DiffOpM(a,h,multiply,r),r);
1968    }
1969  }
1970  return result;
1971}
1972/*2
1973* subtract p2 from p1, p1 and p2 are destroyed
1974* do not put attention on speed: the procedure is only used in the interpreter
1975*/
1976poly p_Sub(poly p1, poly p2, const ring r)
1977{
1978  return p_Add_q(p1, p_Neg(p2,r),r);
1979}
1980
1981/*3
1982* compute for a monomial m
1983* the power m^exp, exp > 1
1984* destroys p
1985*/
1986static poly p_MonPower(poly p, int exp, const ring r)
1987{
1988  int i;
1989
1990  if(!n_IsOne(pGetCoeff(p),r->cf))
1991  {
1992    number x, y;
1993    y = pGetCoeff(p);
1994    n_Power(y,exp,&x,r->cf);
1995    n_Delete(&y,r->cf);
1996    pSetCoeff0(p,x);
1997  }
1998  for (i=rVar(r); i!=0; i--)
1999  {
2000    p_MultExp(p,i, exp,r);
2001  }
2002  p_Setm(p,r);
2003  return p;
2004}
2005
2006/*3
2007* compute for monomials p*q
2008* destroys p, keeps q
2009*/
2010static void p_MonMult(poly p, poly q, const ring r)
2011{
2012  number x, y;
2013
2014  y = pGetCoeff(p);
2015  x = n_Mult(y,pGetCoeff(q),r->cf);
2016  n_Delete(&y,r->cf);
2017  pSetCoeff0(p,x);
2018  //for (int i=pVariables; i!=0; i--)
2019  //{
2020  //  pAddExp(p,i, pGetExp(q,i));
2021  //}
2022  //p->Order += q->Order;
2023  p_ExpVectorAdd(p,q,r);
2024}
2025
2026/*3
2027* compute for monomials p*q
2028* keeps p, q
2029*/
2030static poly p_MonMultC(poly p, poly q, const ring rr)
2031{
2032  number x;
2033  poly r = p_Init(rr);
2034
2035  x = n_Mult(pGetCoeff(p),pGetCoeff(q),rr->cf);
2036  pSetCoeff0(r,x);
2037  p_ExpVectorSum(r,p, q, rr);
2038  return r;
2039}
2040
2041/*3
2042*  create binomial coef.
2043*/
2044static number* pnBin(int exp, const ring r)
2045{
2046  int e, i, h;
2047  number x, y, *bin=NULL;
2048
2049  x = n_Init(exp,r->cf);
2050  if (n_IsZero(x,r->cf))
2051  {
2052    n_Delete(&x,r->cf);
2053    return bin;
2054  }
2055  h = (exp >> 1) + 1;
2056  bin = (number *)omAlloc0(h*sizeof(number));
2057  bin[1] = x;
2058  if (exp < 4)
2059    return bin;
2060  i = exp - 1;
2061  for (e=2; e<h; e++)
2062  {
2063      x = n_Init(i,r->cf);
2064      i--;
2065      y = n_Mult(x,bin[e-1],r->cf);
2066      n_Delete(&x,r->cf);
2067      x = n_Init(e,r->cf);
2068      bin[e] = n_ExactDiv(y,x,r->cf);
2069      n_Delete(&x,r->cf);
2070      n_Delete(&y,r->cf);
2071  }
2072  return bin;
2073}
2074
2075static void pnFreeBin(number *bin, int exp,const coeffs r)
2076{
2077  int e, h = (exp >> 1) + 1;
2078
2079  if (bin[1] != NULL)
2080  {
2081    for (e=1; e<h; e++)
2082      n_Delete(&(bin[e]),r);
2083  }
2084  omFreeSize((ADDRESS)bin, h*sizeof(number));
2085}
2086
2087/*
2088*  compute for a poly p = head+tail, tail is monomial
2089*          (head + tail)^exp, exp > 1
2090*          with binomial coef.
2091*/
2092static poly p_TwoMonPower(poly p, int exp, const ring r)
2093{
2094  int eh, e;
2095  long al;
2096  poly *a;
2097  poly tail, b, res, h;
2098  number x;
2099  number *bin = pnBin(exp,r);
2100
2101  tail = pNext(p);
2102  if (bin == NULL)
2103  {
2104    p_MonPower(p,exp,r);
2105    p_MonPower(tail,exp,r);
2106    p_Test(p,r);
2107    return p;
2108  }
2109  eh = exp >> 1;
2110  al = (exp + 1) * sizeof(poly);
2111  a = (poly *)omAlloc(al);
2112  a[1] = p;
2113  for (e=1; e<exp; e++)
2114  {
2115    a[e+1] = p_MonMultC(a[e],p,r);
2116  }
2117  res = a[exp];
2118  b = p_Head(tail,r);
2119  for (e=exp-1; e>eh; e--)
2120  {
2121    h = a[e];
2122    x = n_Mult(bin[exp-e],pGetCoeff(h),r->cf);
2123    p_SetCoeff(h,x,r);
2124    p_MonMult(h,b,r);
2125    res = pNext(res) = h;
2126    p_MonMult(b,tail,r);
2127  }
2128  for (e=eh; e!=0; e--)
2129  {
2130    h = a[e];
2131    x = n_Mult(bin[e],pGetCoeff(h),r->cf);
2132    p_SetCoeff(h,x,r);
2133    p_MonMult(h,b,r);
2134    res = pNext(res) = h;
2135    p_MonMult(b,tail,r);
2136  }
2137  p_LmDelete(&tail,r);
2138  pNext(res) = b;
2139  pNext(b) = NULL;
2140  res = a[exp];
2141  omFreeSize((ADDRESS)a, al);
2142  pnFreeBin(bin, exp, r->cf);
2143//  tail=res;
2144// while((tail!=NULL)&&(pNext(tail)!=NULL))
2145// {
2146//   if(nIsZero(pGetCoeff(pNext(tail))))
2147//   {
2148//     pLmDelete(&pNext(tail));
2149//   }
2150//   else
2151//     pIter(tail);
2152// }
2153  p_Test(res,r);
2154  return res;
2155}
2156
2157static poly p_Pow(poly p, int i, const ring r)
2158{
2159  poly rc = p_Copy(p,r);
2160  i -= 2;
2161  do
2162  {
2163    rc = p_Mult_q(rc,p_Copy(p,r),r);
2164    p_Normalize(rc,r);
2165    i--;
2166  }
2167  while (i != 0);
2168  return p_Mult_q(rc,p,r);
2169}
2170
2171static poly p_Pow_charp(poly p, int i, const ring r)
2172{
2173  //assume char_p == i
2174  poly h=p;
2175  while(h!=NULL) { p_MonPower(h,i,r);pIter(h);}
2176  return p;
2177}
2178
2179/*2
2180* returns the i-th power of p
2181* p will be destroyed
2182*/
2183poly p_Power(poly p, int i, const ring r)
2184{
2185  poly rc=NULL;
2186
2187  if (i==0)
2188  {
2189    p_Delete(&p,r);
2190    return p_One(r);
2191  }
2192
2193  if(p!=NULL)
2194  {
2195    if ( (i > 0) && ((unsigned long ) i > (r->bitmask))
2196    #ifdef HAVE_SHIFTBBA
2197    && (!rIsLPRing(r))
2198    #endif
2199    )
2200    {
2201      Werror("exponent %d is too large, max. is %ld",i,r->bitmask);
2202      return NULL;
2203    }
2204    switch (i)
2205    {
2206// cannot happen, see above
2207//      case 0:
2208//      {
2209//        rc=pOne();
2210//        pDelete(&p);
2211//        break;
2212//      }
2213      case 1:
2214        rc=p;
2215        break;
2216      case 2:
2217        rc=p_Mult_q(p_Copy(p,r),p,r);
2218        break;
2219      default:
2220        if (i < 0)
2221        {
2222          p_Delete(&p,r);
2223          return NULL;
2224        }
2225        else
2226        {
2227#ifdef HAVE_PLURAL
2228          if (rIsNCRing(r)) /* in the NC case nothing helps :-( */
2229          {
2230            int j=i;
2231            rc = p_Copy(p,r);
2232            while (j>1)
2233            {
2234              rc = p_Mult_q(p_Copy(p,r),rc,r);
2235              j--;
2236            }
2237            p_Delete(&p,r);
2238            return rc;
2239          }
2240#endif
2241          rc = pNext(p);
2242          if (rc == NULL)
2243            return p_MonPower(p,i,r);
2244          /* else: binom ?*/
2245          int char_p=rChar(r);
2246          if ((char_p>0) && (i>char_p)
2247          && ((rField_is_Zp(r,char_p)
2248            || (rField_is_Zp_a(r,char_p)))))
2249          {
2250            poly h=p_Pow_charp(p_Copy(p,r),char_p,r);
2251            int rest=i-char_p;
2252            while (rest>=char_p)
2253            {
2254              rest-=char_p;
2255              h=p_Mult_q(h,p_Pow_charp(p_Copy(p,r),char_p,r),r);
2256            }
2257            poly res=h;
2258            if (rest>0)
2259              res=p_Mult_q(p_Power(p_Copy(p,r),rest,r),h,r);
2260            p_Delete(&p,r);
2261            return res;
2262          }
2263          if ((pNext(rc) != NULL)
2264             || rField_is_Ring(r)
2265             )
2266            return p_Pow(p,i,r);
2267          if ((char_p==0) || (i<=char_p))
2268            return p_TwoMonPower(p,i,r);
2269          return p_Pow(p,i,r);
2270        }
2271      /*end default:*/
2272    }
2273  }
2274  return rc;
2275}
2276
2277/* --------------------------------------------------------------------------------*/
2278/* content suff                                                                   */
2279//number p_InitContent(poly ph, const ring r);
2280
2281void p_Content(poly ph, const ring r)
2282{
2283  if (ph==NULL) return;
2284  const coeffs cf=r->cf;
2285  if (pNext(ph)==NULL)
2286  {
2287    p_SetCoeff(ph,n_Init(1,cf),r);
2288  }
2289  if (cf->cfSubringGcd==ndGcd) /* trivial gcd*/ return;
2290  number h=p_InitContent(ph,r); /* first guess of a gcd of all coeffs */
2291  poly p;
2292  if(n_IsOne(h,cf))
2293  {
2294    goto content_finish;
2295  }
2296  p=ph;
2297  // take the SubringGcd of all coeffs
2298  while (p!=NULL)
2299  {
2300    n_Normalize(pGetCoeff(p),cf);
2301    number d=n_SubringGcd(h,pGetCoeff(p),cf);
2302    n_Delete(&h,cf);
2303    h = d;
2304    if(n_IsOne(h,cf))
2305    {
2306      goto content_finish;
2307    }
2308    pIter(p);
2309  }
2310  // if found<>1, divide by it
2311  p = ph;
2312  while (p!=NULL)
2313  {
2314    number d = n_ExactDiv(pGetCoeff(p),h,cf);
2315    p_SetCoeff(p,d,r);
2316    pIter(p);
2317  }
2318content_finish:
2319  n_Delete(&h,r->cf);
2320  // and last: check leading sign:
2321  if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2322}
2323
2324#define CLEARENUMERATORS 1
2325
2326void p_ContentForGB(poly ph, const ring r)
2327{
2328  if(TEST_OPT_CONTENTSB) return;
2329  assume( ph != NULL );
2330
2331  assume( r != NULL ); assume( r->cf != NULL );
2332
2333
2334#if CLEARENUMERATORS
2335  if( 0 )
2336  {
2337    const coeffs C = r->cf;
2338      // experimentall (recursive enumerator treatment) of alg. Ext!
2339    CPolyCoeffsEnumerator itr(ph);
2340    n_ClearContent(itr, r->cf);
2341
2342    p_Test(ph, r); n_Test(pGetCoeff(ph), C);
2343    assume(n_GreaterZero(pGetCoeff(ph), C)); // ??
2344
2345      // if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2346    return;
2347  }
2348#endif
2349
2350
2351#ifdef HAVE_RINGS
2352  if (rField_is_Ring(r))
2353  {
2354    if (rField_has_Units(r))
2355    {
2356      number k = n_GetUnit(pGetCoeff(ph),r->cf);
2357      if (!n_IsOne(k,r->cf))
2358      {
2359        number tmpGMP = k;
2360        k = n_Invers(k,r->cf);
2361        n_Delete(&tmpGMP,r->cf);
2362        poly h = pNext(ph);
2363        p_SetCoeff(ph, n_Mult(pGetCoeff(ph), k,r->cf),r);
2364        while (h != NULL)
2365        {
2366          p_SetCoeff(h, n_Mult(pGetCoeff(h), k,r->cf),r);
2367          pIter(h);
2368        }
2369//        assume( n_GreaterZero(pGetCoeff(ph),r->cf) );
2370//        if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2371      }
2372      n_Delete(&k,r->cf);
2373    }
2374    return;
2375  }
2376#endif
2377  number h,d;
2378  poly p;
2379
2380  if(pNext(ph)==NULL)
2381  {
2382    p_SetCoeff(ph,n_Init(1,r->cf),r);
2383  }
2384  else
2385  {
2386    assume( pNext(ph) != NULL );
2387#if CLEARENUMERATORS
2388    if( nCoeff_is_Q(r->cf) )
2389    {
2390      // experimentall (recursive enumerator treatment) of alg. Ext!
2391      CPolyCoeffsEnumerator itr(ph);
2392      n_ClearContent(itr, r->cf);
2393
2394      p_Test(ph, r); n_Test(pGetCoeff(ph), r->cf);
2395      assume(n_GreaterZero(pGetCoeff(ph), r->cf)); // ??
2396
2397      // if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2398      return;
2399    }
2400#endif
2401
2402    n_Normalize(pGetCoeff(ph),r->cf);
2403    if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2404    if (rField_is_Q(r)||(getCoeffType(r->cf)==n_transExt)) // should not be used anymore if CLEARENUMERATORS is 1
2405    {
2406      h=p_InitContent(ph,r);
2407      p=ph;
2408    }
2409    else
2410    {
2411      h=n_Copy(pGetCoeff(ph),r->cf);
2412      p = pNext(ph);
2413    }
2414    while (p!=NULL)
2415    {
2416      n_Normalize(pGetCoeff(p),r->cf);
2417      d=n_SubringGcd(h,pGetCoeff(p),r->cf);
2418      n_Delete(&h,r->cf);
2419      h = d;
2420      if(n_IsOne(h,r->cf))
2421      {
2422        break;
2423      }
2424      pIter(p);
2425    }
2426    //number tmp;
2427    if(!n_IsOne(h,r->cf))
2428    {
2429      p = ph;
2430      while (p!=NULL)
2431      {
2432        //d = nDiv(pGetCoeff(p),h);
2433        //tmp = nExactDiv(pGetCoeff(p),h);
2434        //if (!nEqual(d,tmp))
2435        //{
2436        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
2437        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
2438        //  nWrite(tmp);Print(StringEndS("\n")); // NOTE/TODO: use StringAppendS("\n"); omFree(s);
2439        //}
2440        //nDelete(&tmp);
2441        d = n_ExactDiv(pGetCoeff(p),h,r->cf);
2442        p_SetCoeff(p,d,r);
2443        pIter(p);
2444      }
2445    }
2446    n_Delete(&h,r->cf);
2447    if (rField_is_Q_a(r))
2448    {
2449      // special handling for alg. ext.:
2450      if (getCoeffType(r->cf)==n_algExt)
2451      {
2452        h = n_Init(1, r->cf->extRing->cf);
2453        p=ph;
2454        while (p!=NULL)
2455        { // each monom: coeff in Q_a
2456          poly c_n_n=(poly)pGetCoeff(p);
2457          poly c_n=c_n_n;
2458          while (c_n!=NULL)
2459          { // each monom: coeff in Q
2460            d=n_NormalizeHelper(h,pGetCoeff(c_n),r->cf->extRing->cf);
2461            n_Delete(&h,r->cf->extRing->cf);
2462            h=d;
2463            pIter(c_n);
2464          }
2465          pIter(p);
2466        }
2467        /* h contains the 1/lcm of all denominators in c_n_n*/
2468        //n_Normalize(h,r->cf->extRing->cf);
2469        if(!n_IsOne(h,r->cf->extRing->cf))
2470        {
2471          p=ph;
2472          while (p!=NULL)
2473          { // each monom: coeff in Q_a
2474            poly c_n=(poly)pGetCoeff(p);
2475            while (c_n!=NULL)
2476            { // each monom: coeff in Q
2477              d=n_Mult(h,pGetCoeff(c_n),r->cf->extRing->cf);
2478              n_Normalize(d,r->cf->extRing->cf);
2479              n_Delete(&pGetCoeff(c_n),r->cf->extRing->cf);
2480              pGetCoeff(c_n)=d;
2481              pIter(c_n);
2482            }
2483            pIter(p);
2484          }
2485        }
2486        n_Delete(&h,r->cf->extRing->cf);
2487      }
2488      /*else
2489      {
2490      // special handling for rat. functions.:
2491        number hzz =NULL;
2492        p=ph;
2493        while (p!=NULL)
2494        { // each monom: coeff in Q_a (Z_a)
2495          fraction f=(fraction)pGetCoeff(p);
2496          poly c_n=NUM(f);
2497          if (hzz==NULL)
2498          {
2499            hzz=n_Copy(pGetCoeff(c_n),r->cf->extRing->cf);
2500            pIter(c_n);
2501          }
2502          while ((c_n!=NULL)&&(!n_IsOne(hzz,r->cf->extRing->cf)))
2503          { // each monom: coeff in Q (Z)
2504            d=n_Gcd(hzz,pGetCoeff(c_n),r->cf->extRing->cf);
2505            n_Delete(&hzz,r->cf->extRing->cf);
2506            hzz=d;
2507            pIter(c_n);
2508          }
2509          pIter(p);
2510        }
2511        // hzz contains the gcd of all numerators in f
2512        h=n_Invers(hzz,r->cf->extRing->cf);
2513        n_Delete(&hzz,r->cf->extRing->cf);
2514        n_Normalize(h,r->cf->extRing->cf);
2515        if(!n_IsOne(h,r->cf->extRing->cf))
2516        {
2517          p=ph;
2518          while (p!=NULL)
2519          { // each monom: coeff in Q_a (Z_a)
2520            fraction f=(fraction)pGetCoeff(p);
2521            NUM(f)=__p_Mult_nn(NUM(f),h,r->cf->extRing);
2522            p_Normalize(NUM(f),r->cf->extRing);
2523            pIter(p);
2524          }
2525        }
2526        n_Delete(&h,r->cf->extRing->cf);
2527      }*/
2528    }
2529  }
2530  if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2531}
2532
2533// Not yet?
2534#if 1 // currently only used by Singular/janet
2535void p_SimpleContent(poly ph, int smax, const ring r)
2536{
2537  if(TEST_OPT_CONTENTSB) return;
2538  if (ph==NULL) return;
2539  if (pNext(ph)==NULL)
2540  {
2541    p_SetCoeff(ph,n_Init(1,r->cf),r);
2542    return;
2543  }
2544  if ((pNext(pNext(ph))==NULL)||(!rField_is_Q(r)))
2545  {
2546    return;
2547  }
2548  number d=p_InitContent(ph,r);
2549  if (n_Size(d,r->cf)<=smax)
2550  {
2551    //if (TEST_OPT_PROT) PrintS("G");
2552    return;
2553  }
2554
2555  poly p=ph;
2556  number h=d;
2557  if (smax==1) smax=2;
2558  while (p!=NULL)
2559  {
2560#if 0
2561    d=n_Gcd(h,pGetCoeff(p),r->cf);
2562    n_Delete(&h,r->cf);
2563    h = d;
2564#else
2565    STATISTIC(n_Gcd); nlInpGcd(h,pGetCoeff(p),r->cf);
2566#endif
2567    if(n_Size(h,r->cf)<smax)
2568    {
2569      //if (TEST_OPT_PROT) PrintS("g");
2570      return;
2571    }
2572    pIter(p);
2573  }
2574  p = ph;
2575  if (!n_GreaterZero(pGetCoeff(p),r->cf)) h=n_InpNeg(h,r->cf);
2576  if(n_IsOne(h,r->cf)) return;
2577  //if (TEST_OPT_PROT) PrintS("c");
2578  while (p!=NULL)
2579  {
2580#if 1
2581    d = n_ExactDiv(pGetCoeff(p),h,r->cf);
2582    p_SetCoeff(p,d,r);
2583#else
2584    STATISTIC(n_ExactDiv); nlInpExactDiv(pGetCoeff(p),h,r->cf); // no such function... ?
2585#endif
2586    pIter(p);
2587  }
2588  n_Delete(&h,r->cf);
2589}
2590#endif
2591
2592number p_InitContent(poly ph, const ring r)
2593// only for coefficients in Q and rational functions
2594#if 0
2595{
2596  assume(!TEST_OPT_CONTENTSB);
2597  assume(ph!=NULL);
2598  assume(pNext(ph)!=NULL);
2599  assume(rField_is_Q(r));
2600  if (pNext(pNext(ph))==NULL)
2601  {
2602    return n_GetNumerator(pGetCoeff(pNext(ph)),r->cf);
2603  }
2604  poly p=ph;
2605  number n1=n_GetNumerator(pGetCoeff(p),r->cf);
2606  pIter(p);
2607  number n2=n_GetNumerator(pGetCoeff(p),r->cf);
2608  pIter(p);
2609  number d;
2610  number t;
2611  loop
2612  {
2613    nlNormalize(pGetCoeff(p),r->cf);
2614    t=n_GetNumerator(pGetCoeff(p),r->cf);
2615    if (nlGreaterZero(t,r->cf))
2616      d=nlAdd(n1,t,r->cf);
2617    else
2618      d=nlSub(n1,t,r->cf);
2619    nlDelete(&t,r->cf);
2620    nlDelete(&n1,r->cf);
2621    n1=d;
2622    pIter(p);
2623    if (p==NULL) break;
2624    nlNormalize(pGetCoeff(p),r->cf);
2625    t=n_GetNumerator(pGetCoeff(p),r->cf);
2626    if (nlGreaterZero(t,r->cf))
2627      d=nlAdd(n2,t,r->cf);
2628    else
2629      d=nlSub(n2,t,r->cf);
2630    nlDelete(&t,r->cf);
2631    nlDelete(&n2,r->cf);
2632    n2=d;
2633    pIter(p);
2634    if (p==NULL) break;
2635  }
2636  d=nlGcd(n1,n2,r->cf);
2637  nlDelete(&n1,r->cf);
2638  nlDelete(&n2,r->cf);
2639  return d;
2640}
2641#else
2642{
2643  /* ph has al least 2 terms */
2644  number d=pGetCoeff(ph);
2645  int s=n_Size(d,r->cf);
2646  pIter(ph);
2647  number d2=pGetCoeff(ph);
2648  int s2=n_Size(d2,r->cf);
2649  pIter(ph);
2650  if (ph==NULL)
2651  {
2652    if (s<s2) return n_Copy(d,r->cf);
2653    else      return n_Copy(d2,r->cf);
2654  }
2655  do
2656  {
2657    number nd=pGetCoeff(ph);
2658    int ns=n_Size(nd,r->cf);
2659    if (ns<=2)
2660    {
2661      s2=s;
2662      d2=d;
2663      d=nd;
2664      s=ns;
2665      break;
2666    }
2667    else if (ns<s)
2668    {
2669      s2=s;
2670      d2=d;
2671      d=nd;
2672      s=ns;
2673    }
2674    pIter(ph);
2675  }
2676  while(ph!=NULL);
2677  return n_SubringGcd(d,d2,r->cf);
2678}
2679#endif
2680
2681//void pContent(poly ph)
2682//{
2683//  number h,d;
2684//  poly p;
2685//
2686//  p = ph;
2687//  if(pNext(p)==NULL)
2688//  {
2689//    pSetCoeff(p,nInit(1));
2690//  }
2691//  else
2692//  {
2693//#ifdef PDEBUG
2694//    if (!pTest(p)) return;
2695//#endif
2696//    nNormalize(pGetCoeff(p));
2697//    if(!nGreaterZero(pGetCoeff(ph)))
2698//    {
2699//      ph = pNeg(ph);
2700//      nNormalize(pGetCoeff(p));
2701//    }
2702//    h=pGetCoeff(p);
2703//    pIter(p);
2704//    while (p!=NULL)
2705//    {
2706//      nNormalize(pGetCoeff(p));
2707//      if (nGreater(h,pGetCoeff(p))) h=pGetCoeff(p);
2708//      pIter(p);
2709//    }
2710//    h=nCopy(h);
2711//    p=ph;
2712//    while (p!=NULL)
2713//    {
2714//      d=n_Gcd(h,pGetCoeff(p));
2715//      nDelete(&h);
2716//      h = d;
2717//      if(nIsOne(h))
2718//      {
2719//        break;
2720//      }
2721//      pIter(p);
2722//    }
2723//    p = ph;
2724//    //number tmp;
2725//    if(!nIsOne(h))
2726//    {
2727//      while (p!=NULL)
2728//      {
2729//        d = nExactDiv(pGetCoeff(p),h);
2730//        pSetCoeff(p,d);
2731//        pIter(p);
2732//      }
2733//    }
2734//    nDelete(&h);
2735//    if ( (nGetChar() == 1) || (nGetChar() < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
2736//    {
2737//      pTest(ph);
2738//      singclap_divide_content(ph);
2739//      pTest(ph);
2740//    }
2741//  }
2742//}
2743#if 0
2744void p_Content(poly ph, const ring r)
2745{
2746  number h,d;
2747  poly p;
2748
2749  if(pNext(ph)==NULL)
2750  {
2751    p_SetCoeff(ph,n_Init(1,r->cf),r);
2752  }
2753  else
2754  {
2755    n_Normalize(pGetCoeff(ph),r->cf);
2756    if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2757    h=n_Copy(pGetCoeff(ph),r->cf);
2758    p = pNext(ph);
2759    while (p!=NULL)
2760    {
2761      n_Normalize(pGetCoeff(p),r->cf);
2762      d=n_Gcd(h,pGetCoeff(p),r->cf);
2763      n_Delete(&h,r->cf);
2764      h = d;
2765      if(n_IsOne(h,r->cf))
2766      {
2767        break;
2768      }
2769      pIter(p);
2770    }
2771    p = ph;
2772    //number tmp;
2773    if(!n_IsOne(h,r->cf))
2774    {
2775      while (p!=NULL)
2776      {
2777        //d = nDiv(pGetCoeff(p),h);
2778        //tmp = nExactDiv(pGetCoeff(p),h);
2779        //if (!nEqual(d,tmp))
2780        //{
2781        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
2782        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
2783        //  nWrite(tmp);Print(StringEndS("\n")); // NOTE/TODO: use StringAppendS("\n"); omFree(s);
2784        //}
2785        //nDelete(&tmp);
2786        d = n_ExactDiv(pGetCoeff(p),h,r->cf);
2787        p_SetCoeff(p,d,r->cf);
2788        pIter(p);
2789      }
2790    }
2791    n_Delete(&h,r->cf);
2792    //if ( (n_GetChar(r) == 1) || (n_GetChar(r) < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
2793    //{
2794    //  singclap_divide_content(ph);
2795    //  if(!n_GreaterZero(pGetCoeff(ph),r)) ph = p_Neg(ph,r);
2796    //}
2797  }
2798}
2799#endif
2800/* ---------------------------------------------------------------------------*/
2801/* cleardenom suff                                                           */
2802poly p_Cleardenom(poly p, const ring r)
2803{
2804  if( p == NULL )
2805    return NULL;
2806
2807  assume( r != NULL ); assume( r->cf != NULL ); const coeffs C = r->cf;
2808
2809#if CLEARENUMERATORS
2810  if( 0 )
2811  {
2812    CPolyCoeffsEnumerator itr(p);
2813    n_ClearDenominators(itr, C);
2814    n_ClearContent(itr, C); // divide out the content
2815    p_Test(p, r); n_Test(pGetCoeff(p), C);
2816    assume(n_GreaterZero(pGetCoeff(p), C)); // ??
2817//    if(!n_GreaterZero(pGetCoeff(p),C)) p = p_Neg(p,r);
2818    return p;
2819  }
2820#endif
2821
2822  number d, h;
2823
2824  if (rField_is_Ring(r))
2825  {
2826    p_ContentForGB(p,r);
2827    if(!n_GreaterZero(pGetCoeff(p),C)) p = p_Neg(p,r);
2828    return p;
2829  }
2830
2831  if (rField_is_Zp(r) && TEST_OPT_INTSTRATEGY)
2832  {
2833    if(!n_GreaterZero(pGetCoeff(p),C)) p = p_Neg(p,r);
2834    return p;
2835  }
2836
2837  assume(p != NULL);
2838
2839  if(pNext(p)==NULL)
2840  {
2841    if (!TEST_OPT_CONTENTSB
2842    && !rField_is_Ring(r))
2843      p_SetCoeff(p,n_Init(1,r->cf),r);
2844    else if(!n_GreaterZero(pGetCoeff(p),C))
2845      p = p_Neg(p,r);
2846    return p;
2847  }
2848
2849  assume(pNext(p)!=NULL);
2850  poly start=p;
2851
2852#if 0 && CLEARENUMERATORS
2853//CF: does not seem to work that well..
2854
2855  if( nCoeff_is_Q(C) || nCoeff_is_Q_a(C) )
2856  {
2857    CPolyCoeffsEnumerator itr(p);
2858    n_ClearDenominators(itr, C);
2859    n_ClearContent(itr, C); // divide out the content
2860    p_Test(p, r); n_Test(pGetCoeff(p), C);
2861    assume(n_GreaterZero(pGetCoeff(p), C)); // ??
2862//    if(!n_GreaterZero(pGetCoeff(p),C)) p = p_Neg(p,r);
2863    return start;
2864  }
2865#endif
2866
2867  if(1)
2868  {
2869    // get lcm of all denominators ----------------------------------
2870    h = n_Init(1,r->cf);
2871    while (p!=NULL)
2872    {
2873      n_Normalize(pGetCoeff(p),r->cf);
2874      d=n_NormalizeHelper(h,pGetCoeff(p),r->cf);
2875      n_Delete(&h,r->cf);
2876      h=d;
2877      pIter(p);
2878    }
2879    /* h now contains the 1/lcm of all denominators */
2880    if(!n_IsOne(h,r->cf))
2881    {
2882      // multiply by the lcm of all denominators
2883      p = start;
2884      while (p!=NULL)
2885      {
2886        d=n_Mult(h,pGetCoeff(p),r->cf);
2887        n_Normalize(d,r->cf);
2888        p_SetCoeff(p,d,r);
2889        pIter(p);
2890      }
2891    }
2892    n_Delete(&h,r->cf);
2893    p=start;
2894
2895    p_ContentForGB(p,r);
2896#ifdef HAVE_RATGRING
2897    if (rIsRatGRing(r))
2898    {
2899      /* quick unit detection in the rational case is done in gr_nc_bba */
2900      p_ContentRat(p, r);
2901      start=p;
2902    }
2903#endif
2904  }
2905
2906  if(!n_GreaterZero(pGetCoeff(p),C)) p = p_Neg(p,r);
2907
2908  return start;
2909}
2910
2911void p_Cleardenom_n(poly ph,const ring r,number &c)
2912{
2913  const coeffs C = r->cf;
2914  number d, h;
2915
2916  assume( ph != NULL );
2917
2918  poly p = ph;
2919
2920#if CLEARENUMERATORS
2921  if( 0 )
2922  {
2923    CPolyCoeffsEnumerator itr(ph);
2924
2925    n_ClearDenominators(itr, d, C); // multiply with common denom. d
2926    n_ClearContent(itr, h, C); // divide by the content h
2927
2928    c = n_Div(d, h, C); // d/h
2929
2930    n_Delete(&d, C);
2931    n_Delete(&h, C);
2932
2933    n_Test(c, C);
2934
2935    p_Test(ph, r); n_Test(pGetCoeff(ph), C);
2936    assume(n_GreaterZero(pGetCoeff(ph), C)); // ??
2937/*
2938    if(!n_GreaterZero(pGetCoeff(ph),C))
2939    {
2940      ph = p_Neg(ph,r);
2941      c = n_InpNeg(c, C);
2942    }
2943*/
2944    return;
2945  }
2946#endif
2947
2948
2949  if( pNext(p) == NULL )
2950  {
2951    if(!TEST_OPT_CONTENTSB)
2952    {
2953      c=n_Invers(pGetCoeff(p), C);
2954      p_SetCoeff(p, n_Init(1, C), r);
2955    }
2956    else
2957    {
2958      c=n_Init(1,C);
2959    }
2960
2961    if(!n_GreaterZero(pGetCoeff(ph),C))
2962    {
2963      ph = p_Neg(ph,r);
2964      c = n_InpNeg(c, C);
2965    }
2966
2967    return;
2968  }
2969  if (TEST_OPT_CONTENTSB) { c=n_Init(1,C); return; }
2970
2971  assume( pNext(p) != NULL );
2972
2973#if CLEARENUMERATORS
2974  if( nCoeff_is_Q(C) || nCoeff_is_Q_a(C) )
2975  {
2976    CPolyCoeffsEnumerator itr(ph);
2977
2978    n_ClearDenominators(itr, d, C); // multiply with common denom. d
2979    n_ClearContent(itr, h, C); // divide by the content h
2980
2981    c = n_Div(d, h, C); // d/h
2982
2983    n_Delete(&d, C);
2984    n_Delete(&h, C);
2985
2986    n_Test(c, C);
2987
2988    p_Test(ph, r); n_Test(pGetCoeff(ph), C);
2989    assume(n_GreaterZero(pGetCoeff(ph), C)); // ??
2990/*
2991    if(!n_GreaterZero(pGetCoeff(ph),C))
2992    {
2993      ph = p_Neg(ph,r);
2994      c = n_InpNeg(c, C);
2995    }
2996*/
2997    return;
2998  }
2999#endif
3000
3001
3002
3003
3004  if(1)
3005  {
3006    h = n_Init(1,r->cf);
3007    while (p!=NULL)
3008    {
3009      n_Normalize(pGetCoeff(p),r->cf);
3010      d=n_NormalizeHelper(h,pGetCoeff(p),r->cf);
3011      n_Delete(&h,r->cf);
3012      h=d;
3013      pIter(p);
3014    }
3015    c=h;
3016    /* contains the 1/lcm of all denominators */
3017    if(!n_IsOne(h,r->cf))
3018    {
3019      p = ph;
3020      while (p!=NULL)
3021      {
3022        /* should be: // NOTE: don't use ->coef!!!!
3023        * number hh;
3024        * nGetDenom(p->coef,&hh);
3025        * nMult(&h,&hh,&d);
3026        * nNormalize(d);
3027        * nDelete(&hh);
3028        * nMult(d,p->coef,&hh);
3029        * nDelete(&d);
3030        * nDelete(&(p->coef));
3031        * p->coef =hh;
3032        */
3033        d=n_Mult(h,pGetCoeff(p),r->cf);
3034        n_Normalize(d,r->cf);
3035        p_SetCoeff(p,d,r);
3036        pIter(p);
3037      }
3038      if (rField_is_Q_a(r))
3039      {
3040        loop
3041        {
3042          h = n_Init(1,r->cf);
3043          p=ph;
3044          while (p!=NULL)
3045          {
3046            d=n_NormalizeHelper(h,pGetCoeff(p),r->cf);
3047            n_Delete(&h,r->cf);
3048            h=d;
3049            pIter(p);
3050          }
3051          /* contains the 1/lcm of all denominators */
3052          if(!n_IsOne(h,r->cf))
3053          {
3054            p = ph;
3055            while (p!=NULL)
3056            {
3057              /* should be: // NOTE: don't use ->coef!!!!
3058              * number hh;
3059              * nGetDenom(p->coef,&hh);
3060              * nMult(&h,&hh,&d);
3061              * nNormalize(d);
3062              * nDelete(&hh);
3063              * nMult(d,p->coef,&hh);
3064              * nDelete(&d);
3065              * nDelete(&(p->coef));
3066              * p->coef =hh;
3067              */
3068              d=n_Mult(h,pGetCoeff(p),r->cf);
3069              n_Normalize(d,r->cf);
3070              p_SetCoeff(p,d,r);
3071              pIter(p);
3072            }
3073            number t=n_Mult(c,h,r->cf);
3074            n_Delete(&c,r->cf);
3075            c=t;
3076          }
3077          else
3078          {
3079            break;
3080          }
3081          n_Delete(&h,r->cf);
3082        }
3083      }
3084    }
3085  }
3086
3087  if(!n_GreaterZero(pGetCoeff(ph),C))
3088  {
3089    ph = p_Neg(ph,r);
3090    c = n_InpNeg(c, C);
3091  }
3092
3093}
3094
3095  // normalization: for poly over Q: make poly primitive, integral
3096  //                              Qa make poly integral with leading
3097  //                                  coefficient minimal in N
3098  //                            Q(t) make poly primitive, integral
3099
3100void p_ProjectiveUnique(poly ph, const ring r)
3101{
3102  if( ph == NULL )
3103    return;
3104
3105  assume( r != NULL ); assume( r->cf != NULL );
3106  const coeffs C = r->cf;
3107
3108  number h;
3109  poly p;
3110
3111  if (nCoeff_is_Ring(C))
3112  {
3113    p_ContentForGB(ph,r);
3114    if(!n_GreaterZero(pGetCoeff(ph),C)) ph = p_Neg(ph,r);
3115        assume( n_GreaterZero(pGetCoeff(ph),C) );
3116    return;
3117  }
3118
3119  if (nCoeff_is_Zp(C) && TEST_OPT_INTSTRATEGY)
3120  {
3121    assume( n_GreaterZero(pGetCoeff(ph),C) );
3122    if(!n_GreaterZero(pGetCoeff(ph),C)) ph = p_Neg(ph,r);
3123    return;
3124  }
3125  p = ph;
3126
3127  assume(p != NULL);
3128
3129  if(pNext(p)==NULL) // a monomial
3130  {
3131    p_SetCoeff(p, n_Init(1, C), r);
3132    return;
3133  }
3134
3135  assume(pNext(p)!=NULL);
3136
3137  if(!nCoeff_is_Q(C) && !nCoeff_is_transExt(C))
3138  {
3139    h = p_GetCoeff(p, C);
3140    number hInv = n_Invers(h, C);
3141    pIter(p);
3142    while (p!=NULL)
3143    {
3144      p_SetCoeff(p, n_Mult(p_GetCoeff(p, C), hInv, C), r);
3145      pIter(p);
3146    }
3147    n_Delete(&hInv, C);
3148    p = ph;
3149    p_SetCoeff(p, n_Init(1, C), r);
3150  }
3151
3152  p_Cleardenom(ph, r); //removes also Content
3153
3154
3155    /* normalize ph over a transcendental extension s.t.
3156       lead (ph) is > 0 if extRing->cf == Q
3157       or lead (ph) is monic if extRing->cf == Zp*/
3158  if (nCoeff_is_transExt(C))
3159  {
3160    p= ph;
3161    h= p_GetCoeff (p, C);
3162    fraction f = (fraction) h;
3163    number n=p_GetCoeff (NUM (f),C->extRing->cf);
3164    if (rField_is_Q (C->extRing))
3165    {
3166      if (!n_GreaterZero(n,C->extRing->cf))
3167      {
3168        p=p_Neg (p,r);
3169      }
3170    }
3171    else if (rField_is_Zp(C->extRing))
3172    {
3173      if (!n_IsOne (n, C->extRing->cf))
3174      {
3175        n=n_Invers (n,C->extRing->cf);
3176        nMapFunc nMap;
3177        nMap= n_SetMap (C->extRing->cf, C);
3178        number ninv= nMap (n,C->extRing->cf, C);
3179        p=__p_Mult_nn (p, ninv, r);
3180        n_Delete (&ninv, C);
3181        n_Delete (&n, C->extRing->cf);
3182      }
3183    }
3184    p= ph;
3185  }
3186
3187  return;
3188}
3189
3190#if 0   /*unused*/
3191number p_GetAllDenom(poly ph, const ring r)
3192{
3193  number d=n_Init(1,r->cf);
3194  poly p = ph;
3195
3196  while (p!=NULL)
3197  {
3198    number h=n_GetDenom(pGetCoeff(p),r->cf);
3199    if (!n_IsOne(h,r->cf))
3200    {
3201      number dd=n_Mult(d,h,r->cf);
3202      n_Delete(&d,r->cf);
3203      d=dd;
3204    }
3205    n_Delete(&h,r->cf);
3206    pIter(p);
3207  }
3208  return d;
3209}
3210#endif
3211
3212int p_Size(poly p, const ring r)
3213{
3214  int count = 0;
3215  if (r->cf->has_simple_Alloc)
3216    return pLength(p);
3217  while ( p != NULL )
3218  {
3219    count+= n_Size( pGetCoeff( p ), r->cf );
3220    pIter( p );
3221  }
3222  return count;
3223}
3224
3225/*2
3226*make p homogeneous by multiplying the monomials by powers of x_varnum
3227*assume: deg(var(varnum))==1
3228*/
3229poly p_Homogen (poly p, int varnum, const ring r)
3230{
3231  pFDegProc deg;
3232  if (r->pLexOrder && (r->order[0]==ringorder_lp))
3233    deg=p_Totaldegree;
3234  else
3235    deg=r->pFDeg;
3236
3237  poly q=NULL, qn;
3238  int  o,ii;
3239  sBucket_pt bp;
3240
3241  if (p!=NULL)
3242  {
3243    if ((varnum < 1) || (varnum > rVar(r)))
3244    {
3245      return NULL;
3246    }
3247    o=deg(p,r);
3248    q=pNext(p);
3249    while (q != NULL)
3250    {
3251      ii=deg(q,r);
3252      if (ii>o) o=ii;
3253      pIter(q);
3254    }
3255    q = p_Copy(p,r);
3256    bp = sBucketCreate(r);
3257    while (q != NULL)
3258    {
3259      ii = o-deg(q,r);
3260      if (ii!=0)
3261      {
3262        p_AddExp(q,varnum, (long)ii,r);
3263        p_Setm(q,r);
3264      }
3265      qn = pNext(q);
3266      pNext(q) = NULL;
3267      sBucket_Add_m(bp, q);
3268      q = qn;
3269    }
3270    sBucketDestroyAdd(bp, &q, &ii);
3271  }
3272  return q;
3273}
3274
3275/*2
3276*tests if p is homogeneous with respect to the actual weigths
3277*/
3278BOOLEAN p_IsHomogeneous (poly p, const ring r)
3279{
3280  poly qp=p;
3281  int o;
3282
3283  if ((p == NULL) || (pNext(p) == NULL)) return TRUE;
3284  pFDegProc d;
3285  if (r->pLexOrder && (r->order[0]==ringorder_lp))
3286    d=p_Totaldegree;
3287  else
3288    d=r->pFDeg;
3289  o = d(p,r);
3290  do
3291  {
3292    if (d(qp,r) != o) return FALSE;
3293    pIter(qp);
3294  }
3295  while (qp != NULL);
3296  return TRUE;
3297}
3298
3299/*----------utilities for syzygies--------------*/
3300BOOLEAN   p_VectorHasUnitB(poly p, int * k, const ring r)
3301{
3302  poly q=p,qq;
3303  int i;
3304
3305  while (q!=NULL)
3306  {
3307    if (p_LmIsConstantComp(q,r))
3308    {
3309      i = __p_GetComp(q,r);
3310      qq = p;
3311      while ((qq != q) && (__p_GetComp(qq,r) != i)) pIter(qq);
3312      if (qq == q)
3313      {
3314        *k = i;
3315        return TRUE;
3316      }
3317    }
3318    pIter(q);
3319  }
3320  return FALSE;
3321}
3322
3323void   p_VectorHasUnit(poly p, int * k, int * len, const ring r)
3324{
3325  poly q=p,qq;
3326  int i,j=0;
3327
3328  *len = 0;
3329  while (q!=NULL)
3330  {
3331    if (p_LmIsConstantComp(q,r))
3332    {
3333      i = __p_GetComp(q,r);
3334      qq = p;
3335      while ((qq != q) && (__p_GetComp(qq,r) != i)) pIter(qq);
3336      if (qq == q)
3337      {
3338       j = 0;
3339       while (qq!=NULL)
3340       {
3341         if (__p_GetComp(qq,r)==i) j++;
3342        pIter(qq);
3343       }
3344       if ((*len == 0) || (j<*len))
3345       {
3346         *len = j;
3347         *k = i;
3348       }
3349      }
3350    }
3351    pIter(q);
3352  }
3353}
3354
3355poly p_TakeOutComp1(poly * p, int k, const ring r)
3356{
3357  poly q = *p;
3358
3359  if (q==NULL) return NULL;
3360
3361  poly qq=NULL,result = NULL;
3362
3363  if (__p_GetComp(q,r)==k)
3364  {
3365    result = q; /* *p */
3366    while ((q!=NULL) && (__p_GetComp(q,r)==k))
3367    {
3368      p_SetComp(q,0,r);
3369      p_SetmComp(q,r);
3370      qq = q;
3371      pIter(q);
3372    }
3373    *p = q;
3374    pNext(qq) = NULL;
3375  }
3376  if (q==NULL) return result;
3377//  if (pGetComp(q) > k) pGetComp(q)--;
3378  while (pNext(q)!=NULL)
3379  {
3380    if (__p_GetComp(pNext(q),r)==k)
3381    {
3382      if (result==NULL)
3383      {
3384        result = pNext(q);
3385        qq = result;
3386      }
3387      else
3388      {
3389        pNext(qq) = pNext(q);
3390        pIter(qq);
3391      }
3392      pNext(q) = pNext(pNext(q));
3393      pNext(qq) =NULL;
3394      p_SetComp(qq,0,r);
3395      p_SetmComp(qq,r);
3396    }
3397    else
3398    {
3399      pIter(q);
3400//      if (pGetComp(q) > k) pGetComp(q)--;
3401    }
3402  }
3403  return result;
3404}
3405
3406poly p_TakeOutComp(poly * p, int k, const ring r)
3407{
3408  poly q = *p,qq=NULL,result = NULL;
3409
3410  if (q==NULL) return NULL;
3411  BOOLEAN use_setmcomp=rOrd_SetCompRequiresSetm(r);
3412  if (__p_GetComp(q,r)==k)
3413  {
3414    result = q;
3415    do
3416    {
3417      p_SetComp(q,0,r);
3418      if (use_setmcomp) p_SetmComp(q,r);
3419      qq = q;
3420      pIter(q);
3421    }
3422    while ((q!=NULL) && (__p_GetComp(q,r)==k));
3423    *p = q;
3424    pNext(qq) = NULL;
3425  }
3426  if (q==NULL) return result;
3427  if (__p_GetComp(q,r) > k)
3428  {
3429    p_SubComp(q,1,r);
3430    if (use_setmcomp) p_SetmComp(q,r);
3431  }
3432  poly pNext_q;
3433  while ((pNext_q=pNext(q))!=NULL)
3434  {
3435    if (__p_GetComp(pNext_q,r)==k)
3436    {
3437      if (result==NULL)
3438      {
3439        result = pNext_q;
3440        qq = result;
3441      }
3442      else
3443      {
3444        pNext(qq) = pNext_q;
3445        pIter(qq);
3446      }
3447      pNext(q) = pNext(pNext_q);
3448      pNext(qq) =NULL;
3449      p_SetComp(qq,0,r);
3450      if (use_setmcomp) p_SetmComp(qq,r);
3451    }
3452    else
3453    {
3454      /*pIter(q);*/ q=pNext_q;
3455      if (__p_GetComp(q,r) > k)
3456      {
3457        p_SubComp(q,1,r);
3458        if (use_setmcomp) p_SetmComp(q,r);
3459      }
3460    }
3461  }
3462  return result;
3463}
3464
3465// Splits *p into two polys: *q which consists of all monoms with
3466// component == comp and *p of all other monoms *lq == pLength(*q)
3467void p_TakeOutComp(poly *r_p, long comp, poly *r_q, int *lq, const ring r)
3468{
3469  spolyrec pp, qq;
3470  poly p, q, p_prev;
3471  int l = 0;
3472
3473#ifndef SING_NDEBUG
3474  int lp = pLength(*r_p);
3475#endif
3476
3477  pNext(&pp) = *r_p;
3478  p = *r_p;
3479  p_prev = &pp;
3480  q = &qq;
3481
3482  while(p != NULL)
3483  {
3484    while (__p_GetComp(p,r) == comp)
3485    {
3486      pNext(q) = p;
3487      pIter(q);
3488      p_SetComp(p, 0,r);
3489      p_SetmComp(p,r);
3490      pIter(p);
3491      l++;
3492      if (p == NULL)
3493      {
3494        pNext(p_prev) = NULL;
3495        goto Finish;
3496      }
3497    }
3498    pNext(p_prev) = p;
3499    p_prev = p;
3500    pIter(p);
3501  }
3502
3503  Finish:
3504  pNext(q) = NULL;
3505  *r_p = pNext(&pp);
3506  *r_q = pNext(&qq);
3507  *lq = l;
3508#ifndef SING_NDEBUG
3509  assume(pLength(*r_p) + pLength(*r_q) == lp);
3510#endif
3511  p_Test(*r_p,r);
3512  p_Test(*r_q,r);
3513}
3514
3515void p_DeleteComp(poly * p,int k, const ring r)
3516{
3517  poly q;
3518
3519  while ((*p!=NULL) && (__p_GetComp(*p,r)==k)) p_LmDelete(p,r);
3520  if (*p==NULL) return;
3521  q = *p;
3522  if (__p_GetComp(q,r)>k)
3523  {
3524    p_SubComp(q,1,r);
3525    p_SetmComp(q,r);
3526  }
3527  while (pNext(q)!=NULL)
3528  {
3529    if (__p_GetComp(pNext(q),r)==k)
3530      p_LmDelete(&(pNext(q)),r);
3531    else
3532    {
3533      pIter(q);
3534      if (__p_GetComp(q,r)>k)
3535      {
3536        p_SubComp(q,1,r);
3537        p_SetmComp(q,r);
3538      }
3539    }
3540  }
3541}
3542
3543poly p_Vec2Poly(poly v, int k, const ring r)
3544{
3545  poly h;
3546  poly res=NULL;
3547
3548  while (v!=NULL)
3549  {
3550    if (__p_GetComp(v,r)==k)
3551    {
3552      h=p_Head(v,r);
3553      p_SetComp(h,0,r);
3554      pNext(h)=res;res=h;
3555    }
3556    pIter(v);
3557  }
3558  if (res!=NULL) res=pReverse(res);
3559  return res;
3560}
3561
3562/// vector to already allocated array (len>=p_MaxComp(v,r))
3563// also used for p_Vec2Polys
3564void  p_Vec2Array(poly v, poly *p, int len, const ring r)
3565{
3566  poly h;
3567  int k;
3568
3569  for(int i=len-1;i>=0;i--) p[i]=NULL;
3570  while (v!=NULL)
3571  {
3572    h=p_Head(v,r);
3573    k=__p_GetComp(h,r);
3574    if (k>len) { Werror("wrong rank:%d, should be %d",len,k); }
3575    else
3576    {
3577      p_SetComp(h,0,r);
3578      p_Setm(h,r);
3579      pNext(h)=p[k-1];p[k-1]=h;
3580    }
3581    pIter(v);
3582  }
3583  for(int i=len-1;i>=0;i--)
3584  {
3585    if (p[i]!=NULL) p[i]=pReverse(p[i]);
3586  }
3587}
3588
3589/*2
3590* convert a vector to a set of polys,
3591* allocates the polyset, (entries 0..(*len)-1)
3592* the vector will not be changed
3593*/
3594void  p_Vec2Polys(poly v, poly* *p, int *len, const ring r)
3595{
3596  poly h;
3597  int k;
3598
3599  *len=p_MaxComp(v,r);
3600  if (*len==0) *len=1;
3601  *p=(poly*)omAlloc((*len)*sizeof(poly));
3602  p_Vec2Array(v,*p,*len,r);
3603}
3604
3605//
3606// resets the pFDeg and pLDeg: if pLDeg is not given, it is
3607// set to currRing->pLDegOrig, i.e. to the respective LDegProc which
3608// only uses pFDeg (and not p_Deg, or pTotalDegree, etc)
3609void pSetDegProcs(ring r, pFDegProc new_FDeg, pLDegProc new_lDeg)
3610{
3611  assume(new_FDeg != NULL);
3612  r->pFDeg = new_FDeg;
3613
3614  if (new_lDeg == NULL)
3615    new_lDeg = r->pLDegOrig;
3616
3617  r->pLDeg = new_lDeg;
3618}
3619
3620// restores pFDeg and pLDeg:
3621void pRestoreDegProcs(ring r, pFDegProc old_FDeg, pLDegProc old_lDeg)
3622{
3623  assume(old_FDeg != NULL && old_lDeg != NULL);
3624  r->pFDeg = old_FDeg;
3625  r->pLDeg = old_lDeg;
3626}
3627
3628/*-------- several access procedures to monomials -------------------- */
3629/*
3630* the module weights for std
3631*/
3632STATIC_VAR pFDegProc pOldFDeg;
3633STATIC_VAR pLDegProc pOldLDeg;
3634STATIC_VAR BOOLEAN pOldLexOrder;
3635
3636static long pModDeg(poly p, ring r)
3637{
3638  long d=pOldFDeg(p, r);
3639  int c=__p_GetComp(p, r);
3640  if ((c>0) && ((r->pModW)->range(c-1))) d+= (*(r->pModW))[c-1];
3641  return d;
3642  //return pOldFDeg(p, r)+(*pModW)[p_GetComp(p, r)-1];
3643}
3644
3645void p_SetModDeg(intvec *w, ring r)
3646{
3647  if (w!=NULL)
3648  {
3649    r->pModW = w;
3650    pOldFDeg = r->pFDeg;
3651    pOldLDeg = r->pLDeg;
3652    pOldLexOrder = r->pLexOrder;
3653    pSetDegProcs(r,pModDeg);
3654    r->pLexOrder = TRUE;
3655  }
3656  else
3657  {
3658    r->pModW = NULL;
3659    pRestoreDegProcs(r,pOldFDeg, pOldLDeg);
3660    r->pLexOrder = pOldLexOrder;
3661  }
3662}
3663
3664/*2
3665* handle memory request for sets of polynomials (ideals)
3666* l is the length of *p, increment is the difference (may be negative)
3667*/
3668void pEnlargeSet(poly* *p, int l, int increment)
3669{
3670  poly* h;
3671
3672  if (*p==NULL)
3673  {
3674    if (increment==0) return;
3675    h=(poly*)omAlloc0(increment*sizeof(poly));
3676  }
3677  else
3678  {
3679    h=(poly*)omReallocSize((poly*)*p,l*sizeof(poly),(l+increment)*sizeof(poly));
3680    if (increment>0)
3681    {
3682      memset(&(h[l]),0,increment*sizeof(poly));
3683    }
3684  }
3685  *p=h;
3686}
3687
3688/*2
3689*divides p1 by its leading coefficient
3690*/
3691void p_Norm(poly p1, const ring r)
3692{
3693  if (rField_is_Ring(r))
3694  {
3695    if (!n_IsUnit(pGetCoeff(p1), r->cf)) return;
3696    // Werror("p_Norm not possible in the case of coefficient rings.");
3697  }
3698  else if (p1!=NULL)
3699  {
3700    if (pNext(p1)==NULL)
3701    {
3702      p_SetCoeff(p1,n_Init(1,r->cf),r);
3703      return;
3704    }
3705    poly h;
3706    if (!n_IsOne(pGetCoeff(p1),r->cf))
3707    {
3708      number k, c;
3709      n_Normalize(pGetCoeff(p1),r->cf);
3710      k = pGetCoeff(p1);
3711      c = n_Init(1,r->cf);
3712      pSetCoeff0(p1,c);
3713      h = pNext(p1);
3714      while (h!=NULL)
3715      {
3716        c=n_Div(pGetCoeff(h),k,r->cf);
3717        // no need to normalize: Z/p, R
3718        // normalize already in nDiv: Q_a, Z/p_a
3719        // remains: Q
3720        if (rField_is_Q(r) && (!n_IsOne(c,r->cf))) n_Normalize(c,r->cf);
3721        p_SetCoeff(h,c,r);
3722        pIter(h);
3723      }
3724      n_Delete(&k,r->cf);
3725    }
3726    else
3727    {
3728      //if (r->cf->cfNormalize != nDummy2) //TODO: OPTIMIZE
3729      {
3730        h = pNext(p1);
3731        while (h!=NULL)
3732        {
3733          n_Normalize(pGetCoeff(h),r->cf);
3734          pIter(h);
3735        }
3736      }
3737    }
3738  }
3739}
3740
3741/*2
3742*normalize all coefficients
3743*/
3744void p_Normalize(poly p,const ring r)
3745{
3746  if (rField_has_simple_inverse(r)) return; /* Z/p, GF(p,n), R, long R/C */
3747  while (p!=NULL)
3748  {
3749    // no test befor n_Normalize: n_Normalize should fix problems
3750    n_Normalize(pGetCoeff(p),r->cf);
3751    pIter(p);
3752  }
3753}
3754
3755// splits p into polys with Exp(n) == 0 and Exp(n) != 0
3756// Poly with Exp(n) != 0 is reversed
3757static void p_SplitAndReversePoly(poly p, int n, poly *non_zero, poly *zero, const ring r)
3758{
3759  if (p == NULL)
3760  {
3761    *non_zero = NULL;
3762    *zero = NULL;
3763    return;
3764  }
3765  spolyrec sz;
3766  poly z, n_z, next;
3767  z = &sz;
3768  n_z = NULL;
3769
3770  while(p != NULL)
3771  {
3772    next = pNext(p);
3773    if (p_GetExp(p, n,r) == 0)
3774    {
3775      pNext(z) = p;
3776      pIter(z);
3777    }
3778    else
3779    {
3780      pNext(p) = n_z;
3781      n_z = p;
3782    }
3783    p = next;
3784  }
3785  pNext(z) = NULL;
3786  *zero = pNext(&sz);
3787  *non_zero = n_z;
3788}
3789/*3
3790* substitute the n-th variable by 1 in p
3791* destroy p
3792*/
3793static poly p_Subst1 (poly p,int n, const ring r)
3794{
3795  poly qq=NULL, result = NULL;
3796  poly zero=NULL, non_zero=NULL;
3797
3798  // reverse, so that add is likely to be linear
3799  p_SplitAndReversePoly(p, n, &non_zero, &zero,r);
3800
3801  while (non_zero != NULL)
3802  {
3803    assume(p_GetExp(non_zero, n,r) != 0);
3804    qq = non_zero;
3805    pIter(non_zero);
3806    qq->next = NULL;
3807    p_SetExp(qq,n,0,r);
3808    p_Setm(qq,r);
3809    result = p_Add_q(result,qq,r);
3810  }
3811  p = p_Add_q(result, zero,r);
3812  p_Test(p,r);
3813  return p;
3814}
3815
3816/*3
3817* substitute the n-th variable by number e in p
3818* destroy p
3819*/
3820static poly p_Subst2 (poly p,int n, number e, const ring r)
3821{
3822  assume( ! n_IsZero(e,r->cf) );
3823  poly qq,result = NULL;
3824  number nn, nm;
3825  poly zero, non_zero;
3826
3827  // reverse, so that add is likely to be linear
3828  p_SplitAndReversePoly(p, n, &non_zero, &zero,r);
3829
3830  while (non_zero != NULL)
3831  {
3832    assume(p_GetExp(non_zero, n, r) != 0);
3833    qq = non_zero;
3834    pIter(non_zero);
3835    qq->next = NULL;
3836    n_Power(e, p_GetExp(qq, n, r), &nn,r->cf);
3837    nm = n_Mult(nn, pGetCoeff(qq),r->cf);
3838#ifdef HAVE_RINGS
3839    if (n_IsZero(nm,r->cf))
3840    {
3841      p_LmFree(&qq,r);
3842      n_Delete(&nm,r->cf);
3843    }
3844    else
3845#endif
3846    {
3847      p_SetCoeff(qq, nm,r);
3848      p_SetExp(qq, n, 0,r);
3849      p_Setm(qq,r);
3850      result = p_Add_q(result,qq,r);
3851    }
3852    n_Delete(&nn,r->cf);
3853  }
3854  p = p_Add_q(result, zero,r);
3855  p_Test(p,r);
3856  return p;
3857}
3858
3859
3860/* delete monoms whose n-th exponent is different from zero */
3861static poly p_Subst0(poly p, int n, const ring r)
3862{
3863  spolyrec res;
3864  poly h = &res;
3865  pNext(h) = p;
3866
3867  while (pNext(h)!=NULL)
3868  {
3869    if (p_GetExp(pNext(h),n,r)!=0)
3870    {
3871      p_LmDelete(&pNext(h),r);
3872    }
3873    else
3874    {
3875      pIter(h);
3876    }
3877  }
3878  p_Test(pNext(&res),r);
3879  return pNext(&res);
3880}
3881
3882/*2
3883* substitute the n-th variable by e in p
3884* destroy p
3885*/
3886poly p_Subst(poly p, int n, poly e, const ring r)
3887{
3888#ifdef HAVE_SHIFTBBA
3889  // also don't even use p_Subst0 for Letterplace
3890  if (rIsLPRing(r))
3891  {
3892    poly subst = p_LPSubst(p, n, e, r);
3893    p_Delete(&p, r);
3894    return subst;
3895  }
3896#endif
3897
3898  if (e == NULL) return p_Subst0(p, n,r);
3899
3900  if (p_IsConstant(e,r))
3901  {
3902    if (n_IsOne(pGetCoeff(e),r->cf)) return p_Subst1(p,n,r);
3903    else return p_Subst2(p, n, pGetCoeff(e),r);
3904  }
3905
3906#ifdef HAVE_PLURAL
3907  if (rIsPluralRing(r))
3908  {
3909    return nc_pSubst(p,n,e,r);
3910  }
3911#endif
3912
3913  int exponent,i;
3914  poly h, res, m;
3915  int *me,*ee;
3916  number nu,nu1;
3917
3918  me=(int *)omAlloc((rVar(r)+1)*sizeof(int));
3919  ee=(int *)omAlloc((rVar(r)+1)*sizeof(int));
3920  if (e!=NULL) p_GetExpV(e,ee,r);
3921  res=NULL;
3922  h=p;
3923  while (h!=NULL)
3924  {
3925    if ((e!=NULL) || (p_GetExp(h,n,r)==0))
3926    {
3927      m=p_Head(h,r);
3928      p_GetExpV(m,me,r);
3929      exponent=me[n];
3930      me[n]=0;
3931      for(i=rVar(r);i>0;i--)
3932        me[i]+=exponent*ee[i];
3933      p_SetExpV(m,me,r);
3934      if (e!=NULL)
3935      {
3936        n_Power(pGetCoeff(e),exponent,&nu,r->cf);
3937        nu1=n_Mult(pGetCoeff(m),nu,r->cf);
3938        n_Delete(&nu,r->cf);
3939        p_SetCoeff(m,nu1,r);
3940      }
3941      res=p_Add_q(res,m,r);
3942    }
3943    p_LmDelete(&h,r);
3944  }
3945  omFreeSize((ADDRESS)me,(rVar(r)+1)*sizeof(int));
3946  omFreeSize((ADDRESS)ee,(rVar(r)+1)*sizeof(int));
3947  return res;
3948}
3949
3950/*2
3951 * returns a re-ordered convertion of a number as a polynomial,
3952 * with permutation of parameters
3953 * NOTE: this only works for Frank's alg. & trans. fields
3954 */
3955poly n_PermNumber(const number z, const int *par_perm, const int , const ring src, const ring dst)
3956{
3957#if 0
3958  PrintS("\nSource Ring: \n");
3959  rWrite(src);
3960
3961  if(0)
3962  {
3963    number zz = n_Copy(z, src->cf);
3964    PrintS("z: "); n_Write(zz, src);
3965    n_Delete(&zz, src->cf);
3966  }
3967
3968  PrintS("\nDestination Ring: \n");
3969  rWrite(dst);
3970
3971  /*Print("\nOldPar: %d\n", OldPar);
3972  for( int i = 1; i <= OldPar; i++ )
3973  {
3974    Print("par(%d) -> par/var (%d)\n", i, par_perm[i-1]);
3975  }*/
3976#endif
3977  if( z == NULL )
3978     return NULL;
3979
3980  const coeffs srcCf = src->cf;
3981  assume( srcCf != NULL );
3982
3983  assume( !nCoeff_is_GF(srcCf) );
3984  assume( src->cf->extRing!=NULL );
3985
3986  poly zz = NULL;
3987
3988  const ring srcExtRing = srcCf->extRing;
3989  assume( srcExtRing != NULL );
3990
3991  const coeffs dstCf = dst->cf;
3992  assume( dstCf != NULL );
3993
3994  if( nCoeff_is_algExt(srcCf) ) // nCoeff_is_GF(srcCf)?
3995  {
3996    zz = (poly) z;
3997    if( zz == NULL ) return NULL;
3998  }
3999  else if (nCoeff_is_transExt(srcCf))
4000  {
4001    assume( !IS0(z) );
4002
4003    zz = NUM((fraction)z);
4004    p_Test (zz, srcExtRing);
4005
4006    if( zz == NULL ) return NULL;
4007    if( !DENIS1((fraction)z) )
4008    {
4009      if (!p_IsConstant(DEN((fraction)z),srcExtRing))
4010        WarnS("Not defined: Cannot map a rational fraction and make a polynomial out of it! Ignoring the denominator.");
4011    }
4012  }
4013  else
4014  {
4015    assume (FALSE);
4016    WerrorS("Number permutation is not implemented for this data yet!");
4017    return NULL;
4018  }
4019
4020  assume( zz != NULL );
4021  p_Test (zz, srcExtRing);
4022
4023  nMapFunc nMap = n_SetMap(srcExtRing->cf, dstCf);
4024
4025  assume( nMap != NULL );
4026
4027  poly qq;
4028  if ((par_perm == NULL) && (rPar(dst) != 0 && rVar (srcExtRing) > 0))
4029  {
4030    int* perm;
4031    perm=(int *)omAlloc0((rVar(srcExtRing)+1)*sizeof(int));
4032    for(int i=si_min(rVar(srcExtRing),rPar(dst));i>0;i--)
4033      perm[i]=-i;
4034    qq = p_PermPoly(zz, perm, srcExtRing, dst, nMap, NULL, rVar(srcExtRing)-1);
4035    omFreeSize ((ADDRESS)perm, (rVar(srcExtRing)+1)*sizeof(int));
4036  }
4037  else
4038    qq = p_PermPoly(zz, par_perm-1, srcExtRing, dst, nMap, NULL, rVar (srcExtRing)-1);
4039
4040  if(nCoeff_is_transExt(srcCf)
4041  && (!DENIS1((fraction)z))
4042  && p_IsConstant(DEN((fraction)z),srcExtRing))
4043  {
4044    number n=nMap(pGetCoeff(DEN((fraction)z)),srcExtRing->cf, dstCf);
4045    qq=p_Div_nn(qq,n,dst);
4046    n_Delete(&n,dstCf);
4047    p_Normalize(qq,dst);
4048  }
4049  p_Test (qq, dst);
4050
4051  return qq;
4052}
4053
4054
4055/*2
4056*returns a re-ordered copy of a polynomial, with permutation of the variables
4057*/
4058poly p_PermPoly (poly p, const int * perm, const ring oldRing, const ring dst,
4059       nMapFunc nMap, const int *par_perm, int OldPar, BOOLEAN use_mult)
4060{
4061#if 0
4062    p_Test(p, oldRing);
4063    PrintS("p_PermPoly::p: "); p_Write(p, oldRing, oldRing);
4064#endif
4065  const int OldpVariables = rVar(oldRing);
4066  poly result = NULL;
4067  poly result_last = NULL;
4068  poly aq = NULL; /* the map coefficient */
4069  poly qq; /* the mapped monomial */
4070  assume(dst != NULL);
4071  assume(dst->cf != NULL);
4072  #ifdef HAVE_PLURAL
4073  poly tmp_mm=p_One(dst);
4074  #endif
4075  while (p != NULL)
4076  {
4077    // map the coefficient
4078    if ( ((OldPar == 0) || (par_perm == NULL) || rField_is_GF(oldRing) || (nMap==ndCopyMap))
4079    && (nMap != NULL) )
4080    {
4081      qq = p_Init(dst);
4082      assume( nMap != NULL );
4083      number n = nMap(p_GetCoeff(p, oldRing), oldRing->cf, dst->cf);
4084      n_Test (n,dst->cf);
4085      if ( nCoeff_is_algExt(dst->cf) )
4086        n_Normalize(n, dst->cf);
4087      p_GetCoeff(qq, dst) = n;// Note: n can be a ZERO!!!
4088    }
4089    else
4090    {
4091      qq = p_One(dst);
4092//      aq = naPermNumber(p_GetCoeff(p, oldRing), par_perm, OldPar, oldRing); // no dst???
4093//      poly    n_PermNumber(const number z, const int *par_perm, const int P, const ring src, const ring dst)
4094      aq = n_PermNumber(p_GetCoeff(p, oldRing), par_perm, OldPar, oldRing, dst);
4095      p_Test(aq, dst);
4096      if ( nCoeff_is_algExt(dst->cf) )
4097        p_Normalize(aq,dst);
4098      if (aq == NULL)
4099        p_SetCoeff(qq, n_Init(0, dst->cf),dst); // Very dirty trick!!!
4100      p_Test(aq, dst);
4101    }
4102    if (rRing_has_Comp(dst))
4103       p_SetComp(qq, p_GetComp(p, oldRing), dst);
4104    if ( n_IsZero(pGetCoeff(qq), dst->cf) )
4105    {
4106      p_LmDelete(&qq,dst);
4107      qq = NULL;
4108    }
4109    else
4110    {
4111      // map pars:
4112      int mapped_to_par = 0;
4113      for(int i = 1; i <= OldpVariables; i++)
4114      {
4115        int e = p_GetExp(p, i, oldRing);
4116        if (e != 0)
4117        {
4118          if (perm==NULL)
4119            p_SetExp(qq, i, e, dst);
4120          else if (perm[i]>0)
4121          {
4122            #ifdef HAVE_PLURAL
4123            if(use_mult)
4124            {
4125              p_SetExp(tmp_mm,perm[i],e,dst);
4126              p_Setm(tmp_mm,dst);
4127              qq=p_Mult_mm(qq,tmp_mm,dst);
4128              p_SetExp(tmp_mm,perm[i],0,dst);
4129
4130            }
4131            else
4132            #endif
4133            p_AddExp(qq,perm[i], e/*p_GetExp( p,i,oldRing)*/, dst);
4134          }
4135          else if (perm[i]<0)
4136          {
4137            number c = p_GetCoeff(qq, dst);
4138            if (rField_is_GF(dst))
4139            {
4140              assume( dst->cf->extRing == NULL );
4141              number ee = n_Param(1, dst);
4142              number eee;
4143              n_Power(ee, e, &eee, dst->cf); //nfDelete(ee,dst);
4144              ee = n_Mult(c, eee, dst->cf);
4145              //nfDelete(c,dst);nfDelete(eee,dst);
4146              pSetCoeff0(qq,ee);
4147            }
4148            else if (nCoeff_is_Extension(dst->cf))
4149            {
4150              const int par = -perm[i];
4151              assume( par > 0 );
4152//              WarnS("longalg missing 3");
4153#if 1
4154              const coeffs C = dst->cf;
4155              assume( C != NULL );
4156              const ring R = C->extRing;
4157              assume( R != NULL );
4158              assume( par <= rVar(R) );
4159              poly pcn; // = (number)c
4160              assume( !n_IsZero(c, C) );
4161              if( nCoeff_is_algExt(C) )
4162                 pcn = (poly) c;
4163               else //            nCoeff_is_transExt(C)
4164                 pcn = NUM((fraction)c);
4165              if (pNext(pcn) == NULL) // c->z
4166                p_AddExp(pcn, -perm[i], e, R);
4167              else /* more difficult: we have really to multiply: */
4168              {
4169                poly mmc = p_ISet(1, R);
4170                p_SetExp(mmc, -perm[i], e, R);
4171                p_Setm(mmc, R);
4172                number nnc;
4173                // convert back to a number: number nnc = mmc;
4174                if( nCoeff_is_algExt(C) )
4175                   nnc = (number) mmc;
4176                else //            nCoeff_is_transExt(C)
4177                  nnc = ntInit(mmc, C);
4178                p_GetCoeff(qq, dst) = n_Mult((number)c, nnc, C);
4179                n_Delete((number *)&c, C);
4180                n_Delete((number *)&nnc, C);
4181              }
4182              mapped_to_par=1;
4183#endif
4184            }
4185          }
4186          else
4187          {
4188            /* this variable maps to 0 !*/
4189            p_LmDelete(&qq, dst);
4190            break;
4191          }
4192        }
4193      }
4194      if ( mapped_to_par && (qq!= NULL) && nCoeff_is_algExt(dst->cf) )
4195      {
4196        number n = p_GetCoeff(qq, dst);
4197        n_Normalize(n, dst->cf);
4198        p_GetCoeff(qq, dst) = n;
4199      }
4200    }
4201    pIter(p);
4202
4203#if 0
4204    p_Test(aq,dst);
4205    PrintS("aq: "); p_Write(aq, dst, dst);
4206#endif
4207
4208
4209#if 1
4210    if (qq!=NULL)
4211    {
4212      p_Setm(qq,dst);
4213
4214      p_Test(aq,dst);
4215      p_Test(qq,dst);
4216
4217#if 0
4218    PrintS("qq: "); p_Write(qq, dst, dst);
4219#endif
4220
4221      if (aq!=NULL)
4222         qq=p_Mult_q(aq,qq,dst);
4223      aq = qq;
4224      while (pNext(aq) != NULL) pIter(aq);
4225      if (result_last==NULL)
4226      {
4227        result=qq;
4228      }
4229      else
4230      {
4231        pNext(result_last)=qq;
4232      }
4233      result_last=aq;
4234      aq = NULL;
4235    }
4236    else if (aq!=NULL)
4237    {
4238      p_Delete(&aq,dst);
4239    }
4240  }
4241  result=p_SortAdd(result,dst);
4242#else
4243  //  if (qq!=NULL)
4244  //  {
4245  //    pSetm(qq);
4246  //    pTest(qq);
4247  //    pTest(aq);
4248  //    if (aq!=NULL) qq=pMult(aq,qq);
4249  //    aq = qq;
4250  //    while (pNext(aq) != NULL) pIter(aq);
4251  //    pNext(aq) = result;
4252  //    aq = NULL;
4253  //    result = qq;
4254  //  }
4255  //  else if (aq!=NULL)
4256  //  {
4257  //    pDelete(&aq);
4258  //  }
4259  //}
4260  //p = result;
4261  //result = NULL;
4262  //while (p != NULL)
4263  //{
4264  //  qq = p;
4265  //  pIter(p);
4266  //  qq->next = NULL;
4267  //  result = pAdd(result, qq);
4268  //}
4269#endif
4270  p_Test(result,dst);
4271#if 0
4272  p_Test(result,dst);
4273  PrintS("result: "); p_Write(result,dst,dst);
4274#endif
4275  #ifdef HAVE_PLURAL
4276  p_LmDelete(&tmp_mm,dst);
4277  #endif
4278  return result;
4279}
4280/**************************************************************
4281 *
4282 * Jet
4283 *
4284 **************************************************************/
4285
4286poly pp_Jet(poly p, int m, const ring R)
4287{
4288  poly r=NULL;
4289  poly t=NULL;
4290
4291  while (p!=NULL)
4292  {
4293    if (p_Totaldegree(p,R)<=m)
4294    {
4295      if (r==NULL)
4296        r=p_Head(p,R);
4297      else
4298      if (t==NULL)
4299      {
4300        pNext(r)=p_Head(p,R);
4301        t=pNext(r);
4302      }
4303      else
4304      {
4305        pNext(t)=p_Head(p,R);
4306        pIter(t);
4307      }
4308    }
4309    pIter(p);
4310  }
4311  return r;
4312}
4313
4314poly p_Jet(poly p, int m,const ring R)
4315{
4316  while((p!=NULL) && (p_Totaldegree(p,R)>m)) p_LmDelete(&p,R);
4317  if (p==NULL) return NULL;
4318  poly r=p;
4319  while (pNext(p)!=NULL)
4320  {
4321    if (p_Totaldegree(pNext(p),R)>m)
4322    {
4323      p_LmDelete(&pNext(p),R);
4324    }
4325    else
4326      pIter(p);
4327  }
4328  return r;
4329}
4330
4331poly pp_JetW(poly p, int m, short *w, const ring R)
4332{
4333  poly r=NULL;
4334  poly t=NULL;
4335  while (p!=NULL)
4336  {
4337    if (totaldegreeWecart_IV(p,R,w)<=m)
4338    {
4339      if (r==NULL)
4340        r=p_Head(p,R);
4341      else
4342      if (t==NULL)
4343      {
4344        pNext(r)=p_Head(p,R);
4345        t=pNext(r);
4346      }
4347      else
4348      {
4349        pNext(t)=p_Head(p,R);
4350        pIter(t);
4351      }
4352    }
4353    pIter(p);
4354  }
4355  return r;
4356}
4357
4358poly p_JetW(poly p, int m, short *w, const ring R)
4359{
4360  while((p!=NULL) && (totaldegreeWecart_IV(p,R,w)>m)) p_LmDelete(&p,R);
4361  if (p==NULL) return NULL;
4362  poly r=p;
4363  while (pNext(p)!=NULL)
4364  {
4365    if (totaldegreeWecart_IV(pNext(p),R,w)>m)
4366    {
4367      p_LmDelete(&pNext(p),R);
4368    }
4369    else
4370      pIter(p);
4371  }
4372  return r;
4373}
4374
4375/*************************************************************/
4376int p_MinDeg(poly p,intvec *w, const ring R)
4377{
4378  if(p==NULL)
4379    return -1;
4380  int d=-1;
4381  while(p!=NULL)
4382  {
4383    int d0=0;
4384    for(int j=0;j<rVar(R);j++)
4385      if(w==NULL||j>=w->length())
4386        d0+=p_GetExp(p,j+1,R);
4387      else
4388        d0+=(*w)[j]*p_GetExp(p,j+1,R);
4389    if(d0<d||d==-1)
4390      d=d0;
4391    pIter(p);
4392  }
4393  return d;
4394}
4395
4396/***************************************************************/
4397static poly p_Invers(int n,poly u,intvec *w, const ring R)
4398{
4399  if(n<0)
4400    return NULL;
4401  number u0=n_Invers(pGetCoeff(u),R->cf);
4402  poly v=p_NSet(u0,R);
4403  if(n==0)
4404    return v;
4405  short *ww=iv2array(w,R);
4406  poly u1=p_JetW(p_Sub(p_One(R),__p_Mult_nn(u,u0,R),R),n,ww,R);
4407  if(u1==NULL)
4408  {
4409    omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
4410    return v;
4411  }
4412  poly v1=__p_Mult_nn(p_Copy(u1,R),u0,R);
4413  v=p_Add_q(v,p_Copy(v1,R),R);
4414  for(int i=n/p_MinDeg(u1,w,R);i>1;i--)
4415  {
4416    v1=p_JetW(p_Mult_q(v1,p_Copy(u1,R),R),n,ww,R);
4417    v=p_Add_q(v,p_Copy(v1,R),R);
4418  }
4419  p_Delete(&u1,R);
4420  p_Delete(&v1,R);
4421  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
4422  return v;
4423}
4424
4425
4426poly p_Series(int n,poly p,poly u, intvec *w, const ring R)
4427{
4428  short *ww=iv2array(w,R);
4429  if(p!=NULL)
4430  {
4431    if(u==NULL)
4432      p=p_JetW(p,n,ww,R);
4433    else
4434      p=p_JetW(p_Mult_q(p,p_Invers(n-p_MinDeg(p,w,R),u,w,R),R),n,ww,R);
4435  }
4436  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
4437  return p;
4438}
4439
4440BOOLEAN p_EqualPolys(poly p1,poly p2, const ring r)
4441{
4442  while ((p1 != NULL) && (p2 != NULL))
4443  {
4444    if (! p_LmEqual(p1, p2,r))
4445      return FALSE;
4446    if (! n_Equal(p_GetCoeff(p1,r), p_GetCoeff(p2,r),r->cf ))
4447      return FALSE;
4448    pIter(p1);
4449    pIter(p2);
4450  }
4451  return (p1==p2);
4452}
4453
4454static inline BOOLEAN p_ExpVectorEqual(poly p1, poly p2, const ring r1, const ring r2)
4455{
4456  assume( r1 == r2 || rSamePolyRep(r1, r2) );
4457
4458  p_LmCheckPolyRing1(p1, r1);
4459  p_LmCheckPolyRing1(p2, r2);
4460
4461  int i = r1->ExpL_Size;
4462
4463  assume( r1->ExpL_Size == r2->ExpL_Size );
4464
4465  unsigned long *ep = p1->exp;
4466  unsigned long *eq = p2->exp;
4467
4468  do
4469  {
4470    i--;
4471    if (ep[i] != eq[i]) return FALSE;
4472  }
4473  while (i);
4474
4475  return TRUE;
4476}
4477
4478BOOLEAN p_EqualPolys(poly p1,poly p2, const ring r1, const ring r2)
4479{
4480  assume( r1 == r2 || rSamePolyRep(r1, r2) ); // will be used in rEqual!
4481  assume( r1->cf == r2->cf );
4482
4483  while ((p1 != NULL) && (p2 != NULL))
4484  {
4485    // returns 1 if ExpVector(p)==ExpVector(q): does not compare numbers !!
4486    // #define p_LmEqual(p1, p2, r) p_ExpVectorEqual(p1, p2, r)
4487
4488    if (! p_ExpVectorEqual(p1, p2, r1, r2))
4489      return FALSE;
4490
4491    if (! n_Equal(p_GetCoeff(p1,r1), p_GetCoeff(p2,r2), r1->cf ))
4492      return FALSE;
4493
4494    pIter(p1);
4495    pIter(p2);
4496  }
4497  return (p1==p2);
4498}
4499
4500/*2
4501*returns TRUE if p1 is a skalar multiple of p2
4502*assume p1 != NULL and p2 != NULL
4503*/
4504BOOLEAN p_ComparePolys(poly p1,poly p2, const ring r)
4505{
4506  number n,nn;
4507  pAssume(p1 != NULL && p2 != NULL);
4508
4509  if (!p_LmEqual(p1,p2,r)) //compare leading mons
4510      return FALSE;
4511  if ((pNext(p1)==NULL) && (pNext(p2)!=NULL))
4512     return FALSE;
4513  if ((pNext(p2)==NULL) && (pNext(p1)!=NULL))
4514     return FALSE;
4515  if (pLength(p1) != pLength(p2))
4516    return FALSE;
4517  #ifdef HAVE_RINGS
4518  if (rField_is_Ring(r))
4519  {
4520    if (!n_DivBy(pGetCoeff(p1), pGetCoeff(p2), r->cf)) return FALSE;
4521  }
4522  #endif
4523  n=n_Div(pGetCoeff(p1),pGetCoeff(p2),r->cf);
4524  while ((p1 != NULL) /*&& (p2 != NULL)*/)
4525  {
4526    if ( ! p_LmEqual(p1, p2,r))
4527    {
4528        n_Delete(&n, r->cf);
4529        return FALSE;
4530    }
4531    if (!n_Equal(pGetCoeff(p1), nn = n_Mult(pGetCoeff(p2),n, r->cf), r->cf))
4532    {
4533      n_Delete(&n, r->cf);
4534      n_Delete(&nn, r->cf);
4535      return FALSE;
4536    }
4537    n_Delete(&nn, r->cf);
4538    pIter(p1);
4539    pIter(p2);
4540  }
4541  n_Delete(&n, r->cf);
4542  return TRUE;
4543}
4544
4545/*2
4546* returns the length of a (numbers of monomials)
4547* respect syzComp
4548*/
4549poly p_Last(const poly p, int &l, const ring r)
4550{
4551  if (p == NULL)
4552  {
4553    l = 0;
4554    return NULL;
4555  }
4556  l = 1;
4557  poly a = p;
4558  if (! rIsSyzIndexRing(r))
4559  {
4560    poly next = pNext(a);
4561    while (next!=NULL)
4562    {
4563      a = next;
4564      next = pNext(a);
4565      l++;
4566    }
4567  }
4568  else
4569  {
4570    int curr_limit = rGetCurrSyzLimit(r);
4571    poly pp = a;
4572    while ((a=pNext(a))!=NULL)
4573    {
4574      if (__p_GetComp(a,r)<=curr_limit/*syzComp*/)
4575        l++;
4576      else break;
4577      pp = a;
4578    }
4579    a=pp;
4580  }
4581  return a;
4582}
4583
4584int p_Var(poly m,const ring r)
4585{
4586  if (m==NULL) return 0;
4587  if (pNext(m)!=NULL) return 0;
4588  int i,e=0;
4589  for (i=rVar(r); i>0; i--)
4590  {
4591    int exp=p_GetExp(m,i,r);
4592    if (exp==1)
4593    {
4594      if (e==0) e=i;
4595      else return 0;
4596    }
4597    else if (exp!=0)
4598    {
4599      return 0;
4600    }
4601  }
4602  return e;
4603}
4604
4605/*2
4606*the minimal index of used variables - 1
4607*/
4608int p_LowVar (poly p, const ring r)
4609{
4610  int k,l,lex;
4611
4612  if (p == NULL) return -1;
4613
4614  k = 32000;/*a very large dummy value*/
4615  while (p != NULL)
4616  {
4617    l = 1;
4618    lex = p_GetExp(p,l,r);
4619    while ((l < (rVar(r))) && (lex == 0))
4620    {
4621      l++;
4622      lex = p_GetExp(p,l,r);
4623    }
4624    l--;
4625    if (l < k) k = l;
4626    pIter(p);
4627  }
4628  return k;
4629}
4630
4631/*2
4632* verschiebt die Indizees der Modulerzeugenden um i
4633*/
4634void p_Shift (poly * p,int i, const ring r)
4635{
4636  poly qp1 = *p,qp2 = *p;/*working pointers*/
4637  int     j = p_MaxComp(*p,r),k = p_MinComp(*p,r);
4638
4639  if (j+i < 0) return ;
4640  BOOLEAN toPoly= ((j == -i) && (j == k));
4641  while (qp1 != NULL)
4642  {
4643    if (toPoly || (__p_GetComp(qp1,r)+i > 0))
4644    {
4645      p_AddComp(qp1,i,r);
4646      p_SetmComp(qp1,r);
4647      qp2 = qp1;
4648      pIter(qp1);
4649    }
4650    else
4651    {
4652      if (qp2 == *p)
4653      {
4654        pIter(*p);
4655        p_LmDelete(&qp2,r);
4656        qp2 = *p;
4657        qp1 = *p;
4658      }
4659      else
4660      {
4661        qp2->next = qp1->next;
4662        if (qp1!=NULL) p_LmDelete(&qp1,r);
4663        qp1 = qp2->next;
4664      }
4665    }
4666  }
4667}
4668
4669/***************************************************************
4670 *
4671 * Storage Managament Routines
4672 *
4673 ***************************************************************/
4674
4675
4676static inline unsigned long GetBitFields(const long e,
4677                                         const unsigned int s, const unsigned int n)
4678{
4679#define Sy_bit_L(x)     (((unsigned long)1L)<<(x))
4680  unsigned int i = 0;
4681  unsigned long  ev = 0L;
4682  assume(n > 0 && s < BIT_SIZEOF_LONG);
4683  do
4684  {
4685    assume(s+i < BIT_SIZEOF_LONG);
4686    if (e > (long) i) ev |= Sy_bit_L(s+i);
4687    else break;
4688    i++;
4689  }
4690  while (i < n);
4691  return ev;
4692}
4693
4694// Short Exponent Vectors are used for fast divisibility tests
4695// ShortExpVectors "squeeze" an exponent vector into one word as follows:
4696// Let n = BIT_SIZEOF_LONG / pVariables.
4697// If n == 0 (i.e. pVariables > BIT_SIZE_OF_LONG), let m == the number
4698// of non-zero exponents. If (m>BIT_SIZEOF_LONG), then sev = ~0, else
4699// first m bits of sev are set to 1.
4700// Otherwise (i.e. pVariables <= BIT_SIZE_OF_LONG)
4701// represented by a bit-field of length n (resp. n+1 for some
4702// exponents). If the value of an exponent is greater or equal to n, then
4703// all of its respective n bits are set to 1. If the value of an exponent
4704// is smaller than n, say m, then only the first m bits of the respective
4705// n bits are set to 1, the others are set to 0.
4706// This way, we have:
4707// exp1 / exp2 ==> (ev1 & ~ev2) == 0, i.e.,
4708// if (ev1 & ~ev2) then exp1 does not divide exp2
4709unsigned long p_GetShortExpVector(const poly p, const ring r)
4710{
4711  assume(p != NULL);
4712  unsigned long ev = 0; // short exponent vector
4713  unsigned int n = BIT_SIZEOF_LONG / r->N; // number of bits per exp
4714  unsigned int m1; // highest bit which is filled with (n+1)
4715  int i=0,j=1;
4716
4717  if (n == 0)
4718  {
4719    if (r->N <2*BIT_SIZEOF_LONG)
4720    {
4721      n=1;
4722      m1=0;
4723    }
4724    else
4725    {
4726      for (; j<=r->N; j++)
4727      {
4728        if (p_GetExp(p,j,r) > 0) i++;
4729        if (i == BIT_SIZEOF_LONG) break;
4730      }
4731      if (i>0)
4732        ev = ~(0UL) >> (BIT_SIZEOF_LONG - i);
4733      return ev;
4734    }
4735  }
4736  else
4737  {
4738    m1 = (n+1)*(BIT_SIZEOF_LONG - n*r->N);
4739  }
4740
4741  n++;
4742  while (i<m1)
4743  {
4744    ev |= GetBitFields(p_GetExp(p, j,r), i, n);
4745    i += n;
4746    j++;
4747  }
4748
4749  n--;
4750  while (i<BIT_SIZEOF_LONG)
4751  {
4752    ev |= GetBitFields(p_GetExp(p, j,r), i, n);
4753    i += n;
4754    j++;
4755  }
4756  return ev;
4757}
4758
4759
4760///  p_GetShortExpVector of p * pp
4761unsigned long p_GetShortExpVector(const poly p, const poly pp, const ring r)
4762{
4763  assume(p != NULL);
4764  assume(pp != NULL);
4765
4766  unsigned long ev = 0; // short exponent vector
4767  unsigned int n = BIT_SIZEOF_LONG / r->N; // number of bits per exp
4768  unsigned int m1; // highest bit which is filled with (n+1)
4769  int j=1;
4770  unsigned long i = 0L;
4771
4772  if (n == 0)
4773  {
4774    if (r->N <2*BIT_SIZEOF_LONG)
4775    {
4776      n=1;
4777      m1=0;
4778    }
4779    else
4780    {
4781      for (; j<=r->N; j++)
4782      {
4783        if (p_GetExp(p,j,r) > 0 || p_GetExp(pp,j,r) > 0) i++;
4784        if (i == BIT_SIZEOF_LONG) break;
4785      }
4786      if (i>0)
4787        ev = ~(0UL) >> (BIT_SIZEOF_LONG - i);
4788      return ev;
4789    }
4790  }
4791  else
4792  {
4793    m1 = (n+1)*(BIT_SIZEOF_LONG - n*r->N);
4794  }
4795
4796  n++;
4797  while (i<m1)
4798  {
4799    ev |= GetBitFields(p_GetExp(p, j,r) + p_GetExp(pp, j,r), i, n);
4800    i += n;
4801    j++;
4802  }
4803
4804  n--;
4805  while (i<BIT_SIZEOF_LONG)
4806  {
4807    ev |= GetBitFields(p_GetExp(p, j,r) + p_GetExp(pp, j,r), i, n);
4808    i += n;
4809    j++;
4810  }
4811  return ev;
4812}
4813
4814
4815
4816/***************************************************************
4817 *
4818 * p_ShallowDelete
4819 *
4820 ***************************************************************/
4821#undef LINKAGE
4822#define LINKAGE
4823#undef p_Delete__T
4824#define p_Delete__T p_ShallowDelete
4825#undef n_Delete__T
4826#define n_Delete__T(n, r) do {} while (0)
4827
4828#include "polys/templates/p_Delete__T.cc"
4829
4830/***************************************************************/
4831/*
4832* compare a and b
4833*/
4834int p_Compare(const poly a, const poly b, const ring R)
4835{
4836  int r=p_Cmp(a,b,R);
4837  if ((r==0)&&(a!=NULL))
4838  {
4839    number h=n_Sub(pGetCoeff(a),pGetCoeff(b),R->cf);
4840    /* compare lead coeffs */
4841    r = -1+n_IsZero(h,R->cf)+2*n_GreaterZero(h,R->cf); /* -1: <, 0:==, 1: > */
4842    n_Delete(&h,R->cf);
4843  }
4844  else if (a==NULL)
4845  {
4846    if (b==NULL)
4847    {
4848      /* compare 0, 0 */
4849      r=0;
4850    }
4851    else if(p_IsConstant(b,R))
4852    {
4853      /* compare 0, const */
4854      r = 1-2*n_GreaterZero(pGetCoeff(b),R->cf); /* -1: <, 1: > */
4855    }
4856  }
4857  else if (b==NULL)
4858  {
4859    if (p_IsConstant(a,R))
4860    {
4861      /* compare const, 0 */
4862      r = -1+2*n_GreaterZero(pGetCoeff(a),R->cf); /* -1: <, 1: > */
4863    }
4864  }
4865  return(r);
4866}
4867
4868poly p_GcdMon(poly f, poly g, const ring r)
4869{
4870  assume(f!=NULL);
4871  assume(g!=NULL);
4872  assume(pNext(f)==NULL);
4873  poly G=p_Head(f,r);
4874  poly h=g;
4875  int *mf=(int*)omAlloc((r->N+1)*sizeof(int));
4876  p_GetExpV(f,mf,r);
4877  int *mh=(int*)omAlloc((r->N+1)*sizeof(int));
4878  BOOLEAN const_mon;
4879  BOOLEAN one_coeff=n_IsOne(pGetCoeff(G),r->cf);
4880  loop
4881  {
4882    if (h==NULL) break;
4883    if(!one_coeff)
4884    {
4885      number n=n_SubringGcd(pGetCoeff(G),pGetCoeff(h),r->cf);
4886      one_coeff=n_IsOne(n,r->cf);
4887      p_SetCoeff(G,n,r);
4888    }
4889    p_GetExpV(h,mh,r);
4890    const_mon=TRUE;
4891    for(unsigned j=r->N;j!=0;j--)
4892    {
4893      if (mh[j]<mf[j]) mf[j]=mh[j];
4894      if (mf[j]>0) const_mon=FALSE;
4895    }
4896    if (one_coeff && const_mon) break;
4897    pIter(h);
4898  }
4899  mf[0]=0;
4900  p_SetExpV(G,mf,r); // included is p_SetComp, p_Setm
4901  omFreeSize(mf,(r->N+1)*sizeof(int));
4902  omFreeSize(mh,(r->N+1)*sizeof(int));
4903  return G;
4904}
4905
4906poly p_CopyPowerProduct(poly p, const ring r)
4907{
4908  if (p == NULL) return NULL;
4909  p_LmCheckPolyRing1(p, r);
4910  poly np;
4911  omTypeAllocBin(poly, np, r->PolyBin);
4912  p_SetRingOfLm(np, r);
4913  memcpy(np->exp, p->exp, r->ExpL_Size*sizeof(long));
4914  pNext(np) = NULL;
4915  pSetCoeff0(np, n_Init(1, r->cf));
4916  return np;
4917}
4918
4919int p_MaxExpPerVar(poly p, int i, const ring r)
4920{
4921  int m=0;
4922  while(p!=NULL)
4923  {
4924    int mm=p_GetExp(p,i,r);
4925    if (mm>m) m=mm;
4926    pIter(p);
4927  }
4928  return m;
4929}
4930
Note: See TracBrowser for help on using the repository browser.