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

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