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

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