source: git/libpolys/polys/monomials/p_polys.cc @ 02d009

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