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

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