source: git/libpolys/polys/monomials/p_polys.cc @ 4218c1

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