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

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