source: git/libpolys/polys/monomials/p_polys.cc @ 7626a49

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