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

spielwiese
Last change on this file since 656985 was 656985, checked in by Oleksandr Motsak <motsak@…>, 11 years ago
Fix the remaining wrongs due to API change: PrintS+StringAppendS -> PrintS+StringEndS!
  • Property mode set to 100644
File size: 88.0 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    n_Normalize(c,r->cf);
1521    p_SetCoeff(t, c, r);
1522    int e = p_GetExp(p, 1, r) - divisorLE;
1523    p_SetExp(t, 1, e, r);
1524    p_Setm(t, r);
1525    if (needResult) result = p_Add_q(result, p_Copy(t, r), r);
1526    p = p_Add_q(p, p_Neg(p_Mult_q(t, p_Copy(divisor, r), r), r), r);
1527  }
1528  return result;
1529}
1530
1531/*2
1532* returns the partial differentiate of a by the k-th variable
1533* does not destroy the input
1534*/
1535poly p_Diff(poly a, int k, const ring r)
1536{
1537  poly res, f, last;
1538  number t;
1539
1540  last = res = NULL;
1541  while (a!=NULL)
1542  {
1543    if (p_GetExp(a,k,r)!=0)
1544    {
1545      f = p_LmInit(a,r);
1546      t = n_Init(p_GetExp(a,k,r),r->cf);
1547      pSetCoeff0(f,n_Mult(t,pGetCoeff(a),r->cf));
1548      n_Delete(&t,r->cf);
1549      if (n_IsZero(pGetCoeff(f),r->cf))
1550        p_LmDelete(&f,r);
1551      else
1552      {
1553        p_DecrExp(f,k,r);
1554        p_Setm(f,r);
1555        if (res==NULL)
1556        {
1557          res=last=f;
1558        }
1559        else
1560        {
1561          pNext(last)=f;
1562          last=f;
1563        }
1564      }
1565    }
1566    pIter(a);
1567  }
1568  return res;
1569}
1570
1571static poly p_DiffOpM(poly a, poly b,BOOLEAN multiply, const ring r)
1572{
1573  int i,j,s;
1574  number n,h,hh;
1575  poly p=p_One(r);
1576  n=n_Mult(pGetCoeff(a),pGetCoeff(b),r->cf);
1577  for(i=rVar(r);i>0;i--)
1578  {
1579    s=p_GetExp(b,i,r);
1580    if (s<p_GetExp(a,i,r))
1581    {
1582      n_Delete(&n,r->cf);
1583      p_LmDelete(&p,r);
1584      return NULL;
1585    }
1586    if (multiply)
1587    {
1588      for(j=p_GetExp(a,i,r); j>0;j--)
1589      {
1590        h = n_Init(s,r->cf);
1591        hh=n_Mult(n,h,r->cf);
1592        n_Delete(&h,r->cf);
1593        n_Delete(&n,r->cf);
1594        n=hh;
1595        s--;
1596      }
1597      p_SetExp(p,i,s,r);
1598    }
1599    else
1600    {
1601      p_SetExp(p,i,s-p_GetExp(a,i,r),r);
1602    }
1603  }
1604  p_Setm(p,r);
1605  /*if (multiply)*/ p_SetCoeff(p,n,r);
1606  if (n_IsZero(n,r->cf))  p=p_LmDeleteAndNext(p,r); // return NULL as p is a monomial
1607  return p;
1608}
1609
1610poly p_DiffOp(poly a, poly b,BOOLEAN multiply, const ring r)
1611{
1612  poly result=NULL;
1613  poly h;
1614  for(;a!=NULL;pIter(a))
1615  {
1616    for(h=b;h!=NULL;pIter(h))
1617    {
1618      result=p_Add_q(result,p_DiffOpM(a,h,multiply,r),r);
1619    }
1620  }
1621  return result;
1622}
1623/*2
1624* subtract p2 from p1, p1 and p2 are destroyed
1625* do not put attention on speed: the procedure is only used in the interpreter
1626*/
1627poly p_Sub(poly p1, poly p2, const ring r)
1628{
1629  return p_Add_q(p1, p_Neg(p2,r),r);
1630}
1631
1632/*3
1633* compute for a monomial m
1634* the power m^exp, exp > 1
1635* destroys p
1636*/
1637static poly p_MonPower(poly p, int exp, const ring r)
1638{
1639  int i;
1640
1641  if(!n_IsOne(pGetCoeff(p),r->cf))
1642  {
1643    number x, y;
1644    y = pGetCoeff(p);
1645    n_Power(y,exp,&x,r->cf);
1646    n_Delete(&y,r->cf);
1647    pSetCoeff0(p,x);
1648  }
1649  for (i=rVar(r); i!=0; i--)
1650  {
1651    p_MultExp(p,i, exp,r);
1652  }
1653  p_Setm(p,r);
1654  return p;
1655}
1656
1657/*3
1658* compute for monomials p*q
1659* destroys p, keeps q
1660*/
1661static void p_MonMult(poly p, poly q, const ring r)
1662{
1663  number x, y;
1664
1665  y = pGetCoeff(p);
1666  x = n_Mult(y,pGetCoeff(q),r->cf);
1667  n_Delete(&y,r->cf);
1668  pSetCoeff0(p,x);
1669  //for (int i=pVariables; i!=0; i--)
1670  //{
1671  //  pAddExp(p,i, pGetExp(q,i));
1672  //}
1673  //p->Order += q->Order;
1674  p_ExpVectorAdd(p,q,r);
1675}
1676
1677/*3
1678* compute for monomials p*q
1679* keeps p, q
1680*/
1681static poly p_MonMultC(poly p, poly q, const ring rr)
1682{
1683  number x;
1684  poly r = p_Init(rr);
1685
1686  x = n_Mult(pGetCoeff(p),pGetCoeff(q),rr->cf);
1687  pSetCoeff0(r,x);
1688  p_ExpVectorSum(r,p, q, rr);
1689  return r;
1690}
1691
1692/*3
1693*  create binomial coef.
1694*/
1695static number* pnBin(int exp, const ring r)
1696{
1697  int e, i, h;
1698  number x, y, *bin=NULL;
1699
1700  x = n_Init(exp,r->cf);
1701  if (n_IsZero(x,r->cf))
1702  {
1703    n_Delete(&x,r->cf);
1704    return bin;
1705  }
1706  h = (exp >> 1) + 1;
1707  bin = (number *)omAlloc0(h*sizeof(number));
1708  bin[1] = x;
1709  if (exp < 4)
1710    return bin;
1711  i = exp - 1;
1712  for (e=2; e<h; e++)
1713  {
1714      x = n_Init(i,r->cf);
1715      i--;
1716      y = n_Mult(x,bin[e-1],r->cf);
1717      n_Delete(&x,r->cf);
1718      x = n_Init(e,r->cf);
1719      bin[e] = n_IntDiv(y,x,r->cf);
1720      n_Delete(&x,r->cf);
1721      n_Delete(&y,r->cf);
1722  }
1723  return bin;
1724}
1725
1726static void pnFreeBin(number *bin, int exp,const coeffs r)
1727{
1728  int e, h = (exp >> 1) + 1;
1729
1730  if (bin[1] != NULL)
1731  {
1732    for (e=1; e<h; e++)
1733      n_Delete(&(bin[e]),r);
1734  }
1735  omFreeSize((ADDRESS)bin, h*sizeof(number));
1736}
1737
1738/*
1739*  compute for a poly p = head+tail, tail is monomial
1740*          (head + tail)^exp, exp > 1
1741*          with binomial coef.
1742*/
1743static poly p_TwoMonPower(poly p, int exp, const ring r)
1744{
1745  int eh, e;
1746  long al;
1747  poly *a;
1748  poly tail, b, res, h;
1749  number x;
1750  number *bin = pnBin(exp,r);
1751
1752  tail = pNext(p);
1753  if (bin == NULL)
1754  {
1755    p_MonPower(p,exp,r);
1756    p_MonPower(tail,exp,r);
1757#ifdef PDEBUG
1758    p_Test(p,r);
1759#endif
1760    return p;
1761  }
1762  eh = exp >> 1;
1763  al = (exp + 1) * sizeof(poly);
1764  a = (poly *)omAlloc(al);
1765  a[1] = p;
1766  for (e=1; e<exp; e++)
1767  {
1768    a[e+1] = p_MonMultC(a[e],p,r);
1769  }
1770  res = a[exp];
1771  b = p_Head(tail,r);
1772  for (e=exp-1; e>eh; e--)
1773  {
1774    h = a[e];
1775    x = n_Mult(bin[exp-e],pGetCoeff(h),r->cf);
1776    p_SetCoeff(h,x,r);
1777    p_MonMult(h,b,r);
1778    res = pNext(res) = h;
1779    p_MonMult(b,tail,r);
1780  }
1781  for (e=eh; e!=0; e--)
1782  {
1783    h = a[e];
1784    x = n_Mult(bin[e],pGetCoeff(h),r->cf);
1785    p_SetCoeff(h,x,r);
1786    p_MonMult(h,b,r);
1787    res = pNext(res) = h;
1788    p_MonMult(b,tail,r);
1789  }
1790  p_LmDelete(&tail,r);
1791  pNext(res) = b;
1792  pNext(b) = NULL;
1793  res = a[exp];
1794  omFreeSize((ADDRESS)a, al);
1795  pnFreeBin(bin, exp, r->cf);
1796//  tail=res;
1797// while((tail!=NULL)&&(pNext(tail)!=NULL))
1798// {
1799//   if(nIsZero(pGetCoeff(pNext(tail))))
1800//   {
1801//     pLmDelete(&pNext(tail));
1802//   }
1803//   else
1804//     pIter(tail);
1805// }
1806#ifdef PDEBUG
1807  p_Test(res,r);
1808#endif
1809  return res;
1810}
1811
1812static poly p_Pow(poly p, int i, const ring r)
1813{
1814  poly rc = p_Copy(p,r);
1815  i -= 2;
1816  do
1817  {
1818    rc = p_Mult_q(rc,p_Copy(p,r),r);
1819    p_Normalize(rc,r);
1820    i--;
1821  }
1822  while (i != 0);
1823  return p_Mult_q(rc,p,r);
1824}
1825
1826/*2
1827* returns the i-th power of p
1828* p will be destroyed
1829*/
1830poly p_Power(poly p, int i, const ring r)
1831{
1832  poly rc=NULL;
1833
1834  if (i==0)
1835  {
1836    p_Delete(&p,r);
1837    return p_One(r);
1838  }
1839
1840  if(p!=NULL)
1841  {
1842    if ( (i > 0) && ((unsigned long ) i > (r->bitmask)))
1843    {
1844      Werror("exponent %d is too large, max. is %ld",i,r->bitmask);
1845      return NULL;
1846    }
1847    switch (i)
1848    {
1849// cannot happen, see above
1850//      case 0:
1851//      {
1852//        rc=pOne();
1853//        pDelete(&p);
1854//        break;
1855//      }
1856      case 1:
1857        rc=p;
1858        break;
1859      case 2:
1860        rc=p_Mult_q(p_Copy(p,r),p,r);
1861        break;
1862      default:
1863        if (i < 0)
1864        {
1865          p_Delete(&p,r);
1866          return NULL;
1867        }
1868        else
1869        {
1870#ifdef HAVE_PLURAL
1871          if (rIsPluralRing(r)) /* in the NC case nothing helps :-( */
1872          {
1873            int j=i;
1874            rc = p_Copy(p,r);
1875            while (j>1)
1876            {
1877              rc = p_Mult_q(p_Copy(p,r),rc,r);
1878              j--;
1879            }
1880            p_Delete(&p,r);
1881            return rc;
1882          }
1883#endif
1884          rc = pNext(p);
1885          if (rc == NULL)
1886            return p_MonPower(p,i,r);
1887          /* else: binom ?*/
1888          int char_p=rChar(r);
1889          if ((pNext(rc) != NULL)
1890#ifdef HAVE_RINGS
1891             || rField_is_Ring(r)
1892#endif
1893             )
1894            return p_Pow(p,i,r);
1895          if ((char_p==0) || (i<=char_p))
1896            return p_TwoMonPower(p,i,r);
1897          return p_Pow(p,i,r);
1898        }
1899      /*end default:*/
1900    }
1901  }
1902  return rc;
1903}
1904
1905/* --------------------------------------------------------------------------------*/
1906/* content suff                                                                   */
1907
1908static number p_InitContent(poly ph, const ring r);
1909
1910#define CLEARENUMERATORS 1
1911
1912void p_Content(poly ph, const ring r)
1913{
1914  assume( ph != NULL );
1915
1916  assume( r != NULL ); assume( r->cf != NULL ); 
1917
1918
1919#if CLEARENUMERATORS
1920  if( 0 )
1921  {
1922    const coeffs C = r->cf;
1923      // experimentall (recursive enumerator treatment) of alg. Ext!
1924    CPolyCoeffsEnumerator itr(ph);
1925    n_ClearContent(itr, r->cf);
1926
1927    p_Test(ph, r); n_Test(pGetCoeff(ph), C);
1928    assume(n_GreaterZero(pGetCoeff(ph), C)); // ??
1929
1930      // if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
1931    return;
1932  }
1933#endif
1934 
1935 
1936#ifdef HAVE_RINGS
1937  if (rField_is_Ring(r))
1938  {
1939    if (rField_has_Units(r))
1940    {
1941      number k = n_GetUnit(pGetCoeff(ph),r->cf);
1942      if (!n_IsOne(k,r->cf))
1943      {
1944        number tmpGMP = k;
1945        k = n_Invers(k,r->cf);
1946        n_Delete(&tmpGMP,r->cf);
1947        poly h = pNext(ph);
1948        p_SetCoeff(ph, n_Mult(pGetCoeff(ph), k,r->cf),r);
1949        while (h != NULL)
1950        {
1951          p_SetCoeff(h, n_Mult(pGetCoeff(h), k,r->cf),r);
1952          pIter(h);
1953        }
1954//        assume( n_GreaterZero(pGetCoeff(ph),r->cf) );
1955//        if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
1956      }
1957      n_Delete(&k,r->cf);
1958    }
1959    return;
1960  }
1961#endif
1962  number h,d;
1963  poly p;
1964
1965  if(TEST_OPT_CONTENTSB) return;
1966  if(pNext(ph)==NULL)
1967  {
1968    p_SetCoeff(ph,n_Init(1,r->cf),r);
1969  }
1970  else
1971  {
1972    assume( pNext(ph) != NULL );
1973#if CLEARENUMERATORS
1974    if( nCoeff_is_Q(r->cf) || nCoeff_is_Q_a(r->cf) )
1975    {
1976      // experimentall (recursive enumerator treatment) of alg. Ext!
1977      CPolyCoeffsEnumerator itr(ph);
1978      n_ClearContent(itr, r->cf);
1979
1980      p_Test(ph, r); n_Test(pGetCoeff(ph), r->cf);
1981      assume(n_GreaterZero(pGetCoeff(ph), r->cf)); // ??
1982     
1983      // if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
1984      return;
1985    }
1986#endif
1987   
1988    n_Normalize(pGetCoeff(ph),r->cf);
1989    if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
1990    if (rField_is_Q(r)) // should not be used anymore if CLEARENUMERATORS is 1
1991    {
1992      h=p_InitContent(ph,r);
1993      p=ph;
1994    }
1995    else
1996    {
1997      h=n_Copy(pGetCoeff(ph),r->cf);
1998      p = pNext(ph);
1999    }
2000    while (p!=NULL)
2001    {
2002      n_Normalize(pGetCoeff(p),r->cf);
2003      d=n_Gcd(h,pGetCoeff(p),r->cf);
2004      n_Delete(&h,r->cf);
2005      h = d;
2006      if(n_IsOne(h,r->cf))
2007      {
2008        break;
2009      }
2010      pIter(p);
2011    }
2012    p = ph;
2013    //number tmp;
2014    if(!n_IsOne(h,r->cf))
2015    {
2016      while (p!=NULL)
2017      {
2018        //d = nDiv(pGetCoeff(p),h);
2019        //tmp = nIntDiv(pGetCoeff(p),h);
2020        //if (!nEqual(d,tmp))
2021        //{
2022        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
2023        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
2024        //  nWrite(tmp);Print(StringEndS("\n"));
2025        //}
2026        //nDelete(&tmp);
2027        d = n_IntDiv(pGetCoeff(p),h,r->cf);
2028        p_SetCoeff(p,d,r);
2029        pIter(p);
2030      }
2031    }
2032    n_Delete(&h,r->cf);
2033#ifdef HAVE_FACTORY
2034//    if ( (n_GetChar(r) == 1) || (n_GetChar(r) < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
2035//    {
2036//      singclap_divide_content(ph, r);
2037//      if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2038//    }
2039#endif
2040    if (rField_is_Q_a(r)) 
2041    {
2042      // we only need special handling for alg. ext.
2043      if (getCoeffType(r->cf)==n_algExt)
2044      {
2045        number hzz = n_Init(1, r->cf->extRing->cf);
2046        p=ph;
2047        while (p!=NULL)
2048        { // each monom: coeff in Q_a
2049          poly c_n_n=(poly)pGetCoeff(p);
2050          poly c_n=c_n_n;
2051          while (c_n!=NULL)
2052          { // each monom: coeff in Q
2053            d=n_Lcm(hzz,pGetCoeff(c_n),r->cf->extRing->cf);
2054            n_Delete(&hzz,r->cf->extRing->cf);
2055            hzz=d;
2056            pIter(c_n);
2057          }
2058          pIter(p);
2059        }
2060        /* hzz contains the 1/lcm of all denominators in c_n_n*/
2061        h=n_Invers(hzz,r->cf->extRing->cf);
2062        n_Delete(&hzz,r->cf->extRing->cf);
2063        n_Normalize(h,r->cf->extRing->cf);
2064        if(!n_IsOne(h,r->cf->extRing->cf))
2065        {
2066          p=ph;
2067          while (p!=NULL)
2068          { // each monom: coeff in Q_a
2069            poly c_n=(poly)pGetCoeff(p);
2070            while (c_n!=NULL)
2071            { // each monom: coeff in Q
2072              d=n_Mult(h,pGetCoeff(c_n),r->cf->extRing->cf);
2073              n_Normalize(d,r->cf->extRing->cf);
2074              n_Delete(&pGetCoeff(c_n),r->cf->extRing->cf);
2075              pGetCoeff(c_n)=d;
2076              pIter(c_n);
2077            }
2078            pIter(p);
2079          }
2080        }
2081        n_Delete(&h,r->cf->extRing->cf);
2082      }
2083    }
2084  }
2085  if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2086}
2087
2088// Not yet?
2089#if 1 // currently only used by Singular/janet
2090void p_SimpleContent(poly ph, int smax, const ring r)
2091{
2092  if(TEST_OPT_CONTENTSB) return;
2093  if (ph==NULL) return;
2094  if (pNext(ph)==NULL)
2095  {
2096    p_SetCoeff(ph,n_Init(1,r->cf),r);
2097    return;
2098  }
2099  if ((pNext(pNext(ph))==NULL)||(!rField_is_Q(r)))
2100  {
2101    return;
2102  }
2103  number d=p_InitContent(ph,r);
2104  if (n_Size(d,r->cf)<=smax)
2105  {
2106    //if (TEST_OPT_PROT) PrintS("G");
2107    return;
2108  }
2109
2110
2111  poly p=ph;
2112  number h=d;
2113  if (smax==1) smax=2;
2114  while (p!=NULL)
2115  {
2116#if 0
2117    d=nlGcd(h,pGetCoeff(p),r->cf);
2118    nlDelete(&h,r->cf);
2119    h = d;
2120#else
2121    nlInpGcd(h,pGetCoeff(p),r->cf);
2122#endif
2123    if(nlSize(h,r->cf)<smax)
2124    {
2125      //if (TEST_OPT_PROT) PrintS("g");
2126      return;
2127    }
2128    pIter(p);
2129  }
2130  p = ph;
2131  if (!nlGreaterZero(pGetCoeff(p),r->cf)) h=nlNeg(h,r->cf);
2132  if(nlIsOne(h,r->cf)) return;
2133  //if (TEST_OPT_PROT) PrintS("c");
2134  while (p!=NULL)
2135  {
2136#if 1
2137    d = nlIntDiv(pGetCoeff(p),h,r->cf);
2138    p_SetCoeff(p,d,r);
2139#else
2140    nlInpIntDiv(pGetCoeff(p),h,r->cf);
2141#endif
2142    pIter(p);
2143  }
2144  nlDelete(&h,r->cf);
2145}
2146#endif
2147
2148static number p_InitContent(poly ph, const ring r)
2149// only for coefficients in Q
2150#if 0
2151{
2152  assume(!TEST_OPT_CONTENTSB);
2153  assume(ph!=NULL);
2154  assume(pNext(ph)!=NULL);
2155  assume(rField_is_Q(r));
2156  if (pNext(pNext(ph))==NULL)
2157  {
2158    return nlGetNom(pGetCoeff(pNext(ph)),r->cf);
2159  }
2160  poly p=ph;
2161  number n1=nlGetNom(pGetCoeff(p),r->cf);
2162  pIter(p);
2163  number n2=nlGetNom(pGetCoeff(p),r->cf);
2164  pIter(p);
2165  number d;
2166  number t;
2167  loop
2168  {
2169    nlNormalize(pGetCoeff(p),r->cf);
2170    t=nlGetNom(pGetCoeff(p),r->cf);
2171    if (nlGreaterZero(t,r->cf))
2172      d=nlAdd(n1,t,r->cf);
2173    else
2174      d=nlSub(n1,t,r->cf);
2175    nlDelete(&t,r->cf);
2176    nlDelete(&n1,r->cf);
2177    n1=d;
2178    pIter(p);
2179    if (p==NULL) break;
2180    nlNormalize(pGetCoeff(p),r->cf);
2181    t=nlGetNom(pGetCoeff(p),r->cf);
2182    if (nlGreaterZero(t,r->cf))
2183      d=nlAdd(n2,t,r->cf);
2184    else
2185      d=nlSub(n2,t,r->cf);
2186    nlDelete(&t,r->cf);
2187    nlDelete(&n2,r->cf);
2188    n2=d;
2189    pIter(p);
2190    if (p==NULL) break;
2191  }
2192  d=nlGcd(n1,n2,r->cf);
2193  nlDelete(&n1,r->cf);
2194  nlDelete(&n2,r->cf);
2195  return d;
2196}
2197#else
2198{
2199  number d=pGetCoeff(ph);
2200  if(SR_HDL(d)&SR_INT) return d;
2201  int s=mpz_size1(d->z);
2202  int s2=-1;
2203  number d2;
2204  loop
2205  {
2206    pIter(ph);
2207    if(ph==NULL)
2208    {
2209      if (s2==-1) return nlCopy(d,r->cf);
2210      break;
2211    }
2212    if (SR_HDL(pGetCoeff(ph))&SR_INT)
2213    {
2214      s2=s;
2215      d2=d;
2216      s=0;
2217      d=pGetCoeff(ph);
2218      if (s2==0) break;
2219    }
2220    else
2221    if (mpz_size1((pGetCoeff(ph)->z))<=s)
2222    {
2223      s2=s;
2224      d2=d;
2225      d=pGetCoeff(ph);
2226      s=mpz_size1(d->z);
2227    }
2228  }
2229  return nlGcd(d,d2,r->cf);
2230}
2231#endif
2232
2233//void pContent(poly ph)
2234//{
2235//  number h,d;
2236//  poly p;
2237//
2238//  p = ph;
2239//  if(pNext(p)==NULL)
2240//  {
2241//    pSetCoeff(p,nInit(1));
2242//  }
2243//  else
2244//  {
2245//#ifdef PDEBUG
2246//    if (!pTest(p)) return;
2247//#endif
2248//    nNormalize(pGetCoeff(p));
2249//    if(!nGreaterZero(pGetCoeff(ph)))
2250//    {
2251//      ph = pNeg(ph);
2252//      nNormalize(pGetCoeff(p));
2253//    }
2254//    h=pGetCoeff(p);
2255//    pIter(p);
2256//    while (p!=NULL)
2257//    {
2258//      nNormalize(pGetCoeff(p));
2259//      if (nGreater(h,pGetCoeff(p))) h=pGetCoeff(p);
2260//      pIter(p);
2261//    }
2262//    h=nCopy(h);
2263//    p=ph;
2264//    while (p!=NULL)
2265//    {
2266//      d=n_Gcd(h,pGetCoeff(p));
2267//      nDelete(&h);
2268//      h = d;
2269//      if(nIsOne(h))
2270//      {
2271//        break;
2272//      }
2273//      pIter(p);
2274//    }
2275//    p = ph;
2276//    //number tmp;
2277//    if(!nIsOne(h))
2278//    {
2279//      while (p!=NULL)
2280//      {
2281//        d = nIntDiv(pGetCoeff(p),h);
2282//        pSetCoeff(p,d);
2283//        pIter(p);
2284//      }
2285//    }
2286//    nDelete(&h);
2287//#ifdef HAVE_FACTORY
2288//    if ( (nGetChar() == 1) || (nGetChar() < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
2289//    {
2290//      pTest(ph);
2291//      singclap_divide_content(ph);
2292//      pTest(ph);
2293//    }
2294//#endif
2295//  }
2296//}
2297#if 0
2298void p_Content(poly ph, const ring r)
2299{
2300  number h,d;
2301  poly p;
2302
2303  if(pNext(ph)==NULL)
2304  {
2305    p_SetCoeff(ph,n_Init(1,r->cf),r);
2306  }
2307  else
2308  {
2309    n_Normalize(pGetCoeff(ph),r->cf);
2310    if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2311    h=n_Copy(pGetCoeff(ph),r->cf);
2312    p = pNext(ph);
2313    while (p!=NULL)
2314    {
2315      n_Normalize(pGetCoeff(p),r->cf);
2316      d=n_Gcd(h,pGetCoeff(p),r->cf);
2317      n_Delete(&h,r->cf);
2318      h = d;
2319      if(n_IsOne(h,r->cf))
2320      {
2321        break;
2322      }
2323      pIter(p);
2324    }
2325    p = ph;
2326    //number tmp;
2327    if(!n_IsOne(h,r->cf))
2328    {
2329      while (p!=NULL)
2330      {
2331        //d = nDiv(pGetCoeff(p),h);
2332        //tmp = nIntDiv(pGetCoeff(p),h);
2333        //if (!nEqual(d,tmp))
2334        //{
2335        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
2336        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
2337        //  nWrite(tmp);Print(StringEndS("\n"));
2338        //}
2339        //nDelete(&tmp);
2340        d = n_IntDiv(pGetCoeff(p),h,r->cf);
2341        p_SetCoeff(p,d,r->cf);
2342        pIter(p);
2343      }
2344    }
2345    n_Delete(&h,r->cf);
2346#ifdef HAVE_FACTORY
2347    //if ( (n_GetChar(r) == 1) || (n_GetChar(r) < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
2348    //{
2349    //  singclap_divide_content(ph);
2350    //  if(!n_GreaterZero(pGetCoeff(ph),r)) ph = p_Neg(ph,r);
2351    //}
2352#endif
2353  }
2354}
2355#endif
2356/* ---------------------------------------------------------------------------*/
2357/* cleardenom suff                                                           */
2358poly p_Cleardenom(poly ph, const ring r)
2359{
2360  if( ph == NULL )
2361    return NULL;
2362
2363  assume( r != NULL ); assume( r->cf != NULL ); const coeffs C = r->cf;
2364 
2365#if CLEARENUMERATORS
2366  if( 0 )
2367  {
2368    CPolyCoeffsEnumerator itr(ph);
2369
2370    n_ClearDenominators(itr, C);
2371
2372    n_ClearContent(itr, C); // divide out the content
2373
2374    p_Test(ph, r); n_Test(pGetCoeff(ph), C);
2375    assume(n_GreaterZero(pGetCoeff(ph), C)); // ??
2376//    if(!n_GreaterZero(pGetCoeff(ph),C)) ph = p_Neg(ph,r);
2377
2378    return ph;
2379  }
2380#endif
2381
2382  poly start=ph;
2383
2384  number d, h;
2385  poly p;
2386
2387#ifdef HAVE_RINGS
2388  if (rField_is_Ring(r))
2389  {
2390    p_Content(ph,r);
2391    assume( n_GreaterZero(pGetCoeff(ph),C) );
2392    if(!n_GreaterZero(pGetCoeff(ph),C)) ph = p_Neg(ph,r);
2393    return start;
2394  }
2395#endif
2396
2397  if (rField_is_Zp(r) && TEST_OPT_INTSTRATEGY)
2398  {
2399    assume( n_GreaterZero(pGetCoeff(ph),C) );
2400    if(!n_GreaterZero(pGetCoeff(ph),C)) ph = p_Neg(ph,r);
2401    return start;
2402  }
2403  p = ph;
2404
2405  assume(p != NULL);
2406 
2407  if(pNext(p)==NULL)
2408  {
2409    if (TEST_OPT_CONTENTSB)
2410    {
2411      number n=n_GetDenom(pGetCoeff(p),r->cf);
2412      if (!n_IsOne(n,r->cf))
2413      {
2414        number nn=n_Mult(pGetCoeff(p),n,r->cf);
2415        n_Normalize(nn,r->cf);
2416        p_SetCoeff(p,nn,r);
2417      }
2418      n_Delete(&n,r->cf);
2419    }
2420    else
2421      p_SetCoeff(p,n_Init(1,r->cf),r);
2422
2423    assume( n_GreaterZero(pGetCoeff(ph),C) );
2424    if(!n_GreaterZero(pGetCoeff(ph),C)) ph = p_Neg(ph,r);
2425   
2426    return start;
2427  }
2428
2429  assume(pNext(p)!=NULL);
2430
2431#if CLEARENUMERATORS
2432  if( nCoeff_is_Q(C) || nCoeff_is_Q_a(C) )
2433  {
2434    CPolyCoeffsEnumerator itr(ph);
2435
2436    n_ClearDenominators(itr, C);
2437
2438    n_ClearContent(itr, C); // divide out the content
2439
2440    p_Test(ph, r); n_Test(pGetCoeff(ph), C);
2441    assume(n_GreaterZero(pGetCoeff(ph), C)); // ??
2442//    if(!n_GreaterZero(pGetCoeff(ph),C)) ph = p_Neg(ph,r);
2443   
2444    return start;
2445  }
2446#endif
2447
2448  if(1)
2449  {
2450    h = n_Init(1,r->cf);
2451    while (p!=NULL)
2452    {
2453      n_Normalize(pGetCoeff(p),r->cf);
2454      d=n_Lcm(h,pGetCoeff(p),r->cf);
2455      n_Delete(&h,r->cf);
2456      h=d;
2457      pIter(p);
2458    }
2459    /* contains the 1/lcm of all denominators */
2460    if(!n_IsOne(h,r->cf))
2461    {
2462      p = ph;
2463      while (p!=NULL)
2464      {
2465        /* should be:
2466        * number hh;
2467        * nGetDenom(p->coef,&hh);
2468        * nMult(&h,&hh,&d);
2469        * nNormalize(d);
2470        * nDelete(&hh);
2471        * nMult(d,p->coef,&hh);
2472        * nDelete(&d);
2473        * nDelete(&(p->coef));
2474        * p->coef =hh;
2475        */
2476        d=n_Mult(h,pGetCoeff(p),r->cf);
2477        n_Normalize(d,r->cf);
2478        p_SetCoeff(p,d,r);
2479        pIter(p);
2480      }
2481      n_Delete(&h,r->cf);
2482      if (n_GetChar(r->cf)==1)
2483      {
2484        loop
2485        {
2486          h = n_Init(1,r->cf);
2487          p=ph;
2488          while (p!=NULL)
2489          {
2490            d=n_Lcm(h,pGetCoeff(p),r->cf);
2491            n_Delete(&h,r->cf);
2492            h=d;
2493            pIter(p);
2494          }
2495          /* contains the 1/lcm of all denominators */
2496          if(!n_IsOne(h,r->cf))
2497          {
2498            p = ph;
2499            while (p!=NULL)
2500            {
2501              /* should be:
2502              * number hh;
2503              * nGetDenom(p->coef,&hh);
2504              * nMult(&h,&hh,&d);
2505              * nNormalize(d);
2506              * nDelete(&hh);
2507              * nMult(d,p->coef,&hh);
2508              * nDelete(&d);
2509              * nDelete(&(p->coef));
2510              * p->coef =hh;
2511              */
2512              d=n_Mult(h,pGetCoeff(p),r->cf);
2513              n_Normalize(d,r->cf);
2514              p_SetCoeff(p,d,r);
2515              pIter(p);
2516            }
2517            n_Delete(&h,r->cf);
2518          }
2519          else
2520          {
2521            n_Delete(&h,r->cf);
2522            break;
2523          }
2524        }
2525      }
2526    }
2527    if (h!=NULL) n_Delete(&h,r->cf);
2528
2529    p_Content(ph,r);
2530#ifdef HAVE_RATGRING
2531    if (rIsRatGRing(r))
2532    {
2533      /* quick unit detection in the rational case is done in gr_nc_bba */
2534      pContentRat(ph);
2535      start=ph;
2536    }
2537#endif
2538  }
2539
2540  assume( n_GreaterZero(pGetCoeff(ph),C) );
2541  if(!n_GreaterZero(pGetCoeff(ph),C)) ph = p_Neg(ph,r);
2542 
2543  return start;
2544}
2545
2546void p_Cleardenom_n(poly ph,const ring r,number &c)
2547{
2548  const coeffs C = r->cf;
2549  number d, h;
2550
2551  assume( ph != NULL );
2552
2553  poly p = ph;
2554
2555#if CLEARENUMERATORS
2556  if( 0 )
2557  {
2558    CPolyCoeffsEnumerator itr(ph);
2559
2560    n_ClearDenominators(itr, d, C); // multiply with common denom. d
2561    n_ClearContent(itr, h, C); // divide by the content h
2562
2563    c = n_Div(d, h, C); // d/h
2564
2565    n_Delete(&d, C);
2566    n_Delete(&h, C);
2567
2568    n_Test(c, C);
2569
2570    p_Test(ph, r); n_Test(pGetCoeff(ph), C);
2571    assume(n_GreaterZero(pGetCoeff(ph), C)); // ??
2572/*
2573    if(!n_GreaterZero(pGetCoeff(ph),C))
2574    {
2575      ph = p_Neg(ph,r);
2576      c = n_Neg(c, C);
2577    }
2578*/
2579    return;
2580  }
2581#endif
2582 
2583 
2584  if( pNext(p) == NULL )
2585  {
2586    c=n_Invers(pGetCoeff(p), C);
2587    p_SetCoeff(p, n_Init(1, C), r);
2588
2589    assume( n_GreaterZero(pGetCoeff(ph),C) );
2590    if(!n_GreaterZero(pGetCoeff(ph),C))
2591    {
2592      ph = p_Neg(ph,r);
2593      c = n_Neg(c, C);
2594    }
2595   
2596    return;
2597  }
2598
2599  assume( pNext(p) != NULL );
2600 
2601#if CLEARENUMERATORS
2602  if( nCoeff_is_Q(C) || nCoeff_is_Q_a(C) )
2603  {
2604    CPolyCoeffsEnumerator itr(ph);
2605   
2606    n_ClearDenominators(itr, d, C); // multiply with common denom. d
2607    n_ClearContent(itr, h, C); // divide by the content h
2608
2609    c = n_Div(d, h, C); // d/h
2610
2611    n_Delete(&d, C);
2612    n_Delete(&h, C);
2613
2614    n_Test(c, C);
2615
2616    p_Test(ph, r); n_Test(pGetCoeff(ph), C);
2617    assume(n_GreaterZero(pGetCoeff(ph), C)); // ??
2618/*
2619    if(!n_GreaterZero(pGetCoeff(ph),C))
2620    {
2621      ph = p_Neg(ph,r);
2622      c = n_Neg(c, C);
2623    }
2624*/
2625    return;
2626  }
2627#endif
2628
2629 
2630 
2631
2632  if(1)
2633  {
2634    h = n_Init(1,r->cf);
2635    while (p!=NULL)
2636    {
2637      n_Normalize(pGetCoeff(p),r->cf);
2638      d=n_Lcm(h,pGetCoeff(p),r->cf);
2639      n_Delete(&h,r->cf);
2640      h=d;
2641      pIter(p);
2642    }
2643    c=h;
2644    /* contains the 1/lcm of all denominators */
2645    if(!n_IsOne(h,r->cf))
2646    {
2647      p = ph;
2648      while (p!=NULL)
2649      {
2650        /* should be:
2651        * number hh;
2652        * nGetDenom(p->coef,&hh);
2653        * nMult(&h,&hh,&d);
2654        * nNormalize(d);
2655        * nDelete(&hh);
2656        * nMult(d,p->coef,&hh);
2657        * nDelete(&d);
2658        * nDelete(&(p->coef));
2659        * p->coef =hh;
2660        */
2661        d=n_Mult(h,pGetCoeff(p),r->cf);
2662        n_Normalize(d,r->cf);
2663        p_SetCoeff(p,d,r);
2664        pIter(p);
2665      }
2666      if (rField_is_Q_a(r))
2667      {
2668        loop
2669        {
2670          h = n_Init(1,r->cf);
2671          p=ph;
2672          while (p!=NULL)
2673          {
2674            d=n_Lcm(h,pGetCoeff(p),r->cf);
2675            n_Delete(&h,r->cf);
2676            h=d;
2677            pIter(p);
2678          }
2679          /* contains the 1/lcm of all denominators */
2680          if(!n_IsOne(h,r->cf))
2681          {
2682            p = ph;
2683            while (p!=NULL)
2684            {
2685              /* should be:
2686              * number hh;
2687              * nGetDenom(p->coef,&hh);
2688              * nMult(&h,&hh,&d);
2689              * nNormalize(d);
2690              * nDelete(&hh);
2691              * nMult(d,p->coef,&hh);
2692              * nDelete(&d);
2693              * nDelete(&(p->coef));
2694              * p->coef =hh;
2695              */
2696              d=n_Mult(h,pGetCoeff(p),r->cf);
2697              n_Normalize(d,r->cf);
2698              p_SetCoeff(p,d,r);
2699              pIter(p);
2700            }
2701            number t=n_Mult(c,h,r->cf);
2702            n_Delete(&c,r->cf);
2703            c=t;
2704          }
2705          else
2706          {
2707            break;
2708          }
2709          n_Delete(&h,r->cf);
2710        }
2711      }
2712    }
2713  }
2714
2715  if(!n_GreaterZero(pGetCoeff(ph),C))
2716  {
2717    ph = p_Neg(ph,r);
2718    c = n_Neg(c, C);
2719  }
2720 
2721}
2722
2723number p_GetAllDenom(poly ph, const ring r)
2724{
2725  number d=n_Init(1,r->cf);
2726  poly p = ph;
2727
2728  while (p!=NULL)
2729  {
2730    number h=n_GetDenom(pGetCoeff(p),r->cf);
2731    if (!n_IsOne(h,r->cf))
2732    {
2733      number dd=n_Mult(d,h,r->cf);
2734      n_Delete(&d,r->cf);
2735      d=dd;
2736    }
2737    n_Delete(&h,r->cf);
2738    pIter(p);
2739  }
2740  return d;
2741}
2742
2743int p_Size(poly p, const ring r)
2744{
2745  int count = 0;
2746  while ( p != NULL )
2747  {
2748    count+= n_Size( pGetCoeff( p ), r->cf );
2749    pIter( p );
2750  }
2751  return count;
2752}
2753
2754/*2
2755*make p homogeneous by multiplying the monomials by powers of x_varnum
2756*assume: deg(var(varnum))==1
2757*/
2758poly p_Homogen (poly p, int varnum, const ring r)
2759{
2760  pFDegProc deg;
2761  if (r->pLexOrder && (r->order[0]==ringorder_lp))
2762    deg=p_Totaldegree;
2763  else
2764    deg=r->pFDeg;
2765
2766  poly q=NULL, qn;
2767  int  o,ii;
2768  sBucket_pt bp;
2769
2770  if (p!=NULL)
2771  {
2772    if ((varnum < 1) || (varnum > rVar(r)))
2773    {
2774      return NULL;
2775    }
2776    o=deg(p,r);
2777    q=pNext(p);
2778    while (q != NULL)
2779    {
2780      ii=deg(q,r);
2781      if (ii>o) o=ii;
2782      pIter(q);
2783    }
2784    q = p_Copy(p,r);
2785    bp = sBucketCreate(r);
2786    while (q != NULL)
2787    {
2788      ii = o-deg(q,r);
2789      if (ii!=0)
2790      {
2791        p_AddExp(q,varnum, (long)ii,r);
2792        p_Setm(q,r);
2793      }
2794      qn = pNext(q);
2795      pNext(q) = NULL;
2796      sBucket_Add_p(bp, q, 1);
2797      q = qn;
2798    }
2799    sBucketDestroyAdd(bp, &q, &ii);
2800  }
2801  return q;
2802}
2803
2804/*2
2805*tests if p is homogeneous with respect to the actual weigths
2806*/
2807BOOLEAN p_IsHomogeneous (poly p, const ring r)
2808{
2809  poly qp=p;
2810  int o;
2811
2812  if ((p == NULL) || (pNext(p) == NULL)) return TRUE;
2813  pFDegProc d;
2814  if (r->pLexOrder && (r->order[0]==ringorder_lp))
2815    d=p_Totaldegree;
2816  else
2817    d=r->pFDeg;
2818  o = d(p,r);
2819  do
2820  {
2821    if (d(qp,r) != o) return FALSE;
2822    pIter(qp);
2823  }
2824  while (qp != NULL);
2825  return TRUE;
2826}
2827
2828/*----------utilities for syzygies--------------*/
2829BOOLEAN   p_VectorHasUnitB(poly p, int * k, const ring r)
2830{
2831  poly q=p,qq;
2832  int i;
2833
2834  while (q!=NULL)
2835  {
2836    if (p_LmIsConstantComp(q,r))
2837    {
2838      i = p_GetComp(q,r);
2839      qq = p;
2840      while ((qq != q) && (p_GetComp(qq,r) != i)) pIter(qq);
2841      if (qq == q)
2842      {
2843        *k = i;
2844        return TRUE;
2845      }
2846      else
2847        pIter(q);
2848    }
2849    else pIter(q);
2850  }
2851  return FALSE;
2852}
2853
2854void   p_VectorHasUnit(poly p, int * k, int * len, const ring r)
2855{
2856  poly q=p,qq;
2857  int i,j=0;
2858
2859  *len = 0;
2860  while (q!=NULL)
2861  {
2862    if (p_LmIsConstantComp(q,r))
2863    {
2864      i = p_GetComp(q,r);
2865      qq = p;
2866      while ((qq != q) && (p_GetComp(qq,r) != i)) pIter(qq);
2867      if (qq == q)
2868      {
2869       j = 0;
2870       while (qq!=NULL)
2871       {
2872         if (p_GetComp(qq,r)==i) j++;
2873        pIter(qq);
2874       }
2875       if ((*len == 0) || (j<*len))
2876       {
2877         *len = j;
2878         *k = i;
2879       }
2880      }
2881    }
2882    pIter(q);
2883  }
2884}
2885
2886poly p_TakeOutComp1(poly * p, int k, const ring r)
2887{
2888  poly q = *p;
2889
2890  if (q==NULL) return NULL;
2891
2892  poly qq=NULL,result = NULL;
2893
2894  if (p_GetComp(q,r)==k)
2895  {
2896    result = q; /* *p */
2897    while ((q!=NULL) && (p_GetComp(q,r)==k))
2898    {
2899      p_SetComp(q,0,r);
2900      p_SetmComp(q,r);
2901      qq = q;
2902      pIter(q);
2903    }
2904    *p = q;
2905    pNext(qq) = NULL;
2906  }
2907  if (q==NULL) return result;
2908//  if (pGetComp(q) > k) pGetComp(q)--;
2909  while (pNext(q)!=NULL)
2910  {
2911    if (p_GetComp(pNext(q),r)==k)
2912    {
2913      if (result==NULL)
2914      {
2915        result = pNext(q);
2916        qq = result;
2917      }
2918      else
2919      {
2920        pNext(qq) = pNext(q);
2921        pIter(qq);
2922      }
2923      pNext(q) = pNext(pNext(q));
2924      pNext(qq) =NULL;
2925      p_SetComp(qq,0,r);
2926      p_SetmComp(qq,r);
2927    }
2928    else
2929    {
2930      pIter(q);
2931//      if (pGetComp(q) > k) pGetComp(q)--;
2932    }
2933  }
2934  return result;
2935}
2936
2937poly p_TakeOutComp(poly * p, int k, const ring r)
2938{
2939  poly q = *p,qq=NULL,result = NULL;
2940
2941  if (q==NULL) return NULL;
2942  BOOLEAN use_setmcomp=rOrd_SetCompRequiresSetm(r);
2943  if (p_GetComp(q,r)==k)
2944  {
2945    result = q;
2946    do
2947    {
2948      p_SetComp(q,0,r);
2949      if (use_setmcomp) p_SetmComp(q,r);
2950      qq = q;
2951      pIter(q);
2952    }
2953    while ((q!=NULL) && (p_GetComp(q,r)==k));
2954    *p = q;
2955    pNext(qq) = NULL;
2956  }
2957  if (q==NULL) return result;
2958  if (p_GetComp(q,r) > k)
2959  {
2960    p_SubComp(q,1,r);
2961    if (use_setmcomp) p_SetmComp(q,r);
2962  }
2963  poly pNext_q;
2964  while ((pNext_q=pNext(q))!=NULL)
2965  {
2966    if (p_GetComp(pNext_q,r)==k)
2967    {
2968      if (result==NULL)
2969      {
2970        result = pNext_q;
2971        qq = result;
2972      }
2973      else
2974      {
2975        pNext(qq) = pNext_q;
2976        pIter(qq);
2977      }
2978      pNext(q) = pNext(pNext_q);
2979      pNext(qq) =NULL;
2980      p_SetComp(qq,0,r);
2981      if (use_setmcomp) p_SetmComp(qq,r);
2982    }
2983    else
2984    {
2985      /*pIter(q);*/ q=pNext_q;
2986      if (p_GetComp(q,r) > k)
2987      {
2988        p_SubComp(q,1,r);
2989        if (use_setmcomp) p_SetmComp(q,r);
2990      }
2991    }
2992  }
2993  return result;
2994}
2995
2996// Splits *p into two polys: *q which consists of all monoms with
2997// component == comp and *p of all other monoms *lq == pLength(*q)
2998void p_TakeOutComp(poly *r_p, long comp, poly *r_q, int *lq, const ring r)
2999{
3000  spolyrec pp, qq;
3001  poly p, q, p_prev;
3002  int l = 0;
3003
3004#ifdef HAVE_ASSUME
3005  int lp = pLength(*r_p);
3006#endif
3007
3008  pNext(&pp) = *r_p;
3009  p = *r_p;
3010  p_prev = &pp;
3011  q = &qq;
3012
3013  while(p != NULL)
3014  {
3015    while (p_GetComp(p,r) == comp)
3016    {
3017      pNext(q) = p;
3018      pIter(q);
3019      p_SetComp(p, 0,r);
3020      p_SetmComp(p,r);
3021      pIter(p);
3022      l++;
3023      if (p == NULL)
3024      {
3025        pNext(p_prev) = NULL;
3026        goto Finish;
3027      }
3028    }
3029    pNext(p_prev) = p;
3030    p_prev = p;
3031    pIter(p);
3032  }
3033
3034  Finish:
3035  pNext(q) = NULL;
3036  *r_p = pNext(&pp);
3037  *r_q = pNext(&qq);
3038  *lq = l;
3039#ifdef HAVE_ASSUME
3040  assume(pLength(*r_p) + pLength(*r_q) == lp);
3041#endif
3042  p_Test(*r_p,r);
3043  p_Test(*r_q,r);
3044}
3045
3046void p_DeleteComp(poly * p,int k, const ring r)
3047{
3048  poly q;
3049
3050  while ((*p!=NULL) && (p_GetComp(*p,r)==k)) p_LmDelete(p,r);
3051  if (*p==NULL) return;
3052  q = *p;
3053  if (p_GetComp(q,r)>k)
3054  {
3055    p_SubComp(q,1,r);
3056    p_SetmComp(q,r);
3057  }
3058  while (pNext(q)!=NULL)
3059  {
3060    if (p_GetComp(pNext(q),r)==k)
3061      p_LmDelete(&(pNext(q)),r);
3062    else
3063    {
3064      pIter(q);
3065      if (p_GetComp(q,r)>k)
3066      {
3067        p_SubComp(q,1,r);
3068        p_SetmComp(q,r);
3069      }
3070    }
3071  }
3072}
3073
3074/*2
3075* convert a vector to a set of polys,
3076* allocates the polyset, (entries 0..(*len)-1)
3077* the vector will not be changed
3078*/
3079void  p_Vec2Polys(poly v, poly* *p, int *len, const ring r)
3080{
3081  poly h;
3082  int k;
3083
3084  *len=p_MaxComp(v,r);
3085  if (*len==0) *len=1;
3086  *p=(poly*)omAlloc0((*len)*sizeof(poly));
3087  while (v!=NULL)
3088  {
3089    h=p_Head(v,r);
3090    k=p_GetComp(h,r);
3091    p_SetComp(h,0,r);
3092    (*p)[k-1]=p_Add_q((*p)[k-1],h,r);
3093    pIter(v);
3094  }
3095}
3096
3097//
3098// resets the pFDeg and pLDeg: if pLDeg is not given, it is
3099// set to currRing->pLDegOrig, i.e. to the respective LDegProc which
3100// only uses pFDeg (and not p_Deg, or pTotalDegree, etc)
3101void pSetDegProcs(ring r, pFDegProc new_FDeg, pLDegProc new_lDeg)
3102{
3103  assume(new_FDeg != NULL);
3104  r->pFDeg = new_FDeg;
3105
3106  if (new_lDeg == NULL)
3107    new_lDeg = r->pLDegOrig;
3108
3109  r->pLDeg = new_lDeg;
3110}
3111
3112// restores pFDeg and pLDeg:
3113void pRestoreDegProcs(ring r, pFDegProc old_FDeg, pLDegProc old_lDeg)
3114{
3115  assume(old_FDeg != NULL && old_lDeg != NULL);
3116  r->pFDeg = old_FDeg;
3117  r->pLDeg = old_lDeg;
3118}
3119
3120/*-------- several access procedures to monomials -------------------- */
3121/*
3122* the module weights for std
3123*/
3124static pFDegProc pOldFDeg;
3125static pLDegProc pOldLDeg;
3126static BOOLEAN pOldLexOrder;
3127
3128static long pModDeg(poly p, ring r)
3129{
3130  long d=pOldFDeg(p, r);
3131  int c=p_GetComp(p, r);
3132  if ((c>0) && ((r->pModW)->range(c-1))) d+= (*(r->pModW))[c-1];
3133  return d;
3134  //return pOldFDeg(p, r)+(*pModW)[p_GetComp(p, r)-1];
3135}
3136
3137void p_SetModDeg(intvec *w, ring r)
3138{
3139  if (w!=NULL)
3140  {
3141    r->pModW = w;
3142    pOldFDeg = r->pFDeg;
3143    pOldLDeg = r->pLDeg;
3144    pOldLexOrder = r->pLexOrder;
3145    pSetDegProcs(r,pModDeg);
3146    r->pLexOrder = TRUE;
3147  }
3148  else
3149  {
3150    r->pModW = NULL;
3151    pRestoreDegProcs(r,pOldFDeg, pOldLDeg);
3152    r->pLexOrder = pOldLexOrder;
3153  }
3154}
3155
3156/*2
3157* handle memory request for sets of polynomials (ideals)
3158* l is the length of *p, increment is the difference (may be negative)
3159*/
3160void pEnlargeSet(poly* *p, int l, int increment)
3161{
3162  poly* h;
3163
3164  h=(poly*)omReallocSize((poly*)*p,l*sizeof(poly),(l+increment)*sizeof(poly));
3165  if (increment>0)
3166  {
3167    //for (i=l; i<l+increment; i++)
3168    //  h[i]=NULL;
3169    memset(&(h[l]),0,increment*sizeof(poly));
3170  }
3171  *p=h;
3172}
3173
3174/*2
3175*divides p1 by its leading coefficient
3176*/
3177void p_Norm(poly p1, const ring r)
3178{
3179#ifdef HAVE_RINGS
3180  if (rField_is_Ring(r))
3181  {
3182    if (!n_IsUnit(pGetCoeff(p1), r->cf)) return;
3183    // Werror("p_Norm not possible in the case of coefficient rings.");
3184  }
3185  else
3186#endif
3187  if (p1!=NULL)
3188  {
3189    if (pNext(p1)==NULL)
3190    {
3191      p_SetCoeff(p1,n_Init(1,r->cf),r);
3192      return;
3193    }
3194    poly h;
3195    if (!n_IsOne(pGetCoeff(p1),r->cf))
3196    {
3197      number k, c;
3198      n_Normalize(pGetCoeff(p1),r->cf);
3199      k = pGetCoeff(p1);
3200      c = n_Init(1,r->cf);
3201      pSetCoeff0(p1,c);
3202      h = pNext(p1);
3203      while (h!=NULL)
3204      {
3205        c=n_Div(pGetCoeff(h),k,r->cf);
3206        // no need to normalize: Z/p, R
3207        // normalize already in nDiv: Q_a, Z/p_a
3208        // remains: Q
3209        if (rField_is_Q(r) && (!n_IsOne(c,r->cf))) n_Normalize(c,r->cf);
3210        p_SetCoeff(h,c,r);
3211        pIter(h);
3212      }
3213      n_Delete(&k,r->cf);
3214    }
3215    else
3216    {
3217      //if (r->cf->cfNormalize != nDummy2) //TODO: OPTIMIZE
3218      {
3219        h = pNext(p1);
3220        while (h!=NULL)
3221        {
3222          n_Normalize(pGetCoeff(h),r->cf);
3223          pIter(h);
3224        }
3225      }
3226    }
3227  }
3228}
3229
3230/*2
3231*normalize all coefficients
3232*/
3233void p_Normalize(poly p,const ring r)
3234{
3235  if (rField_has_simple_inverse(r)) return; /* Z/p, GF(p,n), R, long R/C */
3236  while (p!=NULL)
3237  {
3238#ifdef LDEBUG
3239    n_Test(pGetCoeff(p), r->cf);
3240#endif
3241    n_Normalize(pGetCoeff(p),r->cf);
3242    pIter(p);
3243  }
3244}
3245
3246// splits p into polys with Exp(n) == 0 and Exp(n) != 0
3247// Poly with Exp(n) != 0 is reversed
3248static void p_SplitAndReversePoly(poly p, int n, poly *non_zero, poly *zero, const ring r)
3249{
3250  if (p == NULL)
3251  {
3252    *non_zero = NULL;
3253    *zero = NULL;
3254    return;
3255  }
3256  spolyrec sz;
3257  poly z, n_z, next;
3258  z = &sz;
3259  n_z = NULL;
3260
3261  while(p != NULL)
3262  {
3263    next = pNext(p);
3264    if (p_GetExp(p, n,r) == 0)
3265    {
3266      pNext(z) = p;
3267      pIter(z);
3268    }
3269    else
3270    {
3271      pNext(p) = n_z;
3272      n_z = p;
3273    }
3274    p = next;
3275  }
3276  pNext(z) = NULL;
3277  *zero = pNext(&sz);
3278  *non_zero = n_z;
3279}
3280/*3
3281* substitute the n-th variable by 1 in p
3282* destroy p
3283*/
3284static poly p_Subst1 (poly p,int n, const ring r)
3285{
3286  poly qq=NULL, result = NULL;
3287  poly zero=NULL, non_zero=NULL;
3288
3289  // reverse, so that add is likely to be linear
3290  p_SplitAndReversePoly(p, n, &non_zero, &zero,r);
3291
3292  while (non_zero != NULL)
3293  {
3294    assume(p_GetExp(non_zero, n,r) != 0);
3295    qq = non_zero;
3296    pIter(non_zero);
3297    qq->next = NULL;
3298    p_SetExp(qq,n,0,r);
3299    p_Setm(qq,r);
3300    result = p_Add_q(result,qq,r);
3301  }
3302  p = p_Add_q(result, zero,r);
3303  p_Test(p,r);
3304  return p;
3305}
3306
3307/*3
3308* substitute the n-th variable by number e in p
3309* destroy p
3310*/
3311static poly p_Subst2 (poly p,int n, number e, const ring r)
3312{
3313  assume( ! n_IsZero(e,r->cf) );
3314  poly qq,result = NULL;
3315  number nn, nm;
3316  poly zero, non_zero;
3317
3318  // reverse, so that add is likely to be linear
3319  p_SplitAndReversePoly(p, n, &non_zero, &zero,r);
3320
3321  while (non_zero != NULL)
3322  {
3323    assume(p_GetExp(non_zero, n, r) != 0);
3324    qq = non_zero;
3325    pIter(non_zero);
3326    qq->next = NULL;
3327    n_Power(e, p_GetExp(qq, n, r), &nn,r->cf);
3328    nm = n_Mult(nn, pGetCoeff(qq),r->cf);
3329#ifdef HAVE_RINGS
3330    if (n_IsZero(nm,r->cf))
3331    {
3332      p_LmFree(&qq,r);
3333      n_Delete(&nm,r->cf);
3334    }
3335    else
3336#endif
3337    {
3338      p_SetCoeff(qq, nm,r);
3339      p_SetExp(qq, n, 0,r);
3340      p_Setm(qq,r);
3341      result = p_Add_q(result,qq,r);
3342    }
3343    n_Delete(&nn,r->cf);
3344  }
3345  p = p_Add_q(result, zero,r);
3346  p_Test(p,r);
3347  return p;
3348}
3349
3350
3351/* delete monoms whose n-th exponent is different from zero */
3352static poly p_Subst0(poly p, int n, const ring r)
3353{
3354  spolyrec res;
3355  poly h = &res;
3356  pNext(h) = p;
3357
3358  while (pNext(h)!=NULL)
3359  {
3360    if (p_GetExp(pNext(h),n,r)!=0)
3361    {
3362      p_LmDelete(&pNext(h),r);
3363    }
3364    else
3365    {
3366      pIter(h);
3367    }
3368  }
3369  p_Test(pNext(&res),r);
3370  return pNext(&res);
3371}
3372
3373/*2
3374* substitute the n-th variable by e in p
3375* destroy p
3376*/
3377poly p_Subst(poly p, int n, poly e, const ring r)
3378{
3379  if (e == NULL) return p_Subst0(p, n,r);
3380
3381  if (p_IsConstant(e,r))
3382  {
3383    if (n_IsOne(pGetCoeff(e),r->cf)) return p_Subst1(p,n,r);
3384    else return p_Subst2(p, n, pGetCoeff(e),r);
3385  }
3386
3387#ifdef HAVE_PLURAL
3388  if (rIsPluralRing(r))
3389  {
3390    return nc_pSubst(p,n,e,r);
3391  }
3392#endif
3393
3394  int exponent,i;
3395  poly h, res, m;
3396  int *me,*ee;
3397  number nu,nu1;
3398
3399  me=(int *)omAlloc((rVar(r)+1)*sizeof(int));
3400  ee=(int *)omAlloc((rVar(r)+1)*sizeof(int));
3401  if (e!=NULL) p_GetExpV(e,ee,r);
3402  res=NULL;
3403  h=p;
3404  while (h!=NULL)
3405  {
3406    if ((e!=NULL) || (p_GetExp(h,n,r)==0))
3407    {
3408      m=p_Head(h,r);
3409      p_GetExpV(m,me,r);
3410      exponent=me[n];
3411      me[n]=0;
3412      for(i=rVar(r);i>0;i--)
3413        me[i]+=exponent*ee[i];
3414      p_SetExpV(m,me,r);
3415      if (e!=NULL)
3416      {
3417        n_Power(pGetCoeff(e),exponent,&nu,r->cf);
3418        nu1=n_Mult(pGetCoeff(m),nu,r->cf);
3419        n_Delete(&nu,r->cf);
3420        p_SetCoeff(m,nu1,r);
3421      }
3422      res=p_Add_q(res,m,r);
3423    }
3424    p_LmDelete(&h,r);
3425  }
3426  omFreeSize((ADDRESS)me,(rVar(r)+1)*sizeof(int));
3427  omFreeSize((ADDRESS)ee,(rVar(r)+1)*sizeof(int));
3428  return res;
3429}
3430
3431/*2
3432 * returns a re-ordered convertion of a number as a polynomial,
3433 * with permutation of parameters
3434 * NOTE: this only works for Frank's alg. & trans. fields
3435 */
3436poly n_PermNumber(const number z, const int *par_perm, const int , const ring src, const ring dst)
3437{
3438#if 0
3439  PrintS("\nSource Ring: \n");
3440  rWrite(src);
3441
3442  if(0)
3443  {
3444    number zz = n_Copy(z, src->cf);
3445    PrintS("z: "); n_Write(zz, src);
3446    n_Delete(&zz, src->cf);
3447  }
3448
3449  PrintS("\nDestination Ring: \n");
3450  rWrite(dst);
3451
3452  Print("\nOldPar: %d\n", OldPar);
3453  for( int i = 1; i <= OldPar; i++ )
3454  {
3455    Print("par(%d) -> par/var (%d)\n", i, par_perm[i-1]);
3456  }
3457#endif
3458  if( z == NULL )
3459     return NULL;
3460
3461  const coeffs srcCf = src->cf;
3462  assume( srcCf != NULL );
3463
3464  assume( !nCoeff_is_GF(srcCf) );
3465  assume( rField_is_Extension(src) );
3466
3467  poly zz = NULL;
3468
3469  const ring srcExtRing = srcCf->extRing;
3470  assume( srcExtRing != NULL );
3471
3472  const coeffs dstCf = dst->cf;
3473  assume( dstCf != NULL );
3474
3475  if( nCoeff_is_algExt(srcCf) ) // nCoeff_is_GF(srcCf)?
3476  {
3477    zz = (poly) z;
3478
3479    if( zz == NULL )
3480       return NULL;
3481
3482  } else if (nCoeff_is_transExt(srcCf))
3483  {
3484    assume( !IS0(z) );
3485
3486    zz = NUM(z);
3487    p_Test (zz, srcExtRing);
3488
3489    if( zz == NULL )
3490       return NULL;
3491
3492    //if( !DENIS1(z) )
3493      //WarnS("Not implemented yet: Cannot permute a rational fraction and make a polynomial out of it! Ignorring the denumerator.");
3494  } else
3495     {
3496        assume (FALSE);
3497        Werror("Number permutation is not implemented for this data yet!");
3498        return NULL;
3499     }
3500
3501  assume( zz != NULL );
3502  p_Test (zz, srcExtRing);
3503
3504
3505  nMapFunc nMap = n_SetMap(srcExtRing->cf, dstCf);
3506
3507  assume( nMap != NULL );
3508
3509  poly qq = p_PermPoly(zz, par_perm - 1, srcExtRing, dst, nMap, NULL, rVar(srcExtRing) );
3510//       poly p_PermPoly (poly p, int * perm, const ring oldRing, const ring dst, nMapFunc nMap, int *par_perm, int OldPar)
3511
3512//  assume( FALSE );  WarnS("longalg missing 2");
3513
3514  return qq;
3515}
3516
3517
3518/*2
3519*returns a re-ordered copy of a polynomial, with permutation of the variables
3520*/
3521poly p_PermPoly (poly p, const int * perm, const ring oldRing, const ring dst,
3522       nMapFunc nMap, const int *par_perm, int OldPar)
3523{
3524#if 0
3525    p_Test(p, oldRing);
3526    PrintS("\np_PermPoly::p: "); p_Write(p, oldRing, oldRing); PrintLn();
3527#endif
3528
3529  const int OldpVariables = rVar(oldRing);
3530  poly result = NULL;
3531  poly result_last = NULL;
3532  poly aq = NULL; /* the map coefficient */
3533  poly qq; /* the mapped monomial */
3534
3535  assume(dst != NULL);
3536  assume(dst->cf != NULL);
3537 
3538  while (p != NULL)
3539  {
3540    // map the coefficient
3541    if ( ((OldPar == 0) || (par_perm == NULL) || rField_is_GF(oldRing)) && (nMap != NULL) )
3542    {
3543      qq = p_Init(dst);
3544      assume( nMap != NULL );
3545      number n = nMap(p_GetCoeff(p, oldRing), oldRing->cf, dst->cf);
3546
3547      if ( nCoeff_is_algExt(dst->cf) )
3548        n_Normalize(n, dst->cf);
3549
3550      p_GetCoeff(qq, dst) = n;// Note: n can be a ZERO!!!
3551      // coef may be zero: 
3552//      p_Test(qq, dst);
3553    }
3554    else
3555    {
3556      qq = p_One(dst);
3557
3558//      aq = naPermNumber(p_GetCoeff(p, oldRing), par_perm, OldPar, oldRing); // no dst???
3559//      poly    n_PermNumber(const number z, const int *par_perm, const int P, const ring src, const ring dst)
3560      aq = n_PermNumber(p_GetCoeff(p, oldRing), par_perm, OldPar, oldRing, dst);
3561
3562      p_Test(aq, dst);
3563
3564      if ( nCoeff_is_algExt(dst->cf) )
3565        p_Normalize(aq,dst);
3566     
3567      if (aq == NULL)
3568        p_SetCoeff(qq, n_Init(0, dst->cf),dst); // Very dirty trick!!!
3569
3570      p_Test(aq, dst);
3571    }
3572
3573    if (rRing_has_Comp(dst))
3574       p_SetComp(qq, p_GetComp(p, oldRing), dst);
3575
3576    if ( n_IsZero(pGetCoeff(qq), dst->cf) )
3577    {
3578      p_LmDelete(&qq,dst);
3579      qq = NULL;
3580    }
3581    else
3582    {
3583      // map pars:
3584      int mapped_to_par = 0;
3585      for(int i = 1; i <= OldpVariables; i++)
3586      {
3587        int e = p_GetExp(p, i, oldRing);
3588        if (e != 0)
3589        {
3590          if (perm==NULL)
3591            p_SetExp(qq, i, e, dst);
3592          else if (perm[i]>0)
3593            p_AddExp(qq,perm[i], e/*p_GetExp( p,i,oldRing)*/, dst);
3594          else if (perm[i]<0)
3595          {
3596            number c = p_GetCoeff(qq, dst);
3597            if (rField_is_GF(dst))
3598            {
3599              assume( dst->cf->extRing == NULL );
3600              number ee = n_Param(1, dst);
3601
3602              number eee;
3603              n_Power(ee, e, &eee, dst->cf); //nfDelete(ee,dst);
3604
3605              ee = n_Mult(c, eee, dst->cf);
3606              //nfDelete(c,dst);nfDelete(eee,dst);
3607              pSetCoeff0(qq,ee);
3608            }
3609            else if (nCoeff_is_Extension(dst->cf))
3610            {
3611              const int par = -perm[i];
3612              assume( par > 0 );
3613
3614//              WarnS("longalg missing 3");
3615#if 1
3616              const coeffs C = dst->cf;
3617              assume( C != NULL );
3618
3619              const ring R = C->extRing;
3620              assume( R != NULL );
3621
3622              assume( par <= rVar(R) );
3623
3624              poly pcn; // = (number)c
3625
3626              assume( !n_IsZero(c, C) );
3627
3628              if( nCoeff_is_algExt(C) )
3629                 pcn = (poly) c;
3630               else //            nCoeff_is_transExt(C)
3631                 pcn = NUM(c);
3632
3633              if (pNext(pcn) == NULL) // c->z
3634                p_AddExp(pcn, -perm[i], e, R);
3635              else /* more difficult: we have really to multiply: */
3636              {
3637                poly mmc = p_ISet(1, R);
3638                p_SetExp(mmc, -perm[i], e, R);
3639                p_Setm(mmc, R);
3640
3641                number nnc;
3642                // convert back to a number: number nnc = mmc;
3643                if( nCoeff_is_algExt(C) )
3644                   nnc = (number) mmc;
3645                else //            nCoeff_is_transExt(C)
3646                  nnc = ntInit(mmc, C);
3647
3648                p_GetCoeff(qq, dst) = n_Mult((number)c, nnc, C);
3649                n_Delete((number *)&c, C);
3650                n_Delete((number *)&nnc, C);
3651              }
3652
3653              mapped_to_par=1;
3654#endif
3655            }
3656          }
3657          else
3658          {
3659            /* this variable maps to 0 !*/
3660            p_LmDelete(&qq, dst);
3661            break;
3662          }
3663        }
3664      }
3665      if ( mapped_to_par && nCoeff_is_algExt(dst->cf) )
3666      {
3667        number n = p_GetCoeff(qq, dst);
3668        n_Normalize(n, dst->cf);
3669        p_GetCoeff(qq, dst) = n;
3670      }
3671    }
3672    pIter(p);
3673
3674#if 0
3675    p_Test(aq,dst);
3676    PrintS("\naq: "); p_Write(aq, dst, dst); PrintLn();
3677#endif
3678
3679
3680#if 1
3681    if (qq!=NULL)
3682    {
3683      p_Setm(qq,dst);
3684
3685      p_Test(aq,dst);
3686      p_Test(qq,dst);
3687
3688#if 0
3689    p_Test(qq,dst);
3690    PrintS("\nqq: "); p_Write(qq, dst, dst); PrintLn();
3691#endif
3692
3693      if (aq!=NULL)
3694         qq=p_Mult_q(aq,qq,dst);
3695
3696      aq = qq;
3697
3698      while (pNext(aq) != NULL) pIter(aq);
3699
3700      if (result_last==NULL)
3701      {
3702        result=qq;
3703      }
3704      else
3705      {
3706        pNext(result_last)=qq;
3707      }
3708      result_last=aq;
3709      aq = NULL;
3710    }
3711    else if (aq!=NULL)
3712    {
3713      p_Delete(&aq,dst);
3714    }
3715  }
3716
3717  result=p_SortAdd(result,dst);
3718#else
3719  //  if (qq!=NULL)
3720  //  {
3721  //    pSetm(qq);
3722  //    pTest(qq);
3723  //    pTest(aq);
3724  //    if (aq!=NULL) qq=pMult(aq,qq);
3725  //    aq = qq;
3726  //    while (pNext(aq) != NULL) pIter(aq);
3727  //    pNext(aq) = result;
3728  //    aq = NULL;
3729  //    result = qq;
3730  //  }
3731  //  else if (aq!=NULL)
3732  //  {
3733  //    pDelete(&aq);
3734  //  }
3735  //}
3736  //p = result;
3737  //result = NULL;
3738  //while (p != NULL)
3739  //{
3740  //  qq = p;
3741  //  pIter(p);
3742  //  qq->next = NULL;
3743  //  result = pAdd(result, qq);
3744  //}
3745#endif
3746  p_Test(result,dst);
3747
3748#if 0
3749  p_Test(result,dst);
3750  PrintS("\nresult: "); p_Write(result,dst,dst); PrintLn();
3751#endif
3752  return result;
3753}
3754/**************************************************************
3755 *
3756 * Jet
3757 *
3758 **************************************************************/
3759
3760poly pp_Jet(poly p, int m, const ring R)
3761{
3762  poly r=NULL;
3763  poly t=NULL;
3764
3765  while (p!=NULL)
3766  {
3767    if (p_Totaldegree(p,R)<=m)
3768    {
3769      if (r==NULL)
3770        r=p_Head(p,R);
3771      else
3772      if (t==NULL)
3773      {
3774        pNext(r)=p_Head(p,R);
3775        t=pNext(r);
3776      }
3777      else
3778      {
3779        pNext(t)=p_Head(p,R);
3780        pIter(t);
3781      }
3782    }
3783    pIter(p);
3784  }
3785  return r;
3786}
3787
3788poly p_Jet(poly p, int m,const ring R)
3789{
3790  while((p!=NULL) && (p_Totaldegree(p,R)>m)) p_LmDelete(&p,R);
3791  if (p==NULL) return NULL;
3792  poly r=p;
3793  while (pNext(p)!=NULL)
3794  {
3795    if (p_Totaldegree(pNext(p),R)>m)
3796    {
3797      p_LmDelete(&pNext(p),R);
3798    }
3799    else
3800      pIter(p);
3801  }
3802  return r;
3803}
3804
3805poly pp_JetW(poly p, int m, short *w, const ring R)
3806{
3807  poly r=NULL;
3808  poly t=NULL;
3809  while (p!=NULL)
3810  {
3811    if (totaldegreeWecart_IV(p,R,w)<=m)
3812    {
3813      if (r==NULL)
3814        r=p_Head(p,R);
3815      else
3816      if (t==NULL)
3817      {
3818        pNext(r)=p_Head(p,R);
3819        t=pNext(r);
3820      }
3821      else
3822      {
3823        pNext(t)=p_Head(p,R);
3824        pIter(t);
3825      }
3826    }
3827    pIter(p);
3828  }
3829  return r;
3830}
3831
3832poly p_JetW(poly p, int m, short *w, const ring R)
3833{
3834  while((p!=NULL) && (totaldegreeWecart_IV(p,R,w)>m)) p_LmDelete(&p,R);
3835  if (p==NULL) return NULL;
3836  poly r=p;
3837  while (pNext(p)!=NULL)
3838  {
3839    if (totaldegreeWecart_IV(pNext(p),R,w)>m)
3840    {
3841      p_LmDelete(&pNext(p),R);
3842    }
3843    else
3844      pIter(p);
3845  }
3846  return r;
3847}
3848
3849/*************************************************************/
3850int p_MinDeg(poly p,intvec *w, const ring R)
3851{
3852  if(p==NULL)
3853    return -1;
3854  int d=-1;
3855  while(p!=NULL)
3856  {
3857    int d0=0;
3858    for(int j=0;j<rVar(R);j++)
3859      if(w==NULL||j>=w->length())
3860        d0+=p_GetExp(p,j+1,R);
3861      else
3862        d0+=(*w)[j]*p_GetExp(p,j+1,R);
3863    if(d0<d||d==-1)
3864      d=d0;
3865    pIter(p);
3866  }
3867  return d;
3868}
3869
3870/***************************************************************/
3871
3872poly p_Series(int n,poly p,poly u, intvec *w, const ring R)
3873{
3874  short *ww=iv2array(w,R);
3875  if(p!=NULL)
3876  {
3877    if(u==NULL)
3878      p=p_JetW(p,n,ww,R);
3879    else
3880      p=p_JetW(p_Mult_q(p,p_Invers(n-p_MinDeg(p,w,R),u,w,R),R),n,ww,R);
3881  }
3882  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
3883  return p;
3884}
3885
3886poly p_Invers(int n,poly u,intvec *w, const ring R)
3887{
3888  if(n<0)
3889    return NULL;
3890  number u0=n_Invers(pGetCoeff(u),R->cf);
3891  poly v=p_NSet(u0,R);
3892  if(n==0)
3893    return v;
3894  short *ww=iv2array(w,R);
3895  poly u1=p_JetW(p_Sub(p_One(R),p_Mult_nn(u,u0,R),R),n,ww,R);
3896  if(u1==NULL)
3897  {
3898    omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
3899    return v;
3900  }
3901  poly v1=p_Mult_nn(p_Copy(u1,R),u0,R);
3902  v=p_Add_q(v,p_Copy(v1,R),R);
3903  for(int i=n/p_MinDeg(u1,w,R);i>1;i--)
3904  {
3905    v1=p_JetW(p_Mult_q(v1,p_Copy(u1,R),R),n,ww,R);
3906    v=p_Add_q(v,p_Copy(v1,R),R);
3907  }
3908  p_Delete(&u1,R);
3909  p_Delete(&v1,R);
3910  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
3911  return v;
3912}
3913
3914BOOLEAN p_EqualPolys(poly p1,poly p2, const ring r)
3915{
3916  while ((p1 != NULL) && (p2 != NULL))
3917  {
3918    if (! p_LmEqual(p1, p2,r))
3919      return FALSE;
3920    if (! n_Equal(p_GetCoeff(p1,r), p_GetCoeff(p2,r),r->cf ))
3921      return FALSE;
3922    pIter(p1);
3923    pIter(p2);
3924  }
3925  return (p1==p2);
3926}
3927
3928static inline BOOLEAN p_ExpVectorEqual(poly p1, poly p2, const ring r1, const ring r2)
3929{
3930  assume( r1 == r2 || rSamePolyRep(r1, r2) );
3931
3932  p_LmCheckPolyRing1(p1, r1);
3933  p_LmCheckPolyRing1(p2, r2);
3934
3935  int i = r1->ExpL_Size;
3936
3937  assume( r1->ExpL_Size == r2->ExpL_Size );
3938
3939  unsigned long *ep = p1->exp;
3940  unsigned long *eq = p2->exp;
3941
3942  do
3943  {
3944    i--;
3945    if (ep[i] != eq[i]) return FALSE;
3946  }
3947  while (i);
3948
3949  return TRUE;
3950}
3951
3952BOOLEAN p_EqualPolys(poly p1,poly p2, const ring r1, const ring r2)
3953{
3954  assume( r1 == r2 || rSamePolyRep(r1, r2) ); // will be used in rEqual!
3955  assume( r1->cf == r2->cf );
3956 
3957  while ((p1 != NULL) && (p2 != NULL))
3958  {
3959    // returns 1 if ExpVector(p)==ExpVector(q): does not compare numbers !!
3960    // #define p_LmEqual(p1, p2, r) p_ExpVectorEqual(p1, p2, r)
3961
3962    if (! p_ExpVectorEqual(p1, p2, r1, r2))
3963      return FALSE;
3964   
3965    if (! n_Equal(p_GetCoeff(p1,r1), p_GetCoeff(p2,r2), r1->cf ))
3966      return FALSE;
3967   
3968    pIter(p1);
3969    pIter(p2);
3970  }
3971  return (p1==p2);
3972}
3973
3974/*2
3975*returns TRUE if p1 is a skalar multiple of p2
3976*assume p1 != NULL and p2 != NULL
3977*/
3978BOOLEAN p_ComparePolys(poly p1,poly p2, const ring r)
3979{
3980  number n,nn;
3981  pAssume(p1 != NULL && p2 != NULL);
3982
3983  if (!p_LmEqual(p1,p2,r)) //compare leading mons
3984      return FALSE;
3985  if ((pNext(p1)==NULL) && (pNext(p2)!=NULL))
3986     return FALSE;
3987  if ((pNext(p2)==NULL) && (pNext(p1)!=NULL))
3988     return FALSE;
3989  if (pLength(p1) != pLength(p2))
3990    return FALSE;
3991#ifdef HAVE_RINGS
3992  if (rField_is_Ring(r))
3993  {
3994    if (!n_DivBy(p_GetCoeff(p1, r), p_GetCoeff(p2, r), r)) return FALSE;
3995  }
3996#endif
3997  n=n_Div(p_GetCoeff(p1,r),p_GetCoeff(p2,r),r);
3998  while ((p1 != NULL) /*&& (p2 != NULL)*/)
3999  {
4000    if ( ! p_LmEqual(p1, p2,r))
4001    {
4002        n_Delete(&n, r);
4003        return FALSE;
4004    }
4005    if (!n_Equal(p_GetCoeff(p1, r), nn = n_Mult(p_GetCoeff(p2, r),n, r->cf), r->cf))
4006    {
4007      n_Delete(&n, r);
4008      n_Delete(&nn, r);
4009      return FALSE;
4010    }
4011    n_Delete(&nn, r);
4012    pIter(p1);
4013    pIter(p2);
4014  }
4015  n_Delete(&n, r);
4016  return TRUE;
4017}
4018
4019/*2
4020* returns the length of a (numbers of monomials)
4021* respect syzComp
4022*/
4023poly p_Last(const poly p, int &l, const ring r)
4024{
4025  if (p == NULL)
4026  {
4027    l = 0;
4028    return NULL;
4029  }
4030  l = 1;
4031  poly a = p;
4032  if (! rIsSyzIndexRing(r))
4033  {
4034    poly next = pNext(a);
4035    while (next!=NULL)
4036    {
4037      a = next;
4038      next = pNext(a);     
4039      l++;
4040    }
4041  }
4042  else
4043  {
4044    int curr_limit = rGetCurrSyzLimit(r);
4045    poly pp = a;
4046    while ((a=pNext(a))!=NULL)
4047    {
4048      if (p_GetComp(a,r)<=curr_limit/*syzComp*/)
4049        l++;
4050      else break;
4051      pp = a;
4052    }
4053    a=pp;
4054  }
4055  return a;
4056}
4057
4058int p_Var(poly m,const ring r)
4059{
4060  if (m==NULL) return 0;
4061  if (pNext(m)!=NULL) return 0;
4062  int i,e=0;
4063  for (i=rVar(r); i>0; i--)
4064  {
4065    int exp=p_GetExp(m,i,r);
4066    if (exp==1)
4067    {
4068      if (e==0) e=i;
4069      else return 0;
4070    }
4071    else if (exp!=0)
4072    {
4073      return 0;
4074    }
4075  }
4076  return e;
4077}
4078
4079/*2
4080*the minimal index of used variables - 1
4081*/
4082int p_LowVar (poly p, const ring r)
4083{
4084  int k,l,lex;
4085
4086  if (p == NULL) return -1;
4087
4088  k = 32000;/*a very large dummy value*/
4089  while (p != NULL)
4090  {
4091    l = 1;
4092    lex = p_GetExp(p,l,r);
4093    while ((l < (rVar(r))) && (lex == 0))
4094    {
4095      l++;
4096      lex = p_GetExp(p,l,r);
4097    }
4098    l--;
4099    if (l < k) k = l;
4100    pIter(p);
4101  }
4102  return k;
4103}
4104
4105/*2
4106* verschiebt die Indizees der Modulerzeugenden um i
4107*/
4108void p_Shift (poly * p,int i, const ring r)
4109{
4110  poly qp1 = *p,qp2 = *p;/*working pointers*/
4111  int     j = p_MaxComp(*p,r),k = p_MinComp(*p,r);
4112
4113  if (j+i < 0) return ;
4114  while (qp1 != NULL)
4115  {
4116    if ((p_GetComp(qp1,r)+i > 0) || ((j == -i) && (j == k)))
4117    {
4118      p_AddComp(qp1,i,r);
4119      p_SetmComp(qp1,r);
4120      qp2 = qp1;
4121      pIter(qp1);
4122    }
4123    else
4124    {
4125      if (qp2 == *p)
4126      {
4127        pIter(*p);
4128        p_LmDelete(&qp2,r);
4129        qp2 = *p;
4130        qp1 = *p;
4131      }
4132      else
4133      {
4134        qp2->next = qp1->next;
4135        if (qp1!=NULL) p_LmDelete(&qp1,r);
4136        qp1 = qp2->next;
4137      }
4138    }
4139  }
4140}
4141
4142/***************************************************************
4143 *
4144 * Storage Managament Routines
4145 *
4146 ***************************************************************/
4147
4148
4149static inline unsigned long GetBitFields(long e,
4150                                         unsigned int s, unsigned int n)
4151{
4152#define Sy_bit_L(x)     (((unsigned long)1L)<<(x))
4153  unsigned int i = 0;
4154  unsigned long  ev = 0L;
4155  assume(n > 0 && s < BIT_SIZEOF_LONG);
4156  do
4157  {
4158    assume(s+i < BIT_SIZEOF_LONG);
4159    if (e > (long) i) ev |= Sy_bit_L(s+i);
4160    else break;
4161    i++;
4162  }
4163  while (i < n);
4164  return ev;
4165}
4166
4167// Short Exponent Vectors are used for fast divisibility tests
4168// ShortExpVectors "squeeze" an exponent vector into one word as follows:
4169// Let n = BIT_SIZEOF_LONG / pVariables.
4170// If n == 0 (i.e. pVariables > BIT_SIZE_OF_LONG), let m == the number
4171// of non-zero exponents. If (m>BIT_SIZEOF_LONG), then sev = ~0, else
4172// first m bits of sev are set to 1.
4173// Otherwise (i.e. pVariables <= BIT_SIZE_OF_LONG)
4174// represented by a bit-field of length n (resp. n+1 for some
4175// exponents). If the value of an exponent is greater or equal to n, then
4176// all of its respective n bits are set to 1. If the value of an exponent
4177// is smaller than n, say m, then only the first m bits of the respective
4178// n bits are set to 1, the others are set to 0.
4179// This way, we have:
4180// exp1 / exp2 ==> (ev1 & ~ev2) == 0, i.e.,
4181// if (ev1 & ~ev2) then exp1 does not divide exp2
4182unsigned long p_GetShortExpVector(poly p, const ring r)
4183{
4184  assume(p != NULL);
4185  if (p == NULL) return 0;
4186  unsigned long ev = 0; // short exponent vector
4187  unsigned int n = BIT_SIZEOF_LONG / r->N; // number of bits per exp
4188  unsigned int m1; // highest bit which is filled with (n+1)
4189  unsigned int i = 0, j=1;
4190
4191  if (n == 0)
4192  {
4193    if (r->N <2*BIT_SIZEOF_LONG)
4194    {
4195      n=1;
4196      m1=0;
4197    }
4198    else
4199    {
4200      for (; j<=(unsigned long) r->N; j++)
4201      {
4202        if (p_GetExp(p,j,r) > 0) i++;
4203        if (i == BIT_SIZEOF_LONG) break;
4204      }
4205      if (i>0)
4206        ev = ~((unsigned long)0) >> ((unsigned long) (BIT_SIZEOF_LONG - i));
4207      return ev;
4208    }
4209  }
4210  else
4211  {
4212    m1 = (n+1)*(BIT_SIZEOF_LONG - n*r->N);
4213  }
4214
4215  n++;
4216  while (i<m1)
4217  {
4218    ev |= GetBitFields(p_GetExp(p, j,r), i, n);
4219    i += n;
4220    j++;
4221  }
4222
4223  n--;
4224  while (i<BIT_SIZEOF_LONG)
4225  {
4226    ev |= GetBitFields(p_GetExp(p, j,r), i, n);
4227    i += n;
4228    j++;
4229  }
4230  return ev;
4231}
4232
4233/***************************************************************
4234 *
4235 * p_ShallowDelete
4236 *
4237 ***************************************************************/
4238#undef LINKAGE
4239#define LINKAGE
4240#undef p_Delete__T
4241#define p_Delete__T p_ShallowDelete
4242#undef n_Delete__T
4243#define n_Delete__T(n, r) do {} while (0)
4244
4245#include <polys/templates/p_Delete__T.cc>
4246
Note: See TracBrowser for help on using the repository browser.