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

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