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

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