source: git/libpolys/polys/monomials/p_polys.cc @ 45cc512

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