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

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