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

spielwiese
Last change on this file since d30a399 was d30a399, checked in by Hans Schoenemann <hannes@…>, 12 years ago
chg: option handling: test,verbose renamed to si_opt_1,si_opt_2
  • Property mode set to 100644
File size: 88.0 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/***************************************************************
5 *  File:    p_polys.cc
6 *  Purpose: implementation of ring independent poly procedures?
7 *  Author:  obachman (Olaf Bachmann)
8 *  Created: 8/00
9 *******************************************************************/
10
11
12#include "config.h"
13
14#include <ctype.h>
15
16#include <omalloc/omalloc.h>
17
18#include <misc/auxiliary.h>
19
20#include <misc/options.h>
21#include <misc/intvec.h>
22
23#include <coeffs/longrat.h> // ???
24#include <coeffs/ffields.h>
25
26#include <polys/PolyEnumerator.h>
27
28#define TRANSEXT_PRIVATES
29
30#include <polys/ext_fields/transext.h>
31#include <polys/ext_fields/algext.h>
32
33#include <polys/weight.h>
34#include <polys/simpleideals.h>
35
36#include "ring.h"
37#include "p_polys.h"
38
39#include <polys/templates/p_MemCmp.h>
40#include <polys/templates/p_MemAdd.h>
41#include <polys/templates/p_MemCopy.h>
42
43
44// #include <???/ideals.h>
45// #include <???/int64vec.h>
46
47#ifndef NDEBUG
48// #include <???/febase.h>
49#endif
50
51#ifdef HAVE_PLURAL
52#include "nc/nc.h"
53#include "nc/sca.h"
54#endif
55
56#include "coeffrings.h"
57#ifdef HAVE_FACTORY
58#include "clapsing.h"
59#endif
60
61/***************************************************************
62 *
63 * Completing what needs to be set for the monomial
64 *
65 ***************************************************************/
66// this is special for the syz stuff
67static int* _components = NULL;
68static long* _componentsShifted = NULL;
69static int _componentsExternal = 0;
70
71BOOLEAN pSetm_error=0;
72
73#ifndef NDEBUG
74# define MYTEST 0
75#else /* ifndef NDEBUG */
76# define MYTEST 0
77#endif /* ifndef NDEBUG */
78
79void p_Setm_General(poly p, const ring r)
80{
81  p_LmCheckPolyRing(p, r);
82  int pos=0;
83  if (r->typ!=NULL)
84  {
85    loop
86    {
87      long ord=0;
88      sro_ord* o=&(r->typ[pos]);
89      switch(o->ord_typ)
90      {
91        case ro_dp:
92        {
93          int a,e;
94          a=o->data.dp.start;
95          e=o->data.dp.end;
96          for(int i=a;i<=e;i++) ord+=p_GetExp(p,i,r);
97          p->exp[o->data.dp.place]=ord;
98          break;
99        }
100        case ro_wp_neg:
101          ord=POLY_NEGWEIGHT_OFFSET;
102          // no break;
103        case ro_wp:
104        {
105          int a,e;
106          a=o->data.wp.start;
107          e=o->data.wp.end;
108          int *w=o->data.wp.weights;
109#if 1
110          for(int i=a;i<=e;i++) ord+=p_GetExp(p,i,r)*w[i-a];
111#else
112          long ai;
113          int ei,wi;
114          for(int i=a;i<=e;i++)
115          {
116             ei=p_GetExp(p,i,r);
117             wi=w[i-a];
118             ai=ei*wi;
119             if (ai/ei!=wi) pSetm_error=TRUE;
120             ord+=ai;
121             if (ord<ai) pSetm_error=TRUE;
122          }
123#endif
124          p->exp[o->data.wp.place]=ord;
125          break;
126        }
127        case ro_am:
128        {
129          ord = POLY_NEGWEIGHT_OFFSET;
130          const short a=o->data.am.start;
131          const short e=o->data.am.end;
132          const int * w=o->data.am.weights;
133#if 1
134          for(short i=a; i<=e; i++, w++)
135            ord += ((*w) * p_GetExp(p,i,r));
136#else
137          long ai;
138          int ei,wi;
139          for(short i=a;i<=e;i++)
140          {
141             ei=p_GetExp(p,i,r);
142             wi=w[i-a];
143             ai=ei*wi;
144             if (ai/ei!=wi) pSetm_error=TRUE;
145             ord += ai;
146             if (ord<ai) pSetm_error=TRUE;
147          }
148#endif
149          const int c = p_GetComp(p,r);
150
151          const short len_gen= o->data.am.len_gen;
152         
153          if ((c > 0) && (c <= len_gen))
154          {
155            assume( w == o->data.am.weights_m );
156            assume( w[0] == len_gen );
157            ord += w[c];
158          }
159         
160          p->exp[o->data.am.place] = ord;
161          break;
162        }
163      case ro_wp64:
164        {
165          int64 ord=0;
166          int a,e;
167          a=o->data.wp64.start;
168          e=o->data.wp64.end;
169          int64 *w=o->data.wp64.weights64;
170          int64 ei,wi,ai;
171          for(int i=a;i<=e;i++)
172          {
173            //Print("exp %d w %d \n",p_GetExp(p,i,r),(int)w[i-a]);
174            //ord+=((int64)p_GetExp(p,i,r))*w[i-a];
175            ei=(int64)p_GetExp(p,i,r);
176            wi=w[i-a];
177            ai=ei*wi;
178            if(ei!=0 && ai/ei!=wi)
179            {
180              pSetm_error=TRUE;
181              #if SIZEOF_LONG == 4
182              Print("ai %lld, wi %lld\n",ai,wi);
183              #else
184              Print("ai %ld, wi %ld\n",ai,wi);
185              #endif
186            }
187            ord+=ai;
188            if (ord<ai)
189            {
190              pSetm_error=TRUE;
191              #if SIZEOF_LONG == 4
192              Print("ai %lld, ord %lld\n",ai,ord);
193              #else
194              Print("ai %ld, ord %ld\n",ai,ord);
195              #endif
196            }
197          }
198          int64 mask=(int64)0x7fffffff;
199          long a_0=(long)(ord&mask); //2^31
200          long a_1=(long)(ord >>31 ); /*(ord/(mask+1));*/
201
202          //Print("mask: %x,  ord: %d,  a_0: %d,  a_1: %d\n"
203          //,(int)mask,(int)ord,(int)a_0,(int)a_1);
204                    //Print("mask: %d",mask);
205
206          p->exp[o->data.wp64.place]=a_1;
207          p->exp[o->data.wp64.place+1]=a_0;
208//            if(p_Setm_error) Print("***************************\n
209//                                    ***************************\n
210//                                    **WARNING: overflow error**\n
211//                                    ***************************\n
212//                                    ***************************\n");
213          break;
214        }
215        case ro_cp:
216        {
217          int a,e;
218          a=o->data.cp.start;
219          e=o->data.cp.end;
220          int pl=o->data.cp.place;
221          for(int i=a;i<=e;i++) { p->exp[pl]=p_GetExp(p,i,r); pl++; }
222          break;
223        }
224        case ro_syzcomp:
225        {
226          int c=p_GetComp(p,r);
227          long sc = c;
228          int* Components = (_componentsExternal ? _components :
229                             o->data.syzcomp.Components);
230          long* ShiftedComponents = (_componentsExternal ? _componentsShifted:
231                                     o->data.syzcomp.ShiftedComponents);
232          if (ShiftedComponents != NULL)
233          {
234            assume(Components != NULL);
235            assume(c == 0 || Components[c] != 0);
236            sc = ShiftedComponents[Components[c]];
237            assume(c == 0 || sc != 0);
238          }
239          p->exp[o->data.syzcomp.place]=sc;
240          break;
241        }
242        case ro_syz:
243        {
244          const unsigned long c = p_GetComp(p, r);
245          const short place = o->data.syz.place;
246          const int limit = o->data.syz.limit;
247
248          if (c > (unsigned long)limit)
249            p->exp[place] = o->data.syz.curr_index;
250          else if (c > 0)
251          {
252            assume( (1 <= c) && (c <= (unsigned long)limit) );
253            p->exp[place]= o->data.syz.syz_index[c];
254          }
255          else
256          {
257            assume(c == 0);
258            p->exp[place]= 0;
259          }
260          break;
261        }
262        // Prefix for Induced Schreyer ordering
263        case ro_isTemp: // Do nothing?? (to be removed into suffix later on...?)
264        {
265          assume(p != NULL);
266
267#ifndef NDEBUG
268#if MYTEST
269          Print("p_Setm_General: ro_isTemp ord: pos: %d, p: ", pos);  p_DebugPrint(p, r, r, 1);
270#endif
271#endif
272          int c = p_GetComp(p, r);
273
274          assume( c >= 0 );
275
276          // Let's simulate case ro_syz above....
277          // Should accumulate (by Suffix) and be a level indicator
278          const int* const pVarOffset = o->data.isTemp.pVarOffset;
279
280          assume( pVarOffset != NULL );
281
282          // TODO: Can this be done in the suffix???
283          for( int i = 1; i <= r->N; i++ ) // No v[0] here!!!
284          {
285            const int vo = pVarOffset[i];
286            if( vo != -1) // TODO: optimize: can be done once!
287            {
288              // Hans! Please don't break it again! p_SetExp(p, ..., r, vo) is correct:
289              p_SetExp(p, p_GetExp(p, i, r), r, vo); // copy put them verbatim
290              // Hans! Please don't break it again! p_GetExp(p, r, vo) is correct:
291              assume( p_GetExp(p, r, vo) == p_GetExp(p, i, r) ); // copy put them verbatim
292            }
293          }
294#ifndef NDEBUG
295          for( int i = 1; i <= r->N; i++ ) // No v[0] here!!!
296          {
297            const int vo = pVarOffset[i];
298            if( vo != -1) // TODO: optimize: can be done once!
299            {
300              // Hans! Please don't break it again! p_GetExp(p, r, vo) is correct:
301              assume( p_GetExp(p, r, vo) == p_GetExp(p, i, r) ); // copy put them verbatim
302            }
303          }
304#if MYTEST
305//          if( p->exp[o->data.isTemp.start] > 0 )
306            PrintS("after Values: "); p_DebugPrint(p, r, r, 1);
307#endif
308#endif
309          break;
310        }
311
312        // Suffix for Induced Schreyer ordering
313        case ro_is:
314        {
315#ifndef NDEBUG
316#if MYTEST
317          Print("p_Setm_General: ro_is ord: pos: %d, p: ", pos);  p_DebugPrint(p, r, r, 1);
318#endif
319#endif
320
321          assume(p != NULL);
322
323          int c = p_GetComp(p, r);
324
325          assume( c >= 0 );
326          const ideal F = o->data.is.F;
327          const int limit = o->data.is.limit;
328          assume( limit >= 0 );
329          const int start = o->data.is.start;
330
331          if( F != NULL && c > limit )
332          {
333#ifndef NDEBUG
334#if MYTEST
335            Print("p_Setm_General: ro_is : in rSetm: pos: %d, c: %d >  limit: %d\n", c, pos, limit); // p_DebugPrint(p, r, r, 1);
336            PrintS("preComputed Values: ");
337            p_DebugPrint(p, r, r, 1);
338#endif
339#endif
340//          if( c > limit ) // BUG???
341            p->exp[start] = 1;
342//          else
343//            p->exp[start] = 0;
344
345
346            c -= limit;
347            assume( c > 0 );
348            c--;
349
350            if( c >= IDELEMS(F) )
351              break;
352
353            assume( c < IDELEMS(F) ); // What about others???
354           
355            const poly pp = F->m[c]; // get reference monomial!!!
356
357            if(pp == NULL)
358              break;
359           
360            assume(pp != NULL);
361
362#ifndef NDEBUG
363#if MYTEST
364            Print("Respective F[c - %d: %d] pp: ", limit, c);
365            p_DebugPrint(pp, r, r, 1);
366#endif
367#endif
368
369            const int end = o->data.is.end;
370            assume(start <= end);
371
372
373//          const int st = o->data.isTemp.start;
374
375#ifndef NDEBUG
376            Print("p_Setm_General: is(-Temp-) :: c: %d, limit: %d, [st:%d] ===>>> %ld\n", c, limit, start, p->exp[start]);
377#endif
378
379            // p_ExpVectorAdd(p, pp, r);
380
381            for( int i = start; i <= end; i++) // v[0] may be here...
382              p->exp[i] += pp->exp[i]; // !!!!!!!! ADD corresponding LT(F)
383
384            // p_MemAddAdjust(p, ri);
385            if (r->NegWeightL_Offset != NULL)
386            {
387              for (int i=r->NegWeightL_Size-1; i>=0; i--)
388              {
389                const int _i = r->NegWeightL_Offset[i];
390                if( start <= _i && _i <= end )
391                  p->exp[_i] -= POLY_NEGWEIGHT_OFFSET;
392              }
393            }
394
395
396#ifndef NDEBUG
397            const int* const pVarOffset = o->data.is.pVarOffset;
398
399            assume( pVarOffset != NULL );
400
401            for( int i = 1; i <= r->N; i++ ) // No v[0] here!!!
402            {
403              const int vo = pVarOffset[i];
404              if( vo != -1) // TODO: optimize: can be done once!
405                // Hans! Please don't break it again! p_GetExp(p/pp, r, vo) is correct:
406                assume( p_GetExp(p, r, vo) == (p_GetExp(p, i, r) + p_GetExp(pp, r, vo)) );
407            }
408            // TODO: how to check this for computed values???
409#if MYTEST
410            PrintS("Computed Values: "); p_DebugPrint(p, r, r, 1);
411#endif
412#endif
413          } else
414          {
415            p->exp[start] = 0; //!!!!????? where?????
416
417            const int* const pVarOffset = o->data.is.pVarOffset;
418
419            // What about v[0] - component: it will be added later by
420            // suffix!!!
421            // TODO: Test it!
422            const int vo = pVarOffset[0];
423            if( vo != -1 )
424              p->exp[vo] = c; // initial component v[0]!
425
426#ifndef NDEBUG
427#if MYTEST
428            Print("ELSE p_Setm_General: ro_is :: c: %d <= limit: %d, vo: %d, exp: %d\n", c, limit, vo, p->exp[vo]);
429            p_DebugPrint(p, r, r, 1);
430#endif
431#endif
432          }
433
434          break;
435        }
436        default:
437          dReportError("wrong ord in rSetm:%d\n",o->ord_typ);
438          return;
439      }
440      pos++;
441      if (pos == r->OrdSize) return;
442    }
443  }
444}
445
446void p_Setm_Syz(poly p, ring r, int* Components, long* ShiftedComponents)
447{
448  _components = Components;
449  _componentsShifted = ShiftedComponents;
450  _componentsExternal = 1;
451  p_Setm_General(p, r);
452  _componentsExternal = 0;
453}
454
455// dummy for lp, ls, etc
456void p_Setm_Dummy(poly p, const ring r)
457{
458  p_LmCheckPolyRing(p, r);
459}
460
461// for dp, Dp, ds, etc
462void p_Setm_TotalDegree(poly p, const ring r)
463{
464  p_LmCheckPolyRing(p, r);
465  p->exp[r->pOrdIndex] = p_Totaldegree(p, r);
466}
467
468// for wp, Wp, ws, etc
469void p_Setm_WFirstTotalDegree(poly p, const ring r)
470{
471  p_LmCheckPolyRing(p, r);
472  p->exp[r->pOrdIndex] = p_WFirstTotalDegree(p, r);
473}
474
475p_SetmProc p_GetSetmProc(ring r)
476{
477  // covers lp, rp, ls,
478  if (r->typ == NULL) return p_Setm_Dummy;
479
480  if (r->OrdSize == 1)
481  {
482    if (r->typ[0].ord_typ == ro_dp &&
483        r->typ[0].data.dp.start == 1 &&
484        r->typ[0].data.dp.end == r->N &&
485        r->typ[0].data.dp.place == r->pOrdIndex)
486      return p_Setm_TotalDegree;
487    if (r->typ[0].ord_typ == ro_wp &&
488        r->typ[0].data.wp.start == 1 &&
489        r->typ[0].data.wp.end == r->N &&
490        r->typ[0].data.wp.place == r->pOrdIndex &&
491        r->typ[0].data.wp.weights == r->firstwv)
492      return p_Setm_WFirstTotalDegree;
493  }
494  return p_Setm_General;
495}
496
497
498/* -------------------------------------------------------------------*/
499/* several possibilities for pFDeg: the degree of the head term       */
500
501/* comptible with ordering */
502long p_Deg(poly a, const ring r)
503{
504  p_LmCheckPolyRing(a, r);
505//  assume(p_GetOrder(a, r) == p_WTotaldegree(a, r)); // WRONG assume!
506  return p_GetOrder(a, r);
507}
508
509// p_WTotalDegree for weighted orderings
510// whose first block covers all variables
511long p_WFirstTotalDegree(poly p, const ring r)
512{
513  int i;
514  long sum = 0;
515
516  for (i=1; i<= r->firstBlockEnds; i++)
517  {
518    sum += p_GetExp(p, i, r)*r->firstwv[i-1];
519  }
520  return sum;
521}
522
523/*2
524* compute the degree of the leading monomial of p
525* with respect to weigths from the ordering
526* the ordering is not compatible with degree so do not use p->Order
527*/
528long p_WTotaldegree(poly p, const ring r)
529{
530  p_LmCheckPolyRing(p, r);
531  int i, k;
532  long j =0;
533
534  // iterate through each block:
535  for (i=0;r->order[i]!=0;i++)
536  {
537    int b0=r->block0[i];
538    int b1=r->block1[i];
539    switch(r->order[i])
540    {
541      case ringorder_M:
542        for (k=b0 /*r->block0[i]*/;k<=b1 /*r->block1[i]*/;k++)
543        { // in jedem block:
544          j+= p_GetExp(p,k,r)*r->wvhdl[i][k - b0 /*r->block0[i]*/]*r->OrdSgn;
545        }
546        break;
547      case ringorder_wp:
548      case ringorder_ws:
549      case ringorder_Wp:
550      case ringorder_Ws:
551        for (k=b0 /*r->block0[i]*/;k<=b1 /*r->block1[i]*/;k++)
552        { // in jedem block:
553          j+= p_GetExp(p,k,r)*r->wvhdl[i][k - b0 /*r->block0[i]*/];
554        }
555        break;
556      case ringorder_lp:
557      case ringorder_ls:
558      case ringorder_rs:
559      case ringorder_dp:
560      case ringorder_ds:
561      case ringorder_Dp:
562      case ringorder_Ds:
563      case ringorder_rp:
564        for (k=b0 /*r->block0[i]*/;k<=b1 /*r->block1[i]*/;k++)
565        {
566          j+= p_GetExp(p,k,r);
567        }
568        break;
569      case ringorder_a64:
570        {
571          int64* w=(int64*)r->wvhdl[i];
572          for (k=0;k<=(b1 /*r->block1[i]*/ - b0 /*r->block0[i]*/);k++)
573          {
574            //there should be added a line which checks if w[k]>2^31
575            j+= p_GetExp(p,k+1, r)*(long)w[k];
576          }
577          //break;
578          return j;
579        }
580      case ringorder_c:
581      case ringorder_C:
582      case ringorder_S:
583      case ringorder_s:
584      case ringorder_aa:
585      case ringorder_IS:
586        break;
587      case ringorder_a:
588        for (k=b0 /*r->block0[i]*/;k<=b1 /*r->block1[i]*/;k++)
589        { // only one line
590          j+= p_GetExp(p,k, r)*r->wvhdl[i][ k- b0 /*r->block0[i]*/];
591        }
592        //break;
593        return j;
594
595#ifndef NDEBUG
596      default:
597        Print("missing order %d in p_WTotaldegree\n",r->order[i]);
598        break;
599#endif
600    }
601  }
602  return  j;
603}
604
605long p_DegW(poly p, const short *w, const ring R)
606{
607  long r=~0L;
608
609  while (p!=NULL)
610  {
611    long t=totaldegreeWecart_IV(p,R,w);
612    if (t>r) r=t;
613    pIter(p);
614  }
615  return r;
616}
617
618int p_Weight(int i, const ring r)
619{
620  if ((r->firstwv==NULL) || (i>r->firstBlockEnds))
621  {
622    return 1;
623  }
624  return r->firstwv[i-1];
625}
626
627long p_WDegree(poly p, const ring r)
628{
629  if (r->firstwv==NULL) return p_Totaldegree(p, r);
630  p_LmCheckPolyRing(p, r);
631  int i;
632  long j =0;
633
634  for(i=1;i<=r->firstBlockEnds;i++)
635    j+=p_GetExp(p, i, r)*r->firstwv[i-1];
636
637  for (;i<=r->N;i++)
638    j+=p_GetExp(p,i, r)*p_Weight(i, r);
639
640  return j;
641}
642
643
644/* ---------------------------------------------------------------------*/
645/* several possibilities for pLDeg: the maximal degree of a monomial in p*/
646/*  compute in l also the pLength of p                                   */
647
648/*2
649* compute the length of a polynomial (in l)
650* and the degree of the monomial with maximal degree: the last one
651*/
652long pLDeg0(poly p,int *l, const ring r)
653{
654  p_CheckPolyRing(p, r);
655  long k= p_GetComp(p, r);
656  int ll=1;
657
658  if (k > 0)
659  {
660    while ((pNext(p)!=NULL) && (p_GetComp(pNext(p), r)==k))
661    {
662      pIter(p);
663      ll++;
664    }
665  }
666  else
667  {
668     while (pNext(p)!=NULL)
669     {
670       pIter(p);
671       ll++;
672     }
673  }
674  *l=ll;
675  return r->pFDeg(p, r);
676}
677
678/*2
679* compute the length of a polynomial (in l)
680* and the degree of the monomial with maximal degree: the last one
681* but search in all components before syzcomp
682*/
683long pLDeg0c(poly p,int *l, const ring r)
684{
685  assume(p!=NULL);
686#ifdef PDEBUG
687  _p_Test(p,r,PDEBUG);
688#endif
689  p_CheckPolyRing(p, r);
690  long o;
691  int ll=1;
692
693  if (! rIsSyzIndexRing(r))
694  {
695    while (pNext(p) != NULL)
696    {
697      pIter(p);
698      ll++;
699    }
700    o = r->pFDeg(p, r);
701  }
702  else
703  {
704    int curr_limit = rGetCurrSyzLimit(r);
705    poly pp = p;
706    while ((p=pNext(p))!=NULL)
707    {
708      if (p_GetComp(p, r)<=curr_limit/*syzComp*/)
709        ll++;
710      else break;
711      pp = p;
712    }
713#ifdef PDEBUG
714    _p_Test(pp,r,PDEBUG);
715#endif
716    o = r->pFDeg(pp, r);
717  }
718  *l=ll;
719  return o;
720}
721
722/*2
723* compute the length of a polynomial (in l)
724* and the degree of the monomial with maximal degree: the first one
725* this works for the polynomial case with degree orderings
726* (both c,dp and dp,c)
727*/
728long pLDegb(poly p,int *l, const ring r)
729{
730  p_CheckPolyRing(p, r);
731  long k= p_GetComp(p, r);
732  long o = r->pFDeg(p, r);
733  int ll=1;
734
735  if (k != 0)
736  {
737    while (((p=pNext(p))!=NULL) && (p_GetComp(p, r)==k))
738    {
739      ll++;
740    }
741  }
742  else
743  {
744    while ((p=pNext(p)) !=NULL)
745    {
746      ll++;
747    }
748  }
749  *l=ll;
750  return o;
751}
752
753/*2
754* compute the length of a polynomial (in l)
755* and the degree of the monomial with maximal degree:
756* this is NOT the last one, we have to look for it
757*/
758long pLDeg1(poly p,int *l, const ring r)
759{
760  p_CheckPolyRing(p, r);
761  long k= p_GetComp(p, r);
762  int ll=1;
763  long  t,max;
764
765  max=r->pFDeg(p, r);
766  if (k > 0)
767  {
768    while (((p=pNext(p))!=NULL) && (p_GetComp(p, r)==k))
769    {
770      t=r->pFDeg(p, r);
771      if (t>max) max=t;
772      ll++;
773    }
774  }
775  else
776  {
777    while ((p=pNext(p))!=NULL)
778    {
779      t=r->pFDeg(p, r);
780      if (t>max) max=t;
781      ll++;
782    }
783  }
784  *l=ll;
785  return max;
786}
787
788/*2
789* compute the length of a polynomial (in l)
790* and the degree of the monomial with maximal degree:
791* this is NOT the last one, we have to look for it
792* in all components
793*/
794long pLDeg1c(poly p,int *l, const ring r)
795{
796  p_CheckPolyRing(p, r);
797  int ll=1;
798  long  t,max;
799
800  max=r->pFDeg(p, r);
801  if (rIsSyzIndexRing(r))
802  {
803    long limit = rGetCurrSyzLimit(r);
804    while ((p=pNext(p))!=NULL)
805    {
806      if (p_GetComp(p, r)<=limit)
807      {
808        if ((t=r->pFDeg(p, r))>max) max=t;
809        ll++;
810      }
811      else break;
812    }
813  }
814  else
815  {
816    while ((p=pNext(p))!=NULL)
817    {
818      if ((t=r->pFDeg(p, r))>max) max=t;
819      ll++;
820    }
821  }
822  *l=ll;
823  return max;
824}
825
826// like pLDeg1, only pFDeg == pDeg
827long pLDeg1_Deg(poly p,int *l, const ring r)
828{
829  assume(r->pFDeg == p_Deg);
830  p_CheckPolyRing(p, r);
831  long k= p_GetComp(p, r);
832  int ll=1;
833  long  t,max;
834
835  max=p_GetOrder(p, r);
836  if (k > 0)
837  {
838    while (((p=pNext(p))!=NULL) && (p_GetComp(p, r)==k))
839    {
840      t=p_GetOrder(p, r);
841      if (t>max) max=t;
842      ll++;
843    }
844  }
845  else
846  {
847    while ((p=pNext(p))!=NULL)
848    {
849      t=p_GetOrder(p, r);
850      if (t>max) max=t;
851      ll++;
852    }
853  }
854  *l=ll;
855  return max;
856}
857
858long pLDeg1c_Deg(poly p,int *l, const ring r)
859{
860  assume(r->pFDeg == p_Deg);
861  p_CheckPolyRing(p, r);
862  int ll=1;
863  long  t,max;
864
865  max=p_GetOrder(p, r);
866  if (rIsSyzIndexRing(r))
867  {
868    long limit = rGetCurrSyzLimit(r);
869    while ((p=pNext(p))!=NULL)
870    {
871      if (p_GetComp(p, r)<=limit)
872      {
873        if ((t=p_GetOrder(p, r))>max) max=t;
874        ll++;
875      }
876      else break;
877    }
878  }
879  else
880  {
881    while ((p=pNext(p))!=NULL)
882    {
883      if ((t=p_GetOrder(p, r))>max) max=t;
884      ll++;
885    }
886  }
887  *l=ll;
888  return max;
889}
890
891// like pLDeg1, only pFDeg == pTotoalDegree
892long pLDeg1_Totaldegree(poly p,int *l, const ring r)
893{
894  p_CheckPolyRing(p, r);
895  long k= p_GetComp(p, r);
896  int ll=1;
897  long  t,max;
898
899  max=p_Totaldegree(p, r);
900  if (k > 0)
901  {
902    while (((p=pNext(p))!=NULL) && (p_GetComp(p, r)==k))
903    {
904      t=p_Totaldegree(p, r);
905      if (t>max) max=t;
906      ll++;
907    }
908  }
909  else
910  {
911    while ((p=pNext(p))!=NULL)
912    {
913      t=p_Totaldegree(p, r);
914      if (t>max) max=t;
915      ll++;
916    }
917  }
918  *l=ll;
919  return max;
920}
921
922long pLDeg1c_Totaldegree(poly p,int *l, const ring r)
923{
924  p_CheckPolyRing(p, r);
925  int ll=1;
926  long  t,max;
927
928  max=p_Totaldegree(p, r);
929  if (rIsSyzIndexRing(r))
930  {
931    long limit = rGetCurrSyzLimit(r);
932    while ((p=pNext(p))!=NULL)
933    {
934      if (p_GetComp(p, r)<=limit)
935      {
936        if ((t=p_Totaldegree(p, r))>max) max=t;
937        ll++;
938      }
939      else break;
940    }
941  }
942  else
943  {
944    while ((p=pNext(p))!=NULL)
945    {
946      if ((t=p_Totaldegree(p, r))>max) max=t;
947      ll++;
948    }
949  }
950  *l=ll;
951  return max;
952}
953
954// like pLDeg1, only pFDeg == p_WFirstTotalDegree
955long pLDeg1_WFirstTotalDegree(poly p,int *l, const ring r)
956{
957  p_CheckPolyRing(p, r);
958  long k= p_GetComp(p, r);
959  int ll=1;
960  long  t,max;
961
962  max=p_WFirstTotalDegree(p, r);
963  if (k > 0)
964  {
965    while (((p=pNext(p))!=NULL) && (p_GetComp(p, r)==k))
966    {
967      t=p_WFirstTotalDegree(p, r);
968      if (t>max) max=t;
969      ll++;
970    }
971  }
972  else
973  {
974    while ((p=pNext(p))!=NULL)
975    {
976      t=p_WFirstTotalDegree(p, r);
977      if (t>max) max=t;
978      ll++;
979    }
980  }
981  *l=ll;
982  return max;
983}
984
985long pLDeg1c_WFirstTotalDegree(poly p,int *l, const ring r)
986{
987  p_CheckPolyRing(p, r);
988  int ll=1;
989  long  t,max;
990
991  max=p_WFirstTotalDegree(p, r);
992  if (rIsSyzIndexRing(r))
993  {
994    long limit = rGetCurrSyzLimit(r);
995    while ((p=pNext(p))!=NULL)
996    {
997      if (p_GetComp(p, r)<=limit)
998      {
999        if ((t=p_Totaldegree(p, r))>max) max=t;
1000        ll++;
1001      }
1002      else break;
1003    }
1004  }
1005  else
1006  {
1007    while ((p=pNext(p))!=NULL)
1008    {
1009      if ((t=p_Totaldegree(p, r))>max) max=t;
1010      ll++;
1011    }
1012  }
1013  *l=ll;
1014  return max;
1015}
1016
1017/***************************************************************
1018 *
1019 * Maximal Exponent business
1020 *
1021 ***************************************************************/
1022
1023static inline unsigned long
1024p_GetMaxExpL2(unsigned long l1, unsigned long l2, const ring r,
1025              unsigned long number_of_exp)
1026{
1027  const unsigned long bitmask = r->bitmask;
1028  unsigned long ml1 = l1 & bitmask;
1029  unsigned long ml2 = l2 & bitmask;
1030  unsigned long max = (ml1 > ml2 ? ml1 : ml2);
1031  unsigned long j = number_of_exp - 1;
1032
1033  if (j > 0)
1034  {
1035    unsigned long mask = bitmask << r->BitsPerExp;
1036    while (1)
1037    {
1038      ml1 = l1 & mask;
1039      ml2 = l2 & mask;
1040      max |= ((ml1 > ml2 ? ml1 : ml2) & mask);
1041      j--;
1042      if (j == 0) break;
1043      mask = mask << r->BitsPerExp;
1044    }
1045  }
1046  return max;
1047}
1048
1049static inline unsigned long
1050p_GetMaxExpL2(unsigned long l1, unsigned long l2, const ring r)
1051{
1052  return p_GetMaxExpL2(l1, l2, r, r->ExpPerLong);
1053}
1054
1055poly p_GetMaxExpP(poly p, const ring r)
1056{
1057  p_CheckPolyRing(p, r);
1058  if (p == NULL) return p_Init(r);
1059  poly max = p_LmInit(p, r);
1060  pIter(p);
1061  if (p == NULL) return max;
1062  int i, offset;
1063  unsigned long l_p, l_max;
1064  unsigned long divmask = r->divmask;
1065
1066  do
1067  {
1068    offset = r->VarL_Offset[0];
1069    l_p = p->exp[offset];
1070    l_max = max->exp[offset];
1071    // do the divisibility trick to find out whether l has an exponent
1072    if (l_p > l_max ||
1073        (((l_max & divmask) ^ (l_p & divmask)) != ((l_max-l_p) & divmask)))
1074      max->exp[offset] = p_GetMaxExpL2(l_max, l_p, r);
1075
1076    for (i=1; i<r->VarL_Size; i++)
1077    {
1078      offset = r->VarL_Offset[i];
1079      l_p = p->exp[offset];
1080      l_max = max->exp[offset];
1081      // do the divisibility trick to find out whether l has an exponent
1082      if (l_p > l_max ||
1083          (((l_max & divmask) ^ (l_p & divmask)) != ((l_max-l_p) & divmask)))
1084        max->exp[offset] = p_GetMaxExpL2(l_max, l_p, r);
1085    }
1086    pIter(p);
1087  }
1088  while (p != NULL);
1089  return max;
1090}
1091
1092unsigned long p_GetMaxExpL(poly p, const ring r, unsigned long l_max)
1093{
1094  unsigned long l_p, divmask = r->divmask;
1095  int i;
1096
1097  while (p != NULL)
1098  {
1099    l_p = p->exp[r->VarL_Offset[0]];
1100    if (l_p > l_max ||
1101        (((l_max & divmask) ^ (l_p & divmask)) != ((l_max-l_p) & divmask)))
1102      l_max = p_GetMaxExpL2(l_max, l_p, r);
1103    for (i=1; i<r->VarL_Size; i++)
1104    {
1105      l_p = p->exp[r->VarL_Offset[i]];
1106      // do the divisibility trick to find out whether l has an exponent
1107      if (l_p > l_max ||
1108          (((l_max & divmask) ^ (l_p & divmask)) != ((l_max-l_p) & divmask)))
1109        l_max = p_GetMaxExpL2(l_max, l_p, r);
1110    }
1111    pIter(p);
1112  }
1113  return l_max;
1114}
1115
1116
1117
1118
1119/***************************************************************
1120 *
1121 * Misc things
1122 *
1123 ***************************************************************/
1124// returns TRUE, if all monoms have the same component
1125BOOLEAN p_OneComp(poly p, const ring r)
1126{
1127  if(p!=NULL)
1128  {
1129    long i = p_GetComp(p, r);
1130    while (pNext(p)!=NULL)
1131    {
1132      pIter(p);
1133      if(i != p_GetComp(p, r)) return FALSE;
1134    }
1135  }
1136  return TRUE;
1137}
1138
1139/*2
1140*test if a monomial /head term is a pure power
1141*/
1142int p_IsPurePower(const poly p, const ring r)
1143{
1144  int i,k=0;
1145
1146  for (i=r->N;i;i--)
1147  {
1148    if (p_GetExp(p,i, r)!=0)
1149    {
1150      if(k!=0) return 0;
1151      k=i;
1152    }
1153  }
1154  return k;
1155}
1156
1157/*2
1158*test if a polynomial is univariate
1159* return -1 for constant,
1160* 0 for not univariate,s
1161* i if dep. on var(i)
1162*/
1163int p_IsUnivariate(poly p, const ring r)
1164{
1165  int i,k=-1;
1166
1167  while (p!=NULL)
1168  {
1169    for (i=r->N;i;i--)
1170    {
1171      if (p_GetExp(p,i, r)!=0)
1172      {
1173        if((k!=-1)&&(k!=i)) return 0;
1174        k=i;
1175      }
1176    }
1177    pIter(p);
1178  }
1179  return k;
1180}
1181
1182// set entry e[i] to 1 if var(i) occurs in p, ignore var(j) if e[j]>0
1183int  p_GetVariables(poly p, int * e, const ring r)
1184{
1185  int i;
1186  int n=0;
1187  while(p!=NULL)
1188  {
1189    n=0;
1190    for(i=r->N; i>0; i--)
1191    {
1192      if(e[i]==0)
1193      {
1194        if (p_GetExp(p,i,r)>0)
1195        {
1196          e[i]=1;
1197          n++;
1198        }
1199      }
1200      else
1201        n++;
1202    }
1203    if (n==r->N) break;
1204    pIter(p);
1205  }
1206  return n;
1207}
1208
1209
1210/*2
1211* returns a polynomial representing the integer i
1212*/
1213poly p_ISet(long i, const ring r)
1214{
1215  poly rc = NULL;
1216  if (i!=0)
1217  {
1218    rc = p_Init(r);
1219    pSetCoeff0(rc,n_Init(i,r->cf));
1220    if (n_IsZero(pGetCoeff(rc),r->cf))
1221      p_LmDelete(&rc,r);
1222  }
1223  return rc;
1224}
1225
1226/*2
1227* an optimized version of p_ISet for the special case 1
1228*/
1229poly p_One(const ring r)
1230{
1231  poly rc = p_Init(r);
1232  pSetCoeff0(rc,n_Init(1,r->cf));
1233  return rc;
1234}
1235
1236void p_Split(poly p, poly *h)
1237{
1238  *h=pNext(p);
1239  pNext(p)=NULL;
1240}
1241
1242/*2
1243* pair has no common factor ? or is no polynomial
1244*/
1245BOOLEAN p_HasNotCF(poly p1, poly p2, const ring r)
1246{
1247
1248  if (p_GetComp(p1,r) > 0 || p_GetComp(p2,r) > 0)
1249    return FALSE;
1250  int i = rVar(r);
1251  loop
1252  {
1253    if ((p_GetExp(p1, i, r) > 0) && (p_GetExp(p2, i, r) > 0))
1254      return FALSE;
1255    i--;
1256    if (i == 0)
1257      return TRUE;
1258  }
1259}
1260
1261/*2
1262* convert monomial given as string to poly, e.g. 1x3y5z
1263*/
1264const char * p_Read(const char *st, poly &rc, const ring r)
1265{
1266  if (r==NULL) { rc=NULL;return st;}
1267  int i,j;
1268  rc = p_Init(r);
1269  const char *s = r->cf->cfRead(st,&(rc->coef),r->cf);
1270  if (s==st)
1271  /* i.e. it does not start with a coeff: test if it is a ringvar*/
1272  {
1273    j = r_IsRingVar(s,r);
1274    if (j >= 0)
1275    {
1276      p_IncrExp(rc,1+j,r);
1277      while (*s!='\0') s++;
1278      goto done;
1279    }
1280  }
1281  while (*s!='\0')
1282  {
1283    char ss[2];
1284    ss[0] = *s++;
1285    ss[1] = '\0';
1286    j = r_IsRingVar(ss,r);
1287    if (j >= 0)
1288    {
1289      const char *s_save=s;
1290      s = eati(s,&i);
1291      if (((unsigned long)i) >  r->bitmask)
1292      {
1293        // exponent to large: it is not a monomial
1294        p_LmDelete(&rc,r);
1295        return s_save;
1296      }
1297      p_AddExp(rc,1+j, (long)i, r);
1298    }
1299    else
1300    {
1301      // 1st char of is not a varname
1302      // We return the parsed polynomial nevertheless. This is needed when
1303      // we are parsing coefficients in a rational function field.
1304      s--;
1305      return s;
1306    }
1307  }
1308done:
1309  if (n_IsZero(pGetCoeff(rc),r->cf)) p_LmDelete(&rc,r);
1310  else
1311  {
1312#ifdef HAVE_PLURAL
1313    // in super-commutative ring
1314    // squares of anti-commutative variables are zeroes!
1315    if(rIsSCA(r))
1316    {
1317      const unsigned int iFirstAltVar = scaFirstAltVar(r);
1318      const unsigned int iLastAltVar  = scaLastAltVar(r);
1319
1320      assume(rc != NULL);
1321
1322      for(unsigned int k = iFirstAltVar; k <= iLastAltVar; k++)
1323        if( p_GetExp(rc, k, r) > 1 )
1324        {
1325          p_LmDelete(&rc, r);
1326          goto finish;
1327        }
1328    }
1329#endif
1330
1331    p_Setm(rc,r);
1332  }
1333finish:
1334  return s;
1335}
1336poly p_mInit(const char *st, BOOLEAN &ok, const ring r)
1337{
1338  poly p;
1339  const char *s=p_Read(st,p,r);
1340  if (*s!='\0')
1341  {
1342    if ((s!=st)&&isdigit(st[0]))
1343    {
1344      errorreported=TRUE;
1345    }
1346    ok=FALSE;
1347    p_Delete(&p,r);
1348    return NULL;
1349  }
1350  #ifdef PDEBUG
1351  _p_Test(p,r,PDEBUG);
1352  #endif
1353  ok=!errorreported;
1354  return p;
1355}
1356
1357/*2
1358* returns a polynomial representing the number n
1359* destroys n
1360*/
1361poly p_NSet(number n, const ring r)
1362{
1363  if (n_IsZero(n,r->cf))
1364  {
1365    n_Delete(&n, r->cf);
1366    return NULL;
1367  }
1368  else
1369  {
1370    poly rc = p_Init(r);
1371    pSetCoeff0(rc,n);
1372    return rc;
1373  }
1374}
1375/*2
1376* assumes that LM(a) = LM(b)*m, for some monomial m,
1377* returns the multiplicant m,
1378* leaves a and b unmodified
1379*/
1380poly p_Divide(poly a, poly b, const ring r)
1381{
1382  assume((p_GetComp(a,r)==p_GetComp(b,r)) || (p_GetComp(b,r)==0));
1383  int i;
1384  poly result = p_Init(r);
1385
1386  for(i=(int)r->N; i; i--)
1387    p_SetExp(result,i, p_GetExp(a,i,r)- p_GetExp(b,i,r),r);
1388  p_SetComp(result, p_GetComp(a,r) - p_GetComp(b,r),r);
1389  p_Setm(result,r);
1390  return result;
1391}
1392
1393poly p_Div_nn(poly p, const number n, const ring r)
1394{
1395  pAssume(!n_IsZero(n,r->cf));
1396  p_Test(p, r);
1397
1398  poly q = p;
1399  while (p != NULL)
1400  {
1401    number nc = pGetCoeff(p);
1402    pSetCoeff0(p, n_Div(nc, n, r->cf));
1403    n_Delete(&nc, r->cf);
1404    pIter(p);
1405  }
1406  p_Test(q, r);
1407  return q;
1408}
1409
1410/*2
1411* divides a by the monomial b, ignores monomials which are not divisible
1412* assumes that b is not NULL, destroyes b
1413*/
1414poly p_DivideM(poly a, poly b, const ring r)
1415{
1416  if (a==NULL) { p_Delete(&b,r); return NULL; }
1417  poly result=a;
1418  poly prev=NULL;
1419  int i;
1420#ifdef HAVE_RINGS
1421  number inv=pGetCoeff(b);
1422#else
1423  number inv=n_Invers(pGetCoeff(b),r->cf);
1424#endif
1425
1426  while (a!=NULL)
1427  {
1428    if (p_DivisibleBy(b,a,r))
1429    {
1430      for(i=(int)r->N; i; i--)
1431         p_SubExp(a,i, p_GetExp(b,i,r),r);
1432      p_SubComp(a, p_GetComp(b,r),r);
1433      p_Setm(a,r);
1434      prev=a;
1435      pIter(a);
1436    }
1437    else
1438    {
1439      if (prev==NULL)
1440      {
1441        p_LmDelete(&result,r);
1442        a=result;
1443      }
1444      else
1445      {
1446        p_LmDelete(&pNext(prev),r);
1447        a=pNext(prev);
1448      }
1449    }
1450  }
1451#ifdef HAVE_RINGS
1452  if (n_IsUnit(inv,r->cf))
1453  {
1454    inv = n_Invers(inv,r->cf);
1455    p_Mult_nn(result,inv,r);
1456    n_Delete(&inv, r->cf);
1457  }
1458  else
1459  {
1460    p_Div_nn(result,inv,r);
1461  }
1462#else
1463  p_Mult_nn(result,inv,r);
1464  n_Delete(&inv, r->cf);
1465#endif
1466  p_Delete(&b, r);
1467  return result;
1468}
1469
1470#ifdef HAVE_RINGS
1471/* TRUE iff LT(f) | LT(g) */
1472BOOLEAN p_DivisibleByRingCase(poly f, poly g, const ring r)
1473{
1474  int exponent;
1475  for(int i = (int)rVar(r); i>0; i--)
1476  {
1477    exponent = p_GetExp(g, i, r) - p_GetExp(f, i, r);
1478    if (exponent < 0) return FALSE;
1479  }
1480  return n_DivBy(pGetCoeff(g), pGetCoeff(f), r->cf);
1481}
1482#endif
1483
1484// returns the LCM of the head terms of a and b in *m
1485void p_Lcm(const poly a, const poly b, poly m, const ring r)
1486{
1487  for (int i=rVar(r); i; --i)
1488    p_SetExp(m,i, si_max( p_GetExp(a,i,r), p_GetExp(b,i,r)),r);
1489 
1490  p_SetComp(m, si_max(p_GetComp(a,r), p_GetComp(b,r)),r);
1491  /* Don't do a pSetm here, otherwise hres/lres chockes */
1492}
1493
1494/* assumes that p and divisor are univariate polynomials in r,
1495   mentioning the same variable;
1496   assumes divisor != NULL;
1497   p may be NULL;
1498   assumes a global monomial ordering in r;
1499   performs polynomial division of p by divisor:
1500     - afterwards p contains the remainder of the division, i.e.,
1501       p_before = result * divisor + p_afterwards;
1502     - if needResult == TRUE, then the method computes and returns 'result',
1503       otherwise NULL is returned (This parametrization can be used when
1504       one is only interested in the remainder of the division. In this
1505       case, the method will be slightly faster.)
1506   leaves divisor unmodified */
1507poly      p_PolyDiv(poly &p, const poly divisor, const BOOLEAN needResult, const ring r)
1508{
1509  assume(divisor != NULL);
1510  if (p == NULL) return NULL;
1511
1512  poly result = NULL;
1513  number divisorLC = p_GetCoeff(divisor, r);
1514  int divisorLE = p_GetExp(divisor, 1, r);
1515  while ((p != NULL) && (p_Deg(p, r) >= p_Deg(divisor, r)))
1516  {
1517    /* determine t = LT(p) / LT(divisor) */
1518    poly t = p_ISet(1, r);
1519    number c = n_Div(p_GetCoeff(p, r), divisorLC, r->cf);
1520    p_SetCoeff(t, c, r);
1521    int e = p_GetExp(p, 1, r) - divisorLE;
1522    p_SetExp(t, 1, e, r);
1523    p_Setm(t, r);
1524    if (needResult) result = p_Add_q(result, p_Copy(t, r), r);
1525    p = p_Add_q(p, p_Neg(p_Mult_q(t, p_Copy(divisor, r), r), r), r);
1526  }
1527  return result;
1528}
1529
1530/*2
1531* returns the partial differentiate of a by the k-th variable
1532* does not destroy the input
1533*/
1534poly p_Diff(poly a, int k, const ring r)
1535{
1536  poly res, f, last;
1537  number t;
1538
1539  last = res = NULL;
1540  while (a!=NULL)
1541  {
1542    if (p_GetExp(a,k,r)!=0)
1543    {
1544      f = p_LmInit(a,r);
1545      t = n_Init(p_GetExp(a,k,r),r->cf);
1546      pSetCoeff0(f,n_Mult(t,pGetCoeff(a),r->cf));
1547      n_Delete(&t,r->cf);
1548      if (n_IsZero(pGetCoeff(f),r->cf))
1549        p_LmDelete(&f,r);
1550      else
1551      {
1552        p_DecrExp(f,k,r);
1553        p_Setm(f,r);
1554        if (res==NULL)
1555        {
1556          res=last=f;
1557        }
1558        else
1559        {
1560          pNext(last)=f;
1561          last=f;
1562        }
1563      }
1564    }
1565    pIter(a);
1566  }
1567  return res;
1568}
1569
1570static poly p_DiffOpM(poly a, poly b,BOOLEAN multiply, const ring r)
1571{
1572  int i,j,s;
1573  number n,h,hh;
1574  poly p=p_One(r);
1575  n=n_Mult(pGetCoeff(a),pGetCoeff(b),r->cf);
1576  for(i=rVar(r);i>0;i--)
1577  {
1578    s=p_GetExp(b,i,r);
1579    if (s<p_GetExp(a,i,r))
1580    {
1581      n_Delete(&n,r->cf);
1582      p_LmDelete(&p,r);
1583      return NULL;
1584    }
1585    if (multiply)
1586    {
1587      for(j=p_GetExp(a,i,r); j>0;j--)
1588      {
1589        h = n_Init(s,r->cf);
1590        hh=n_Mult(n,h,r->cf);
1591        n_Delete(&h,r->cf);
1592        n_Delete(&n,r->cf);
1593        n=hh;
1594        s--;
1595      }
1596      p_SetExp(p,i,s,r);
1597    }
1598    else
1599    {
1600      p_SetExp(p,i,s-p_GetExp(a,i,r),r);
1601    }
1602  }
1603  p_Setm(p,r);
1604  /*if (multiply)*/ p_SetCoeff(p,n,r);
1605  if (n_IsZero(n,r->cf))  p=p_LmDeleteAndNext(p,r); // return NULL as p is a monomial
1606  return p;
1607}
1608
1609poly p_DiffOp(poly a, poly b,BOOLEAN multiply, const ring r)
1610{
1611  poly result=NULL;
1612  poly h;
1613  for(;a!=NULL;pIter(a))
1614  {
1615    for(h=b;h!=NULL;pIter(h))
1616    {
1617      result=p_Add_q(result,p_DiffOpM(a,h,multiply,r),r);
1618    }
1619  }
1620  return result;
1621}
1622/*2
1623* subtract p2 from p1, p1 and p2 are destroyed
1624* do not put attention on speed: the procedure is only used in the interpreter
1625*/
1626poly p_Sub(poly p1, poly p2, const ring r)
1627{
1628  return p_Add_q(p1, p_Neg(p2,r),r);
1629}
1630
1631/*3
1632* compute for a monomial m
1633* the power m^exp, exp > 1
1634* destroys p
1635*/
1636static poly p_MonPower(poly p, int exp, const ring r)
1637{
1638  int i;
1639
1640  if(!n_IsOne(pGetCoeff(p),r->cf))
1641  {
1642    number x, y;
1643    y = pGetCoeff(p);
1644    n_Power(y,exp,&x,r->cf);
1645    n_Delete(&y,r->cf);
1646    pSetCoeff0(p,x);
1647  }
1648  for (i=rVar(r); i!=0; i--)
1649  {
1650    p_MultExp(p,i, exp,r);
1651  }
1652  p_Setm(p,r);
1653  return p;
1654}
1655
1656/*3
1657* compute for monomials p*q
1658* destroys p, keeps q
1659*/
1660static void p_MonMult(poly p, poly q, const ring r)
1661{
1662  number x, y;
1663
1664  y = pGetCoeff(p);
1665  x = n_Mult(y,pGetCoeff(q),r->cf);
1666  n_Delete(&y,r->cf);
1667  pSetCoeff0(p,x);
1668  //for (int i=pVariables; i!=0; i--)
1669  //{
1670  //  pAddExp(p,i, pGetExp(q,i));
1671  //}
1672  //p->Order += q->Order;
1673  p_ExpVectorAdd(p,q,r);
1674}
1675
1676/*3
1677* compute for monomials p*q
1678* keeps p, q
1679*/
1680static poly p_MonMultC(poly p, poly q, const ring rr)
1681{
1682  number x;
1683  poly r = p_Init(rr);
1684
1685  x = n_Mult(pGetCoeff(p),pGetCoeff(q),rr->cf);
1686  pSetCoeff0(r,x);
1687  p_ExpVectorSum(r,p, q, rr);
1688  return r;
1689}
1690
1691/*3
1692*  create binomial coef.
1693*/
1694static number* pnBin(int exp, const ring r)
1695{
1696  int e, i, h;
1697  number x, y, *bin=NULL;
1698
1699  x = n_Init(exp,r->cf);
1700  if (n_IsZero(x,r->cf))
1701  {
1702    n_Delete(&x,r->cf);
1703    return bin;
1704  }
1705  h = (exp >> 1) + 1;
1706  bin = (number *)omAlloc0(h*sizeof(number));
1707  bin[1] = x;
1708  if (exp < 4)
1709    return bin;
1710  i = exp - 1;
1711  for (e=2; e<h; e++)
1712  {
1713      x = n_Init(i,r->cf);
1714      i--;
1715      y = n_Mult(x,bin[e-1],r->cf);
1716      n_Delete(&x,r->cf);
1717      x = n_Init(e,r->cf);
1718      bin[e] = n_IntDiv(y,x,r->cf);
1719      n_Delete(&x,r->cf);
1720      n_Delete(&y,r->cf);
1721  }
1722  return bin;
1723}
1724
1725static void pnFreeBin(number *bin, int exp,const coeffs r)
1726{
1727  int e, h = (exp >> 1) + 1;
1728
1729  if (bin[1] != NULL)
1730  {
1731    for (e=1; e<h; e++)
1732      n_Delete(&(bin[e]),r);
1733  }
1734  omFreeSize((ADDRESS)bin, h*sizeof(number));
1735}
1736
1737/*
1738*  compute for a poly p = head+tail, tail is monomial
1739*          (head + tail)^exp, exp > 1
1740*          with binomial coef.
1741*/
1742static poly p_TwoMonPower(poly p, int exp, const ring r)
1743{
1744  int eh, e;
1745  long al;
1746  poly *a;
1747  poly tail, b, res, h;
1748  number x;
1749  number *bin = pnBin(exp,r);
1750
1751  tail = pNext(p);
1752  if (bin == NULL)
1753  {
1754    p_MonPower(p,exp,r);
1755    p_MonPower(tail,exp,r);
1756#ifdef PDEBUG
1757    p_Test(p,r);
1758#endif
1759    return p;
1760  }
1761  eh = exp >> 1;
1762  al = (exp + 1) * sizeof(poly);
1763  a = (poly *)omAlloc(al);
1764  a[1] = p;
1765  for (e=1; e<exp; e++)
1766  {
1767    a[e+1] = p_MonMultC(a[e],p,r);
1768  }
1769  res = a[exp];
1770  b = p_Head(tail,r);
1771  for (e=exp-1; e>eh; e--)
1772  {
1773    h = a[e];
1774    x = n_Mult(bin[exp-e],pGetCoeff(h),r->cf);
1775    p_SetCoeff(h,x,r);
1776    p_MonMult(h,b,r);
1777    res = pNext(res) = h;
1778    p_MonMult(b,tail,r);
1779  }
1780  for (e=eh; e!=0; e--)
1781  {
1782    h = a[e];
1783    x = n_Mult(bin[e],pGetCoeff(h),r->cf);
1784    p_SetCoeff(h,x,r);
1785    p_MonMult(h,b,r);
1786    res = pNext(res) = h;
1787    p_MonMult(b,tail,r);
1788  }
1789  p_LmDelete(&tail,r);
1790  pNext(res) = b;
1791  pNext(b) = NULL;
1792  res = a[exp];
1793  omFreeSize((ADDRESS)a, al);
1794  pnFreeBin(bin, exp, r->cf);
1795//  tail=res;
1796// while((tail!=NULL)&&(pNext(tail)!=NULL))
1797// {
1798//   if(nIsZero(pGetCoeff(pNext(tail))))
1799//   {
1800//     pLmDelete(&pNext(tail));
1801//   }
1802//   else
1803//     pIter(tail);
1804// }
1805#ifdef PDEBUG
1806  p_Test(res,r);
1807#endif
1808  return res;
1809}
1810
1811static poly p_Pow(poly p, int i, const ring r)
1812{
1813  poly rc = p_Copy(p,r);
1814  i -= 2;
1815  do
1816  {
1817    rc = p_Mult_q(rc,p_Copy(p,r),r);
1818    p_Normalize(rc,r);
1819    i--;
1820  }
1821  while (i != 0);
1822  return p_Mult_q(rc,p,r);
1823}
1824
1825/*2
1826* returns the i-th power of p
1827* p will be destroyed
1828*/
1829poly p_Power(poly p, int i, const ring r)
1830{
1831  poly rc=NULL;
1832
1833  if (i==0)
1834  {
1835    p_Delete(&p,r);
1836    return p_One(r);
1837  }
1838
1839  if(p!=NULL)
1840  {
1841    if ( (i > 0) && ((unsigned long ) i > (r->bitmask)))
1842    {
1843      Werror("exponent %d is too large, max. is %ld",i,r->bitmask);
1844      return NULL;
1845    }
1846    switch (i)
1847    {
1848// cannot happen, see above
1849//      case 0:
1850//      {
1851//        rc=pOne();
1852//        pDelete(&p);
1853//        break;
1854//      }
1855      case 1:
1856        rc=p;
1857        break;
1858      case 2:
1859        rc=p_Mult_q(p_Copy(p,r),p,r);
1860        break;
1861      default:
1862        if (i < 0)
1863        {
1864          p_Delete(&p,r);
1865          return NULL;
1866        }
1867        else
1868        {
1869#ifdef HAVE_PLURAL
1870          if (rIsPluralRing(r)) /* in the NC case nothing helps :-( */
1871          {
1872            int j=i;
1873            rc = p_Copy(p,r);
1874            while (j>1)
1875            {
1876              rc = p_Mult_q(p_Copy(p,r),rc,r);
1877              j--;
1878            }
1879            p_Delete(&p,r);
1880            return rc;
1881          }
1882#endif
1883          rc = pNext(p);
1884          if (rc == NULL)
1885            return p_MonPower(p,i,r);
1886          /* else: binom ?*/
1887          int char_p=rChar(r);
1888          if ((pNext(rc) != NULL)
1889#ifdef HAVE_RINGS
1890             || rField_is_Ring(r)
1891#endif
1892             )
1893            return p_Pow(p,i,r);
1894          if ((char_p==0) || (i<=char_p))
1895            return p_TwoMonPower(p,i,r);
1896          return p_Pow(p,i,r);
1897        }
1898      /*end default:*/
1899    }
1900  }
1901  return rc;
1902}
1903
1904/* --------------------------------------------------------------------------------*/
1905/* content suff                                                                   */
1906
1907static number p_InitContent(poly ph, const ring r);
1908
1909#define CLEARENUMERATORS 0
1910
1911void p_Content(poly ph, const ring r)
1912{
1913  assume( ph != NULL );
1914
1915  assume( r != NULL ); assume( r->cf != NULL ); 
1916
1917
1918#if CLEARENUMERATORS
1919  if( 0 )
1920  {
1921    const coeffs C = r->cf;
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), r->cf);
1980      assume(n_GreaterZero(pGetCoeff(ph), r->cf)); // ??
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.