source: git/libpolys/polys/monomials/p_polys.cc @ 20c540

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