source: git/libpolys/polys/monomials/p_polys.cc @ 2e2c67

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