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

spielwiese
Last change on this file since c4e9ea was c4e9ea, checked in by Martin Lee <martinlee84@…>, 11 years ago
chg: put make monic into p_ProjectiveUnique
  • Property mode set to 100644
File size: 92.6 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/***************************************************************
5 *  File:    p_polys.cc
6 *  Purpose: implementation of ring independent poly procedures?
7 *  Author:  obachman (Olaf Bachmann)
8 *  Created: 8/00
9 *******************************************************************/
10
11
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) && !nCoeff_is_transExt(C))
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 
2874 
2875    /* normalize ph over a transcendental extension s.t.
2876       lead (ph) is > 0 if extRing->cf == Q
2877       or lead (ph) is monic if extRing->cf == Zp*/
2878    if (nCoeff_is_transExt(C))
2879    {
2880      p= ph;
2881      h= p_GetCoeff (p, C);
2882      fraction f = (fraction) h;
2883      poly g = NUM(f);
2884      number n=p_GetCoeff (g,C->extRing->cf);
2885      if (rField_is_Q (C->extRing))
2886      {
2887        if (!n_GreaterZero(n,C->extRing->cf))
2888        {
2889          p=p_Neg (p,r);
2890        }
2891      }
2892      else if (rField_is_Zp(C->extRing))
2893      {
2894        if (!n_IsOne (n, C->extRing->cf))
2895        {
2896          n=n_Invers (n,C->extRing->cf);
2897          nMapFunc nMap;
2898          nMap= n_SetMap (C->extRing->cf, C);
2899          number ninv= nMap (n,C->extRing->cf, C);
2900          p=p_Mult_nn (p, ninv, r);
2901          n_Delete (&ninv, C);
2902          n_Delete (&n, C->extRing->cf);
2903        }
2904      }
2905      p= ph;
2906    }
2907   
2908  return;
2909}
2910
2911#if 0   /*unused*/
2912number p_GetAllDenom(poly ph, const ring r)
2913{
2914  number d=n_Init(1,r->cf);
2915  poly p = ph;
2916
2917  while (p!=NULL)
2918  {
2919    number h=n_GetDenom(pGetCoeff(p),r->cf);
2920    if (!n_IsOne(h,r->cf))
2921    {
2922      number dd=n_Mult(d,h,r->cf);
2923      n_Delete(&d,r->cf);
2924      d=dd;
2925    }
2926    n_Delete(&h,r->cf);
2927    pIter(p);
2928  }
2929  return d;
2930}
2931#endif
2932
2933int p_Size(poly p, const ring r)
2934{
2935  int count = 0;
2936  while ( p != NULL )
2937  {
2938    count+= n_Size( pGetCoeff( p ), r->cf );
2939    pIter( p );
2940  }
2941  return count;
2942}
2943
2944/*2
2945*make p homogeneous by multiplying the monomials by powers of x_varnum
2946*assume: deg(var(varnum))==1
2947*/
2948poly p_Homogen (poly p, int varnum, const ring r)
2949{
2950  pFDegProc deg;
2951  if (r->pLexOrder && (r->order[0]==ringorder_lp))
2952    deg=p_Totaldegree;
2953  else
2954    deg=r->pFDeg;
2955
2956  poly q=NULL, qn;
2957  int  o,ii;
2958  sBucket_pt bp;
2959
2960  if (p!=NULL)
2961  {
2962    if ((varnum < 1) || (varnum > rVar(r)))
2963    {
2964      return NULL;
2965    }
2966    o=deg(p,r);
2967    q=pNext(p);
2968    while (q != NULL)
2969    {
2970      ii=deg(q,r);
2971      if (ii>o) o=ii;
2972      pIter(q);
2973    }
2974    q = p_Copy(p,r);
2975    bp = sBucketCreate(r);
2976    while (q != NULL)
2977    {
2978      ii = o-deg(q,r);
2979      if (ii!=0)
2980      {
2981        p_AddExp(q,varnum, (long)ii,r);
2982        p_Setm(q,r);
2983      }
2984      qn = pNext(q);
2985      pNext(q) = NULL;
2986      sBucket_Add_p(bp, q, 1);
2987      q = qn;
2988    }
2989    sBucketDestroyAdd(bp, &q, &ii);
2990  }
2991  return q;
2992}
2993
2994/*2
2995*tests if p is homogeneous with respect to the actual weigths
2996*/
2997BOOLEAN p_IsHomogeneous (poly p, const ring r)
2998{
2999  poly qp=p;
3000  int o;
3001
3002  if ((p == NULL) || (pNext(p) == NULL)) return TRUE;
3003  pFDegProc d;
3004  if (r->pLexOrder && (r->order[0]==ringorder_lp))
3005    d=p_Totaldegree;
3006  else
3007    d=r->pFDeg;
3008  o = d(p,r);
3009  do
3010  {
3011    if (d(qp,r) != o) return FALSE;
3012    pIter(qp);
3013  }
3014  while (qp != NULL);
3015  return TRUE;
3016}
3017
3018/*----------utilities for syzygies--------------*/
3019BOOLEAN   p_VectorHasUnitB(poly p, int * k, const ring r)
3020{
3021  poly q=p,qq;
3022  int i;
3023
3024  while (q!=NULL)
3025  {
3026    if (p_LmIsConstantComp(q,r))
3027    {
3028      i = p_GetComp(q,r);
3029      qq = p;
3030      while ((qq != q) && (p_GetComp(qq,r) != i)) pIter(qq);
3031      if (qq == q)
3032      {
3033        *k = i;
3034        return TRUE;
3035      }
3036      else
3037        pIter(q);
3038    }
3039    else pIter(q);
3040  }
3041  return FALSE;
3042}
3043
3044void   p_VectorHasUnit(poly p, int * k, int * len, const ring r)
3045{
3046  poly q=p,qq;
3047  int i,j=0;
3048
3049  *len = 0;
3050  while (q!=NULL)
3051  {
3052    if (p_LmIsConstantComp(q,r))
3053    {
3054      i = p_GetComp(q,r);
3055      qq = p;
3056      while ((qq != q) && (p_GetComp(qq,r) != i)) pIter(qq);
3057      if (qq == q)
3058      {
3059       j = 0;
3060       while (qq!=NULL)
3061       {
3062         if (p_GetComp(qq,r)==i) j++;
3063        pIter(qq);
3064       }
3065       if ((*len == 0) || (j<*len))
3066       {
3067         *len = j;
3068         *k = i;
3069       }
3070      }
3071    }
3072    pIter(q);
3073  }
3074}
3075
3076poly p_TakeOutComp1(poly * p, int k, const ring r)
3077{
3078  poly q = *p;
3079
3080  if (q==NULL) return NULL;
3081
3082  poly qq=NULL,result = NULL;
3083
3084  if (p_GetComp(q,r)==k)
3085  {
3086    result = q; /* *p */
3087    while ((q!=NULL) && (p_GetComp(q,r)==k))
3088    {
3089      p_SetComp(q,0,r);
3090      p_SetmComp(q,r);
3091      qq = q;
3092      pIter(q);
3093    }
3094    *p = q;
3095    pNext(qq) = NULL;
3096  }
3097  if (q==NULL) return result;
3098//  if (pGetComp(q) > k) pGetComp(q)--;
3099  while (pNext(q)!=NULL)
3100  {
3101    if (p_GetComp(pNext(q),r)==k)
3102    {
3103      if (result==NULL)
3104      {
3105        result = pNext(q);
3106        qq = result;
3107      }
3108      else
3109      {
3110        pNext(qq) = pNext(q);
3111        pIter(qq);
3112      }
3113      pNext(q) = pNext(pNext(q));
3114      pNext(qq) =NULL;
3115      p_SetComp(qq,0,r);
3116      p_SetmComp(qq,r);
3117    }
3118    else
3119    {
3120      pIter(q);
3121//      if (pGetComp(q) > k) pGetComp(q)--;
3122    }
3123  }
3124  return result;
3125}
3126
3127poly p_TakeOutComp(poly * p, int k, const ring r)
3128{
3129  poly q = *p,qq=NULL,result = NULL;
3130
3131  if (q==NULL) return NULL;
3132  BOOLEAN use_setmcomp=rOrd_SetCompRequiresSetm(r);
3133  if (p_GetComp(q,r)==k)
3134  {
3135    result = q;
3136    do
3137    {
3138      p_SetComp(q,0,r);
3139      if (use_setmcomp) p_SetmComp(q,r);
3140      qq = q;
3141      pIter(q);
3142    }
3143    while ((q!=NULL) && (p_GetComp(q,r)==k));
3144    *p = q;
3145    pNext(qq) = NULL;
3146  }
3147  if (q==NULL) return result;
3148  if (p_GetComp(q,r) > k)
3149  {
3150    p_SubComp(q,1,r);
3151    if (use_setmcomp) p_SetmComp(q,r);
3152  }
3153  poly pNext_q;
3154  while ((pNext_q=pNext(q))!=NULL)
3155  {
3156    if (p_GetComp(pNext_q,r)==k)
3157    {
3158      if (result==NULL)
3159      {
3160        result = pNext_q;
3161        qq = result;
3162      }
3163      else
3164      {
3165        pNext(qq) = pNext_q;
3166        pIter(qq);
3167      }
3168      pNext(q) = pNext(pNext_q);
3169      pNext(qq) =NULL;
3170      p_SetComp(qq,0,r);
3171      if (use_setmcomp) p_SetmComp(qq,r);
3172    }
3173    else
3174    {
3175      /*pIter(q);*/ q=pNext_q;
3176      if (p_GetComp(q,r) > k)
3177      {
3178        p_SubComp(q,1,r);
3179        if (use_setmcomp) p_SetmComp(q,r);
3180      }
3181    }
3182  }
3183  return result;
3184}
3185
3186// Splits *p into two polys: *q which consists of all monoms with
3187// component == comp and *p of all other monoms *lq == pLength(*q)
3188void p_TakeOutComp(poly *r_p, long comp, poly *r_q, int *lq, const ring r)
3189{
3190  spolyrec pp, qq;
3191  poly p, q, p_prev;
3192  int l = 0;
3193
3194#ifdef HAVE_ASSUME
3195  int lp = pLength(*r_p);
3196#endif
3197
3198  pNext(&pp) = *r_p;
3199  p = *r_p;
3200  p_prev = &pp;
3201  q = &qq;
3202
3203  while(p != NULL)
3204  {
3205    while (p_GetComp(p,r) == comp)
3206    {
3207      pNext(q) = p;
3208      pIter(q);
3209      p_SetComp(p, 0,r);
3210      p_SetmComp(p,r);
3211      pIter(p);
3212      l++;
3213      if (p == NULL)
3214      {
3215        pNext(p_prev) = NULL;
3216        goto Finish;
3217      }
3218    }
3219    pNext(p_prev) = p;
3220    p_prev = p;
3221    pIter(p);
3222  }
3223
3224  Finish:
3225  pNext(q) = NULL;
3226  *r_p = pNext(&pp);
3227  *r_q = pNext(&qq);
3228  *lq = l;
3229#ifdef HAVE_ASSUME
3230  assume(pLength(*r_p) + pLength(*r_q) == lp);
3231#endif
3232  p_Test(*r_p,r);
3233  p_Test(*r_q,r);
3234}
3235
3236void p_DeleteComp(poly * p,int k, const ring r)
3237{
3238  poly q;
3239
3240  while ((*p!=NULL) && (p_GetComp(*p,r)==k)) p_LmDelete(p,r);
3241  if (*p==NULL) return;
3242  q = *p;
3243  if (p_GetComp(q,r)>k)
3244  {
3245    p_SubComp(q,1,r);
3246    p_SetmComp(q,r);
3247  }
3248  while (pNext(q)!=NULL)
3249  {
3250    if (p_GetComp(pNext(q),r)==k)
3251      p_LmDelete(&(pNext(q)),r);
3252    else
3253    {
3254      pIter(q);
3255      if (p_GetComp(q,r)>k)
3256      {
3257        p_SubComp(q,1,r);
3258        p_SetmComp(q,r);
3259      }
3260    }
3261  }
3262}
3263
3264/*2
3265* convert a vector to a set of polys,
3266* allocates the polyset, (entries 0..(*len)-1)
3267* the vector will not be changed
3268*/
3269void  p_Vec2Polys(poly v, poly* *p, int *len, const ring r)
3270{
3271  poly h;
3272  int k;
3273
3274  *len=p_MaxComp(v,r);
3275  if (*len==0) *len=1;
3276  *p=(poly*)omAlloc0((*len)*sizeof(poly));
3277  while (v!=NULL)
3278  {
3279    h=p_Head(v,r);
3280    k=p_GetComp(h,r);
3281    p_SetComp(h,0,r);
3282    (*p)[k-1]=p_Add_q((*p)[k-1],h,r);
3283    pIter(v);
3284  }
3285}
3286
3287//
3288// resets the pFDeg and pLDeg: if pLDeg is not given, it is
3289// set to currRing->pLDegOrig, i.e. to the respective LDegProc which
3290// only uses pFDeg (and not p_Deg, or pTotalDegree, etc)
3291void pSetDegProcs(ring r, pFDegProc new_FDeg, pLDegProc new_lDeg)
3292{
3293  assume(new_FDeg != NULL);
3294  r->pFDeg = new_FDeg;
3295
3296  if (new_lDeg == NULL)
3297    new_lDeg = r->pLDegOrig;
3298
3299  r->pLDeg = new_lDeg;
3300}
3301
3302// restores pFDeg and pLDeg:
3303void pRestoreDegProcs(ring r, pFDegProc old_FDeg, pLDegProc old_lDeg)
3304{
3305  assume(old_FDeg != NULL && old_lDeg != NULL);
3306  r->pFDeg = old_FDeg;
3307  r->pLDeg = old_lDeg;
3308}
3309
3310/*-------- several access procedures to monomials -------------------- */
3311/*
3312* the module weights for std
3313*/
3314static pFDegProc pOldFDeg;
3315static pLDegProc pOldLDeg;
3316static BOOLEAN pOldLexOrder;
3317
3318static long pModDeg(poly p, ring r)
3319{
3320  long d=pOldFDeg(p, r);
3321  int c=p_GetComp(p, r);
3322  if ((c>0) && ((r->pModW)->range(c-1))) d+= (*(r->pModW))[c-1];
3323  return d;
3324  //return pOldFDeg(p, r)+(*pModW)[p_GetComp(p, r)-1];
3325}
3326
3327void p_SetModDeg(intvec *w, ring r)
3328{
3329  if (w!=NULL)
3330  {
3331    r->pModW = w;
3332    pOldFDeg = r->pFDeg;
3333    pOldLDeg = r->pLDeg;
3334    pOldLexOrder = r->pLexOrder;
3335    pSetDegProcs(r,pModDeg);
3336    r->pLexOrder = TRUE;
3337  }
3338  else
3339  {
3340    r->pModW = NULL;
3341    pRestoreDegProcs(r,pOldFDeg, pOldLDeg);
3342    r->pLexOrder = pOldLexOrder;
3343  }
3344}
3345
3346/*2
3347* handle memory request for sets of polynomials (ideals)
3348* l is the length of *p, increment is the difference (may be negative)
3349*/
3350void pEnlargeSet(poly* *p, int l, int increment)
3351{
3352  poly* h;
3353
3354  h=(poly*)omReallocSize((poly*)*p,l*sizeof(poly),(l+increment)*sizeof(poly));
3355  if (increment>0)
3356  {
3357    //for (i=l; i<l+increment; i++)
3358    //  h[i]=NULL;
3359    memset(&(h[l]),0,increment*sizeof(poly));
3360  }
3361  *p=h;
3362}
3363
3364/*2
3365*divides p1 by its leading coefficient
3366*/
3367void p_Norm(poly p1, const ring r)
3368{
3369#ifdef HAVE_RINGS
3370  if (rField_is_Ring(r))
3371  {
3372    if (!n_IsUnit(pGetCoeff(p1), r->cf)) return;
3373    // Werror("p_Norm not possible in the case of coefficient rings.");
3374  }
3375  else
3376#endif
3377  if (p1!=NULL)
3378  {
3379    if (pNext(p1)==NULL)
3380    {
3381      p_SetCoeff(p1,n_Init(1,r->cf),r);
3382      return;
3383    }
3384    poly h;
3385    if (!n_IsOne(pGetCoeff(p1),r->cf))
3386    {
3387      number k, c;
3388      n_Normalize(pGetCoeff(p1),r->cf);
3389      k = pGetCoeff(p1);
3390      c = n_Init(1,r->cf);
3391      pSetCoeff0(p1,c);
3392      h = pNext(p1);
3393      while (h!=NULL)
3394      {
3395        c=n_Div(pGetCoeff(h),k,r->cf);
3396        // no need to normalize: Z/p, R
3397        // normalize already in nDiv: Q_a, Z/p_a
3398        // remains: Q
3399        if (rField_is_Q(r) && (!n_IsOne(c,r->cf))) n_Normalize(c,r->cf);
3400        p_SetCoeff(h,c,r);
3401        pIter(h);
3402      }
3403      n_Delete(&k,r->cf);
3404    }
3405    else
3406    {
3407      //if (r->cf->cfNormalize != nDummy2) //TODO: OPTIMIZE
3408      {
3409        h = pNext(p1);
3410        while (h!=NULL)
3411        {
3412          n_Normalize(pGetCoeff(h),r->cf);
3413          pIter(h);
3414        }
3415      }
3416    }
3417  }
3418}
3419
3420/*2
3421*normalize all coefficients
3422*/
3423void p_Normalize(poly p,const ring r)
3424{
3425  if (rField_has_simple_inverse(r)) return; /* Z/p, GF(p,n), R, long R/C */
3426  while (p!=NULL)
3427  {
3428#ifdef LDEBUG
3429    n_Test(pGetCoeff(p), r->cf);
3430#endif
3431    n_Normalize(pGetCoeff(p),r->cf);
3432    pIter(p);
3433  }
3434}
3435
3436// splits p into polys with Exp(n) == 0 and Exp(n) != 0
3437// Poly with Exp(n) != 0 is reversed
3438static void p_SplitAndReversePoly(poly p, int n, poly *non_zero, poly *zero, const ring r)
3439{
3440  if (p == NULL)
3441  {
3442    *non_zero = NULL;
3443    *zero = NULL;
3444    return;
3445  }
3446  spolyrec sz;
3447  poly z, n_z, next;
3448  z = &sz;
3449  n_z = NULL;
3450
3451  while(p != NULL)
3452  {
3453    next = pNext(p);
3454    if (p_GetExp(p, n,r) == 0)
3455    {
3456      pNext(z) = p;
3457      pIter(z);
3458    }
3459    else
3460    {
3461      pNext(p) = n_z;
3462      n_z = p;
3463    }
3464    p = next;
3465  }
3466  pNext(z) = NULL;
3467  *zero = pNext(&sz);
3468  *non_zero = n_z;
3469}
3470/*3
3471* substitute the n-th variable by 1 in p
3472* destroy p
3473*/
3474static poly p_Subst1 (poly p,int n, const ring r)
3475{
3476  poly qq=NULL, result = NULL;
3477  poly zero=NULL, non_zero=NULL;
3478
3479  // reverse, so that add is likely to be linear
3480  p_SplitAndReversePoly(p, n, &non_zero, &zero,r);
3481
3482  while (non_zero != NULL)
3483  {
3484    assume(p_GetExp(non_zero, n,r) != 0);
3485    qq = non_zero;
3486    pIter(non_zero);
3487    qq->next = NULL;
3488    p_SetExp(qq,n,0,r);
3489    p_Setm(qq,r);
3490    result = p_Add_q(result,qq,r);
3491  }
3492  p = p_Add_q(result, zero,r);
3493  p_Test(p,r);
3494  return p;
3495}
3496
3497/*3
3498* substitute the n-th variable by number e in p
3499* destroy p
3500*/
3501static poly p_Subst2 (poly p,int n, number e, const ring r)
3502{
3503  assume( ! n_IsZero(e,r->cf) );
3504  poly qq,result = NULL;
3505  number nn, nm;
3506  poly zero, non_zero;
3507
3508  // reverse, so that add is likely to be linear
3509  p_SplitAndReversePoly(p, n, &non_zero, &zero,r);
3510
3511  while (non_zero != NULL)
3512  {
3513    assume(p_GetExp(non_zero, n, r) != 0);
3514    qq = non_zero;
3515    pIter(non_zero);
3516    qq->next = NULL;
3517    n_Power(e, p_GetExp(qq, n, r), &nn,r->cf);
3518    nm = n_Mult(nn, pGetCoeff(qq),r->cf);
3519#ifdef HAVE_RINGS
3520    if (n_IsZero(nm,r->cf))
3521    {
3522      p_LmFree(&qq,r);
3523      n_Delete(&nm,r->cf);
3524    }
3525    else
3526#endif
3527    {
3528      p_SetCoeff(qq, nm,r);
3529      p_SetExp(qq, n, 0,r);
3530      p_Setm(qq,r);
3531      result = p_Add_q(result,qq,r);
3532    }
3533    n_Delete(&nn,r->cf);
3534  }
3535  p = p_Add_q(result, zero,r);
3536  p_Test(p,r);
3537  return p;
3538}
3539
3540
3541/* delete monoms whose n-th exponent is different from zero */
3542static poly p_Subst0(poly p, int n, const ring r)
3543{
3544  spolyrec res;
3545  poly h = &res;
3546  pNext(h) = p;
3547
3548  while (pNext(h)!=NULL)
3549  {
3550    if (p_GetExp(pNext(h),n,r)!=0)
3551    {
3552      p_LmDelete(&pNext(h),r);
3553    }
3554    else
3555    {
3556      pIter(h);
3557    }
3558  }
3559  p_Test(pNext(&res),r);
3560  return pNext(&res);
3561}
3562
3563/*2
3564* substitute the n-th variable by e in p
3565* destroy p
3566*/
3567poly p_Subst(poly p, int n, poly e, const ring r)
3568{
3569  if (e == NULL) return p_Subst0(p, n,r);
3570
3571  if (p_IsConstant(e,r))
3572  {
3573    if (n_IsOne(pGetCoeff(e),r->cf)) return p_Subst1(p,n,r);
3574    else return p_Subst2(p, n, pGetCoeff(e),r);
3575  }
3576
3577#ifdef HAVE_PLURAL
3578  if (rIsPluralRing(r))
3579  {
3580    return nc_pSubst(p,n,e,r);
3581  }
3582#endif
3583
3584  int exponent,i;
3585  poly h, res, m;
3586  int *me,*ee;
3587  number nu,nu1;
3588
3589  me=(int *)omAlloc((rVar(r)+1)*sizeof(int));
3590  ee=(int *)omAlloc((rVar(r)+1)*sizeof(int));
3591  if (e!=NULL) p_GetExpV(e,ee,r);
3592  res=NULL;
3593  h=p;
3594  while (h!=NULL)
3595  {
3596    if ((e!=NULL) || (p_GetExp(h,n,r)==0))
3597    {
3598      m=p_Head(h,r);
3599      p_GetExpV(m,me,r);
3600      exponent=me[n];
3601      me[n]=0;
3602      for(i=rVar(r);i>0;i--)
3603        me[i]+=exponent*ee[i];
3604      p_SetExpV(m,me,r);
3605      if (e!=NULL)
3606      {
3607        n_Power(pGetCoeff(e),exponent,&nu,r->cf);
3608        nu1=n_Mult(pGetCoeff(m),nu,r->cf);
3609        n_Delete(&nu,r->cf);
3610        p_SetCoeff(m,nu1,r);
3611      }
3612      res=p_Add_q(res,m,r);
3613    }
3614    p_LmDelete(&h,r);
3615  }
3616  omFreeSize((ADDRESS)me,(rVar(r)+1)*sizeof(int));
3617  omFreeSize((ADDRESS)ee,(rVar(r)+1)*sizeof(int));
3618  return res;
3619}
3620
3621/*2
3622 * returns a re-ordered convertion of a number as a polynomial,
3623 * with permutation of parameters
3624 * NOTE: this only works for Frank's alg. & trans. fields
3625 */
3626poly n_PermNumber(const number z, const int *par_perm, const int , const ring src, const ring dst)
3627{
3628#if 0
3629  PrintS("\nSource Ring: \n");
3630  rWrite(src);
3631
3632  if(0)
3633  {
3634    number zz = n_Copy(z, src->cf);
3635    PrintS("z: "); n_Write(zz, src);
3636    n_Delete(&zz, src->cf);
3637  }
3638
3639  PrintS("\nDestination Ring: \n");
3640  rWrite(dst);
3641
3642  /*Print("\nOldPar: %d\n", OldPar);
3643  for( int i = 1; i <= OldPar; i++ )
3644  {
3645    Print("par(%d) -> par/var (%d)\n", i, par_perm[i-1]);
3646  }*/
3647#endif
3648  if( z == NULL )
3649     return NULL;
3650
3651  const coeffs srcCf = src->cf;
3652  assume( srcCf != NULL );
3653
3654  assume( !nCoeff_is_GF(srcCf) );
3655  assume( src->cf->extRing!=NULL );
3656
3657  poly zz = NULL;
3658
3659  const ring srcExtRing = srcCf->extRing;
3660  assume( srcExtRing != NULL );
3661
3662  const coeffs dstCf = dst->cf;
3663  assume( dstCf != NULL );
3664
3665  if( nCoeff_is_algExt(srcCf) ) // nCoeff_is_GF(srcCf)?
3666  {
3667    zz = (poly) z;
3668    if( zz == NULL ) return NULL;
3669  }
3670  else if (nCoeff_is_transExt(srcCf))
3671  {
3672    assume( !IS0(z) );
3673
3674    zz = NUM(z);
3675    p_Test (zz, srcExtRing);
3676
3677    if( zz == NULL ) return NULL;
3678    if( !DENIS1(z) )
3679    {
3680      if (p_IsConstant(DEN(z),srcExtRing))
3681      {
3682        number n=pGetCoeff(DEN(z));
3683        zz=p_Div_nn(zz,n,srcExtRing);
3684        p_Normalize(zz,srcExtRing);
3685      }
3686      //else
3687      //  WarnS("Not implemented yet: Cannot permute a rational fraction and make a polynomial out of it! Ignorring the denumerator.");
3688    }
3689  }
3690  else
3691  {
3692    assume (FALSE);
3693    Werror("Number permutation is not implemented for this data yet!");
3694    return NULL;
3695  }
3696
3697  assume( zz != NULL );
3698  p_Test (zz, srcExtRing);
3699
3700  nMapFunc nMap = n_SetMap(srcExtRing->cf, dstCf);
3701
3702  assume( nMap != NULL );
3703
3704  poly qq;
3705  if ((par_perm == NULL) && (rPar(dst) != 0 && rVar (srcExtRing) > 0))
3706  {
3707    int* perm;
3708    perm=(int *)omAlloc0((rVar(srcExtRing)+1)*sizeof(int));
3709    perm[0]= 0;
3710    for(int i=si_min(rVar(srcExtRing),rPar(dst));i>0;i--)
3711      perm[i]=-i;
3712    qq = p_PermPoly(zz, perm, srcExtRing, dst, nMap, NULL, rVar(srcExtRing)-1);
3713    omFreeSize ((ADDRESS)perm, (rVar(srcExtRing)+1)*sizeof(int));
3714  }
3715  else
3716    qq = p_PermPoly(zz, par_perm-1, srcExtRing, dst, nMap, NULL, rVar (srcExtRing)-1);
3717
3718  assume (p_Test (qq, dst));
3719
3720//       poly p_PermPoly (poly p, int * perm, const ring oldRing, const ring dst, nMapFunc nMap, int *par_perm, int OldPar)
3721
3722//  assume( FALSE );  WarnS("longalg missing 2");
3723
3724  return qq;
3725}
3726
3727
3728/*2
3729*returns a re-ordered copy of a polynomial, with permutation of the variables
3730*/
3731poly p_PermPoly (poly p, const int * perm, const ring oldRing, const ring dst,
3732       nMapFunc nMap, const int *par_perm, int OldPar)
3733{
3734#if 0
3735    p_Test(p, oldRing);
3736    PrintS("\np_PermPoly::p: "); p_Write(p, oldRing, oldRing); PrintLn();
3737#endif
3738
3739  const int OldpVariables = rVar(oldRing);
3740  poly result = NULL;
3741  poly result_last = NULL;
3742  poly aq = NULL; /* the map coefficient */
3743  poly qq; /* the mapped monomial */
3744
3745  assume(dst != NULL);
3746  assume(dst->cf != NULL);
3747
3748  while (p != NULL)
3749  {
3750    // map the coefficient
3751    if ( ((OldPar == 0) || (par_perm == NULL) || rField_is_GF(oldRing)) && (nMap != NULL) )
3752    {
3753      qq = p_Init(dst);
3754      assume( nMap != NULL );
3755
3756      number n = nMap(p_GetCoeff(p, oldRing), oldRing->cf, dst->cf);
3757
3758      assume (n_Test (n,dst->cf));
3759
3760      if ( nCoeff_is_algExt(dst->cf) )
3761        n_Normalize(n, dst->cf);
3762
3763      p_GetCoeff(qq, dst) = n;// Note: n can be a ZERO!!!
3764      // coef may be zero:
3765//      p_Test(qq, dst);
3766    }
3767    else
3768    {
3769      qq = p_One(dst);
3770
3771//      aq = naPermNumber(p_GetCoeff(p, oldRing), par_perm, OldPar, oldRing); // no dst???
3772//      poly    n_PermNumber(const number z, const int *par_perm, const int P, const ring src, const ring dst)
3773      aq = n_PermNumber(p_GetCoeff(p, oldRing), par_perm, OldPar, oldRing, dst);
3774
3775      p_Test(aq, dst);
3776
3777      if ( nCoeff_is_algExt(dst->cf) )
3778        p_Normalize(aq,dst);
3779
3780      if (aq == NULL)
3781        p_SetCoeff(qq, n_Init(0, dst->cf),dst); // Very dirty trick!!!
3782
3783      p_Test(aq, dst);
3784    }
3785
3786    if (rRing_has_Comp(dst))
3787       p_SetComp(qq, p_GetComp(p, oldRing), dst);
3788
3789    if ( n_IsZero(pGetCoeff(qq), dst->cf) )
3790    {
3791      p_LmDelete(&qq,dst);
3792      qq = NULL;
3793    }
3794    else
3795    {
3796      // map pars:
3797      int mapped_to_par = 0;
3798      for(int i = 1; i <= OldpVariables; i++)
3799      {
3800        int e = p_GetExp(p, i, oldRing);
3801        if (e != 0)
3802        {
3803          if (perm==NULL)
3804            p_SetExp(qq, i, e, dst);
3805          else if (perm[i]>0)
3806            p_AddExp(qq,perm[i], e/*p_GetExp( p,i,oldRing)*/, dst);
3807          else if (perm[i]<0)
3808          {
3809            number c = p_GetCoeff(qq, dst);
3810            if (rField_is_GF(dst))
3811            {
3812              assume( dst->cf->extRing == NULL );
3813              number ee = n_Param(1, dst);
3814
3815              number eee;
3816              n_Power(ee, e, &eee, dst->cf); //nfDelete(ee,dst);
3817
3818              ee = n_Mult(c, eee, dst->cf);
3819              //nfDelete(c,dst);nfDelete(eee,dst);
3820              pSetCoeff0(qq,ee);
3821            }
3822            else if (nCoeff_is_Extension(dst->cf))
3823            {
3824              const int par = -perm[i];
3825              assume( par > 0 );
3826
3827//              WarnS("longalg missing 3");
3828#if 1
3829              const coeffs C = dst->cf;
3830              assume( C != NULL );
3831
3832              const ring R = C->extRing;
3833              assume( R != NULL );
3834
3835              assume( par <= rVar(R) );
3836
3837              poly pcn; // = (number)c
3838
3839              assume( !n_IsZero(c, C) );
3840
3841              if( nCoeff_is_algExt(C) )
3842                 pcn = (poly) c;
3843               else //            nCoeff_is_transExt(C)
3844                 pcn = NUM(c);
3845
3846              if (pNext(pcn) == NULL) // c->z
3847                p_AddExp(pcn, -perm[i], e, R);
3848              else /* more difficult: we have really to multiply: */
3849              {
3850                poly mmc = p_ISet(1, R);
3851                p_SetExp(mmc, -perm[i], e, R);
3852                p_Setm(mmc, R);
3853
3854                number nnc;
3855                // convert back to a number: number nnc = mmc;
3856                if( nCoeff_is_algExt(C) )
3857                   nnc = (number) mmc;
3858                else //            nCoeff_is_transExt(C)
3859                  nnc = ntInit(mmc, C);
3860
3861                p_GetCoeff(qq, dst) = n_Mult((number)c, nnc, C);
3862                n_Delete((number *)&c, C);
3863                n_Delete((number *)&nnc, C);
3864              }
3865
3866              mapped_to_par=1;
3867#endif
3868            }
3869          }
3870          else
3871          {
3872            /* this variable maps to 0 !*/
3873            p_LmDelete(&qq, dst);
3874            break;
3875          }
3876        }
3877      }
3878      if ( mapped_to_par && qq!= NULL && nCoeff_is_algExt(dst->cf) )
3879      {
3880        number n = p_GetCoeff(qq, dst);
3881        n_Normalize(n, dst->cf);
3882        p_GetCoeff(qq, dst) = n;
3883      }
3884    }
3885    pIter(p);
3886
3887#if 0
3888    p_Test(aq,dst);
3889    PrintS("\naq: "); p_Write(aq, dst, dst); PrintLn();
3890#endif
3891
3892
3893#if 1
3894    if (qq!=NULL)
3895    {
3896      p_Setm(qq,dst);
3897
3898      p_Test(aq,dst);
3899      p_Test(qq,dst);
3900
3901#if 0
3902    p_Test(qq,dst);
3903    PrintS("\nqq: "); p_Write(qq, dst, dst); PrintLn();
3904#endif
3905
3906      if (aq!=NULL)
3907         qq=p_Mult_q(aq,qq,dst);
3908
3909      aq = qq;
3910
3911      while (pNext(aq) != NULL) pIter(aq);
3912
3913      if (result_last==NULL)
3914      {
3915        result=qq;
3916      }
3917      else
3918      {
3919        pNext(result_last)=qq;
3920      }
3921      result_last=aq;
3922      aq = NULL;
3923    }
3924    else if (aq!=NULL)
3925    {
3926      p_Delete(&aq,dst);
3927    }
3928  }
3929
3930  result=p_SortAdd(result,dst);
3931#else
3932  //  if (qq!=NULL)
3933  //  {
3934  //    pSetm(qq);
3935  //    pTest(qq);
3936  //    pTest(aq);
3937  //    if (aq!=NULL) qq=pMult(aq,qq);
3938  //    aq = qq;
3939  //    while (pNext(aq) != NULL) pIter(aq);
3940  //    pNext(aq) = result;
3941  //    aq = NULL;
3942  //    result = qq;
3943  //  }
3944  //  else if (aq!=NULL)
3945  //  {
3946  //    pDelete(&aq);
3947  //  }
3948  //}
3949  //p = result;
3950  //result = NULL;
3951  //while (p != NULL)
3952  //{
3953  //  qq = p;
3954  //  pIter(p);
3955  //  qq->next = NULL;
3956  //  result = pAdd(result, qq);
3957  //}
3958#endif
3959  p_Test(result,dst);
3960
3961#if 0
3962  p_Test(result,dst);
3963  PrintS("\nresult: "); p_Write(result,dst,dst); PrintLn();
3964#endif
3965  return result;
3966}
3967/**************************************************************
3968 *
3969 * Jet
3970 *
3971 **************************************************************/
3972
3973poly pp_Jet(poly p, int m, const ring R)
3974{
3975  poly r=NULL;
3976  poly t=NULL;
3977
3978  while (p!=NULL)
3979  {
3980    if (p_Totaldegree(p,R)<=m)
3981    {
3982      if (r==NULL)
3983        r=p_Head(p,R);
3984      else
3985      if (t==NULL)
3986      {
3987        pNext(r)=p_Head(p,R);
3988        t=pNext(r);
3989      }
3990      else
3991      {
3992        pNext(t)=p_Head(p,R);
3993        pIter(t);
3994      }
3995    }
3996    pIter(p);
3997  }
3998  return r;
3999}
4000
4001poly p_Jet(poly p, int m,const ring R)
4002{
4003  while((p!=NULL) && (p_Totaldegree(p,R)>m)) p_LmDelete(&p,R);
4004  if (p==NULL) return NULL;
4005  poly r=p;
4006  while (pNext(p)!=NULL)
4007  {
4008    if (p_Totaldegree(pNext(p),R)>m)
4009    {
4010      p_LmDelete(&pNext(p),R);
4011    }
4012    else
4013      pIter(p);
4014  }
4015  return r;
4016}
4017
4018poly pp_JetW(poly p, int m, short *w, const ring R)
4019{
4020  poly r=NULL;
4021  poly t=NULL;
4022  while (p!=NULL)
4023  {
4024    if (totaldegreeWecart_IV(p,R,w)<=m)
4025    {
4026      if (r==NULL)
4027        r=p_Head(p,R);
4028      else
4029      if (t==NULL)
4030      {
4031        pNext(r)=p_Head(p,R);
4032        t=pNext(r);
4033      }
4034      else
4035      {
4036        pNext(t)=p_Head(p,R);
4037        pIter(t);
4038      }
4039    }
4040    pIter(p);
4041  }
4042  return r;
4043}
4044
4045poly p_JetW(poly p, int m, short *w, const ring R)
4046{
4047  while((p!=NULL) && (totaldegreeWecart_IV(p,R,w)>m)) p_LmDelete(&p,R);
4048  if (p==NULL) return NULL;
4049  poly r=p;
4050  while (pNext(p)!=NULL)
4051  {
4052    if (totaldegreeWecart_IV(pNext(p),R,w)>m)
4053    {
4054      p_LmDelete(&pNext(p),R);
4055    }
4056    else
4057      pIter(p);
4058  }
4059  return r;
4060}
4061
4062/*************************************************************/
4063int p_MinDeg(poly p,intvec *w, const ring R)
4064{
4065  if(p==NULL)
4066    return -1;
4067  int d=-1;
4068  while(p!=NULL)
4069  {
4070    int d0=0;
4071    for(int j=0;j<rVar(R);j++)
4072      if(w==NULL||j>=w->length())
4073        d0+=p_GetExp(p,j+1,R);
4074      else
4075        d0+=(*w)[j]*p_GetExp(p,j+1,R);
4076    if(d0<d||d==-1)
4077      d=d0;
4078    pIter(p);
4079  }
4080  return d;
4081}
4082
4083/***************************************************************/
4084
4085poly p_Series(int n,poly p,poly u, intvec *w, const ring R)
4086{
4087  short *ww=iv2array(w,R);
4088  if(p!=NULL)
4089  {
4090    if(u==NULL)
4091      p=p_JetW(p,n,ww,R);
4092    else
4093      p=p_JetW(p_Mult_q(p,p_Invers(n-p_MinDeg(p,w,R),u,w,R),R),n,ww,R);
4094  }
4095  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
4096  return p;
4097}
4098
4099poly p_Invers(int n,poly u,intvec *w, const ring R)
4100{
4101  if(n<0)
4102    return NULL;
4103  number u0=n_Invers(pGetCoeff(u),R->cf);
4104  poly v=p_NSet(u0,R);
4105  if(n==0)
4106    return v;
4107  short *ww=iv2array(w,R);
4108  poly u1=p_JetW(p_Sub(p_One(R),p_Mult_nn(u,u0,R),R),n,ww,R);
4109  if(u1==NULL)
4110  {
4111    omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
4112    return v;
4113  }
4114  poly v1=p_Mult_nn(p_Copy(u1,R),u0,R);
4115  v=p_Add_q(v,p_Copy(v1,R),R);
4116  for(int i=n/p_MinDeg(u1,w,R);i>1;i--)
4117  {
4118    v1=p_JetW(p_Mult_q(v1,p_Copy(u1,R),R),n,ww,R);
4119    v=p_Add_q(v,p_Copy(v1,R),R);
4120  }
4121  p_Delete(&u1,R);
4122  p_Delete(&v1,R);
4123  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
4124  return v;
4125}
4126
4127BOOLEAN p_EqualPolys(poly p1,poly p2, const ring r)
4128{
4129  while ((p1 != NULL) && (p2 != NULL))
4130  {
4131    if (! p_LmEqual(p1, p2,r))
4132      return FALSE;
4133    if (! n_Equal(p_GetCoeff(p1,r), p_GetCoeff(p2,r),r->cf ))
4134      return FALSE;
4135    pIter(p1);
4136    pIter(p2);
4137  }
4138  return (p1==p2);
4139}
4140
4141static inline BOOLEAN p_ExpVectorEqual(poly p1, poly p2, const ring r1, const ring r2)
4142{
4143  assume( r1 == r2 || rSamePolyRep(r1, r2) );
4144
4145  p_LmCheckPolyRing1(p1, r1);
4146  p_LmCheckPolyRing1(p2, r2);
4147
4148  int i = r1->ExpL_Size;
4149
4150  assume( r1->ExpL_Size == r2->ExpL_Size );
4151
4152  unsigned long *ep = p1->exp;
4153  unsigned long *eq = p2->exp;
4154
4155  do
4156  {
4157    i--;
4158    if (ep[i] != eq[i]) return FALSE;
4159  }
4160  while (i);
4161
4162  return TRUE;
4163}
4164
4165BOOLEAN p_EqualPolys(poly p1,poly p2, const ring r1, const ring r2)
4166{
4167  assume( r1 == r2 || rSamePolyRep(r1, r2) ); // will be used in rEqual!
4168  assume( r1->cf == r2->cf );
4169
4170  while ((p1 != NULL) && (p2 != NULL))
4171  {
4172    // returns 1 if ExpVector(p)==ExpVector(q): does not compare numbers !!
4173    // #define p_LmEqual(p1, p2, r) p_ExpVectorEqual(p1, p2, r)
4174
4175    if (! p_ExpVectorEqual(p1, p2, r1, r2))
4176      return FALSE;
4177
4178    if (! n_Equal(p_GetCoeff(p1,r1), p_GetCoeff(p2,r2), r1->cf ))
4179      return FALSE;
4180
4181    pIter(p1);
4182    pIter(p2);
4183  }
4184  return (p1==p2);
4185}
4186
4187/*2
4188*returns TRUE if p1 is a skalar multiple of p2
4189*assume p1 != NULL and p2 != NULL
4190*/
4191BOOLEAN p_ComparePolys(poly p1,poly p2, const ring r)
4192{
4193  number n,nn;
4194  pAssume(p1 != NULL && p2 != NULL);
4195
4196  if (!p_LmEqual(p1,p2,r)) //compare leading mons
4197      return FALSE;
4198  if ((pNext(p1)==NULL) && (pNext(p2)!=NULL))
4199     return FALSE;
4200  if ((pNext(p2)==NULL) && (pNext(p1)!=NULL))
4201     return FALSE;
4202  if (pLength(p1) != pLength(p2))
4203    return FALSE;
4204#ifdef HAVE_RINGS
4205  if (rField_is_Ring(r))
4206  {
4207    if (!n_DivBy(p_GetCoeff(p1, r), p_GetCoeff(p2, r), r)) return FALSE;
4208  }
4209#endif
4210  n=n_Div(p_GetCoeff(p1,r),p_GetCoeff(p2,r),r);
4211  while ((p1 != NULL) /*&& (p2 != NULL)*/)
4212  {
4213    if ( ! p_LmEqual(p1, p2,r))
4214    {
4215        n_Delete(&n, r);
4216        return FALSE;
4217    }
4218    if (!n_Equal(p_GetCoeff(p1, r), nn = n_Mult(p_GetCoeff(p2, r),n, r->cf), r->cf))
4219    {
4220      n_Delete(&n, r);
4221      n_Delete(&nn, r);
4222      return FALSE;
4223    }
4224    n_Delete(&nn, r);
4225    pIter(p1);
4226    pIter(p2);
4227  }
4228  n_Delete(&n, r);
4229  return TRUE;
4230}
4231
4232/*2
4233* returns the length of a (numbers of monomials)
4234* respect syzComp
4235*/
4236poly p_Last(const poly p, int &l, const ring r)
4237{
4238  if (p == NULL)
4239  {
4240    l = 0;
4241    return NULL;
4242  }
4243  l = 1;
4244  poly a = p;
4245  if (! rIsSyzIndexRing(r))
4246  {
4247    poly next = pNext(a);
4248    while (next!=NULL)
4249    {
4250      a = next;
4251      next = pNext(a);
4252      l++;
4253    }
4254  }
4255  else
4256  {
4257    int curr_limit = rGetCurrSyzLimit(r);
4258    poly pp = a;
4259    while ((a=pNext(a))!=NULL)
4260    {
4261      if (p_GetComp(a,r)<=curr_limit/*syzComp*/)
4262        l++;
4263      else break;
4264      pp = a;
4265    }
4266    a=pp;
4267  }
4268  return a;
4269}
4270
4271int p_Var(poly m,const ring r)
4272{
4273  if (m==NULL) return 0;
4274  if (pNext(m)!=NULL) return 0;
4275  int i,e=0;
4276  for (i=rVar(r); i>0; i--)
4277  {
4278    int exp=p_GetExp(m,i,r);
4279    if (exp==1)
4280    {
4281      if (e==0) e=i;
4282      else return 0;
4283    }
4284    else if (exp!=0)
4285    {
4286      return 0;
4287    }
4288  }
4289  return e;
4290}
4291
4292/*2
4293*the minimal index of used variables - 1
4294*/
4295int p_LowVar (poly p, const ring r)
4296{
4297  int k,l,lex;
4298
4299  if (p == NULL) return -1;
4300
4301  k = 32000;/*a very large dummy value*/
4302  while (p != NULL)
4303  {
4304    l = 1;
4305    lex = p_GetExp(p,l,r);
4306    while ((l < (rVar(r))) && (lex == 0))
4307    {
4308      l++;
4309      lex = p_GetExp(p,l,r);
4310    }
4311    l--;
4312    if (l < k) k = l;
4313    pIter(p);
4314  }
4315  return k;
4316}
4317
4318/*2
4319* verschiebt die Indizees der Modulerzeugenden um i
4320*/
4321void p_Shift (poly * p,int i, const ring r)
4322{
4323  poly qp1 = *p,qp2 = *p;/*working pointers*/
4324  int     j = p_MaxComp(*p,r),k = p_MinComp(*p,r);
4325
4326  if (j+i < 0) return ;
4327  while (qp1 != NULL)
4328  {
4329    if ((p_GetComp(qp1,r)+i > 0) || ((j == -i) && (j == k)))
4330    {
4331      p_AddComp(qp1,i,r);
4332      p_SetmComp(qp1,r);
4333      qp2 = qp1;
4334      pIter(qp1);
4335    }
4336    else
4337    {
4338      if (qp2 == *p)
4339      {
4340        pIter(*p);
4341        p_LmDelete(&qp2,r);
4342        qp2 = *p;
4343        qp1 = *p;
4344      }
4345      else
4346      {
4347        qp2->next = qp1->next;
4348        if (qp1!=NULL) p_LmDelete(&qp1,r);
4349        qp1 = qp2->next;
4350      }
4351    }
4352  }
4353}
4354
4355/***************************************************************
4356 *
4357 * Storage Managament Routines
4358 *
4359 ***************************************************************/
4360
4361
4362static inline unsigned long GetBitFields(long e,
4363                                         unsigned int s, unsigned int n)
4364{
4365#define Sy_bit_L(x)     (((unsigned long)1L)<<(x))
4366  unsigned int i = 0;
4367  unsigned long  ev = 0L;
4368  assume(n > 0 && s < BIT_SIZEOF_LONG);
4369  do
4370  {
4371    assume(s+i < BIT_SIZEOF_LONG);
4372    if (e > (long) i) ev |= Sy_bit_L(s+i);
4373    else break;
4374    i++;
4375  }
4376  while (i < n);
4377  return ev;
4378}
4379
4380// Short Exponent Vectors are used for fast divisibility tests
4381// ShortExpVectors "squeeze" an exponent vector into one word as follows:
4382// Let n = BIT_SIZEOF_LONG / pVariables.
4383// If n == 0 (i.e. pVariables > BIT_SIZE_OF_LONG), let m == the number
4384// of non-zero exponents. If (m>BIT_SIZEOF_LONG), then sev = ~0, else
4385// first m bits of sev are set to 1.
4386// Otherwise (i.e. pVariables <= BIT_SIZE_OF_LONG)
4387// represented by a bit-field of length n (resp. n+1 for some
4388// exponents). If the value of an exponent is greater or equal to n, then
4389// all of its respective n bits are set to 1. If the value of an exponent
4390// is smaller than n, say m, then only the first m bits of the respective
4391// n bits are set to 1, the others are set to 0.
4392// This way, we have:
4393// exp1 / exp2 ==> (ev1 & ~ev2) == 0, i.e.,
4394// if (ev1 & ~ev2) then exp1 does not divide exp2
4395unsigned long p_GetShortExpVector(poly p, const ring r)
4396{
4397  assume(p != NULL);
4398  if (p == NULL) return 0;
4399  unsigned long ev = 0; // short exponent vector
4400  unsigned int n = BIT_SIZEOF_LONG / r->N; // number of bits per exp
4401  unsigned int m1; // highest bit which is filled with (n+1)
4402  unsigned int i = 0, j=1;
4403
4404  if (n == 0)
4405  {
4406    if (r->N <2*BIT_SIZEOF_LONG)
4407    {
4408      n=1;
4409      m1=0;
4410    }
4411    else
4412    {
4413      for (; j<=(unsigned long) r->N; j++)
4414      {
4415        if (p_GetExp(p,j,r) > 0) i++;
4416        if (i == BIT_SIZEOF_LONG) break;
4417      }
4418      if (i>0)
4419        ev = ~((unsigned long)0) >> ((unsigned long) (BIT_SIZEOF_LONG - i));
4420      return ev;
4421    }
4422  }
4423  else
4424  {
4425    m1 = (n+1)*(BIT_SIZEOF_LONG - n*r->N);
4426  }
4427
4428  n++;
4429  while (i<m1)
4430  {
4431    ev |= GetBitFields(p_GetExp(p, j,r), i, n);
4432    i += n;
4433    j++;
4434  }
4435
4436  n--;
4437  while (i<BIT_SIZEOF_LONG)
4438  {
4439    ev |= GetBitFields(p_GetExp(p, j,r), i, n);
4440    i += n;
4441    j++;
4442  }
4443  return ev;
4444}
4445
4446/***************************************************************
4447 *
4448 * p_ShallowDelete
4449 *
4450 ***************************************************************/
4451#undef LINKAGE
4452#define LINKAGE
4453#undef p_Delete__T
4454#define p_Delete__T p_ShallowDelete
4455#undef n_Delete__T
4456#define n_Delete__T(n, r) do {} while (0)
4457
4458#include <polys/templates/p_Delete__T.cc>
4459
Note: See TracBrowser for help on using the repository browser.