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

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