source: git/libpolys/polys/monomials/p_polys.cc @ 7fcc5b1

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