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

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