source: git/libpolys/polys/monomials/p_polys.cc @ 304ad9b

spielwiese
Last change on this file since 304ad9b was 304ad9b, checked in by Hans Schoenemann <hannes@…>, 13 years ago
p_MemCmp.h and p_MemCopy.h are now internal headers
  • Property mode set to 100644
File size: 79.4 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 the head term of b is a multiple of the head term of a
1313* and return the multiplicant *m
1314* Frank's observation: If LM(b) = LM(a)*m, then we may actually set
1315* negative(!) exponents in the below loop. I suspect that the correct
1316* comment should be "assumes that LM(a) = LM(b)*m, for some monomial m..."
1317*/
1318poly p_Divide(poly a, poly b, const ring r)
1319{
1320  assume((p_GetComp(a,r)==p_GetComp(b,r)) || (p_GetComp(b,r)==0));
1321  int i;
1322  poly result = p_Init(r);
1323
1324  for(i=(int)r->N; i; i--)
1325    p_SetExp(result,i, p_GetExp(a,i,r)- p_GetExp(b,i,r),r);
1326  p_SetComp(result, p_GetComp(a,r) - p_GetComp(b,r),r);
1327  p_Setm(result,r);
1328  return result;
1329}
1330
1331poly p_Div_nn(poly p, const number n, const ring r)
1332{
1333  pAssume(!n_IsZero(n,r->cf));
1334  p_Test(p, r);
1335
1336  poly q = p;
1337  while (p != NULL)
1338  {
1339    number nc = pGetCoeff(p);
1340    pSetCoeff0(p, n_Div(nc, n, r->cf));
1341    n_Delete(&nc, r->cf);
1342    pIter(p);
1343  }
1344  p_Test(q, r);
1345  return q;
1346}
1347
1348/*2
1349* divides a by the monomial b, ignores monomials which are not divisible
1350* assumes that b is not NULL, destroyes b
1351*/
1352poly p_DivideM(poly a, poly b, const ring r)
1353{
1354  if (a==NULL) { p_Delete(&b,r); return NULL; }
1355  poly result=a;
1356  poly prev=NULL;
1357  int i;
1358#ifdef HAVE_RINGS
1359  number inv=pGetCoeff(b);
1360#else
1361  number inv=n_Invers(pGetCoeff(b),r->cf);
1362#endif
1363
1364  while (a!=NULL)
1365  {
1366    if (p_DivisibleBy(b,a,r))
1367    {
1368      for(i=(int)r->N; i; i--)
1369         p_SubExp(a,i, p_GetExp(b,i,r),r);
1370      p_SubComp(a, p_GetComp(b,r),r);
1371      p_Setm(a,r);
1372      prev=a;
1373      pIter(a);
1374    }
1375    else
1376    {
1377      if (prev==NULL)
1378      {
1379        p_LmDelete(&result,r);
1380        a=result;
1381      }
1382      else
1383      {
1384        p_LmDelete(&pNext(prev),r);
1385        a=pNext(prev);
1386      }
1387    }
1388  }
1389#ifdef HAVE_RINGS
1390  if (n_IsUnit(inv,r->cf))
1391  {
1392    inv = n_Invers(inv,r->cf);
1393    p_Mult_nn(result,inv,r);
1394    n_Delete(&inv, r->cf);
1395  }
1396  else
1397  {
1398    p_Div_nn(result,inv,r);
1399  }
1400#else
1401  p_Mult_nn(result,inv,r);
1402  n_Delete(&inv, r->cf);
1403#endif
1404  p_Delete(&b, r);
1405  return result;
1406}
1407
1408#ifdef HAVE_RINGS
1409/* TRUE iff LT(f) | LT(g) */
1410BOOLEAN p_DivisibleByRingCase(poly f, poly g, const ring r)
1411{
1412  int exponent;
1413  for(int i = (int)rVar(r); i>0; i--)
1414  {
1415    exponent = p_GetExp(g, i, r) - p_GetExp(f, i, r);
1416    if (exponent < 0) return FALSE;
1417  }
1418  return n_DivBy(pGetCoeff(g), pGetCoeff(f), r->cf);
1419}
1420#endif
1421
1422/*2
1423* returns the LCM of the head terms of a and b in *m
1424*/
1425void p_Lcm(poly a, poly b, poly m, const ring r)
1426{
1427  int i;
1428  for (i=rVar(r); i; i--)
1429  {
1430    p_SetExp(m,i, si_max( p_GetExp(a,i,r), p_GetExp(b,i,r)),r);
1431  }
1432  p_SetComp(m, si_max(p_GetComp(a,r), p_GetComp(b,r)),r);
1433  /* Don't do a pSetm here, otherwise hres/lres chockes */
1434}
1435
1436/* assumes that p and divisor are univariate polynomials in r,
1437   mentioning the same variable;
1438   assumes divisor != NULL;
1439   p may be NULL;
1440   assumes a global monomial ordering in r;
1441   performs polynomial division of p by divisor:
1442     - afterwards p contains the remainder of the division, i.e.,
1443       p_before = result * divisor + p_afterwards;
1444     - if needResult == TRUE, then the method computes and returns 'result',
1445       otherwise NULL is returned (This parametrization can be used when
1446       one is only interested in the remainder of the division. In this
1447       case, the method will be slightly faster.)
1448   leaves divisor unmodified */
1449poly p_PolyDiv(poly &p, poly divisor, BOOLEAN needResult, ring r)
1450{
1451  assume(divisor != NULL);
1452  if (p == NULL) return NULL;
1453 
1454  poly result = NULL;
1455  number divisorLC = p_GetCoeff(divisor, r);
1456  int divisorLE = p_GetExp(divisor, 1, r);
1457  while ((p != NULL) && (p_Deg(p, r) >= p_Deg(divisor, r)))
1458  {
1459    /* determine t = LT(p) / LT(divisor) */
1460    poly t = p_ISet(1, r);
1461    number c = n_Div(p_GetCoeff(p, r), divisorLC, r->cf);
1462    p_SetCoeff(t, c, r);
1463    int e = p_GetExp(p, 1, r) - divisorLE;
1464    p_SetExp(t, 1, e, r);
1465    p_Setm(t, r);
1466    if (needResult) result = p_Add_q(result, p_Copy(t, r), r);
1467    p = p_Add_q(p, p_Neg(p_Mult_q(t, p_Copy(divisor, r), r), r), r);
1468  }
1469  return result;
1470}
1471
1472/* returns NULL if p == NULL, otherwise makes p monic by dividing
1473   by its leading coefficient (only done if this is not already 1);
1474   this assumes that we are over a ground field so that division
1475   is well-defined;
1476   modifies p */
1477void p_Monic(poly &p, ring r)
1478{
1479  if (p == NULL) return;
1480  poly pp = p;
1481  number lc = p_GetCoeff(p, r);
1482  if (n_IsOne(lc, r->cf)) return;
1483  number lcInverse = n_Invers(lc, r->cf);
1484  number n = n_Init(1, r->cf);
1485  p_SetCoeff(p, n, r);   // destroys old leading coefficient!
1486  p = pIter(p);
1487  while (p != NULL)
1488  {
1489    number n = n_Mult(p_GetCoeff(p, r), lcInverse, r->cf);
1490    p_SetCoeff(p, n, r);   // destroys old leading coefficient!
1491    p = pIter(p);
1492  }
1493  n_Delete(&lcInverse, r->cf);
1494  p = pp;
1495}
1496
1497/* see p_Gcd;
1498   additional assumption: deg(p) >= deg(q);
1499   must destroy p and q (unless one of them is returned) */
1500poly p_GcdHelper(poly &p, poly &q, ring r)
1501{
1502  if (q == NULL)
1503  {
1504    /* We have to make p monic before we return it, so that if the
1505       gcd is a unit in the ground field, we will actually return 1. */
1506    p_Monic(p, r);
1507    return p;
1508  }
1509  else
1510  {
1511    p_PolyDiv(p, q, FALSE, r);
1512    return p_GcdHelper(q, p, r);
1513  }
1514}
1515
1516/* assumes that p and q are univariate polynomials in r,
1517   mentioning the same variable;
1518   assumes a global monomial ordering in r;
1519   assumes that not both p and q are NULL;
1520   returns the gcd of p and q;
1521   leaves p and q unmodified */
1522poly p_Gcd(poly p, poly q, ring r)
1523{
1524  assume((p != NULL) || (q != NULL));
1525 
1526  poly a = p; poly b = q;
1527  if (p_Deg(a, r) < p_Deg(b, r)) { a = q; b = p; }
1528  a = p_Copy(a, r); b = p_Copy(b, r);
1529  return p_GcdHelper(a, b, r);
1530}
1531
1532/* see p_ExtGcd;
1533   additional assumption: deg(p) >= deg(q);
1534   must destroy p and q (unless one of them is returned) */
1535poly p_ExtGcdHelper(poly &p, poly &pFactor, poly &q, poly &qFactor,
1536                    ring r)
1537{
1538  if (q == NULL)
1539  {
1540    qFactor = NULL;
1541    pFactor = p_ISet(1, r);
1542    p_SetCoeff(pFactor, n_Invers(p_GetCoeff(p, r), r->cf), r);
1543    p_Monic(p, r);
1544    return p;
1545  }
1546  else
1547  {
1548    poly pDivQ = p_PolyDiv(p, q, TRUE, r);
1549    poly ppFactor = NULL; poly qqFactor = NULL;
1550    poly theGcd = p_ExtGcdHelper(q, qqFactor, p, ppFactor, r);
1551    pFactor = ppFactor;
1552    qFactor = p_Add_q(qqFactor,
1553                      p_Neg(p_Mult_q(pDivQ, p_Copy(ppFactor, r), r), r),
1554                      r);
1555    return theGcd;
1556  }
1557}
1558
1559/* assumes that p and q are univariate polynomials in r,
1560   mentioning the same variable;
1561   assumes a global monomial ordering in r;
1562   assumes that not both p and q are NULL;
1563   returns the gcd of p and q;
1564   moreover, afterwards pFactor and qFactor contain appropriate
1565   factors such that gcd(p, q) = p * pFactor + q * qFactor;
1566   leaves p and q unmodified */
1567poly p_ExtGcd(poly p, poly &pFactor, poly q, poly &qFactor, ring r)
1568{
1569  assume((p != NULL) || (q != NULL)); 
1570  poly a = p; poly b = q; BOOLEAN aCorrespondsToP = TRUE;
1571  if (p_Deg(a, r) < p_Deg(b, r))
1572  { a = q; b = p; aCorrespondsToP = FALSE; }
1573  a = p_Copy(a, r); b = p_Copy(b, r);
1574  poly aFactor = NULL; poly bFactor = NULL;
1575  poly theGcd = p_ExtGcdHelper(a, aFactor, b, bFactor, r);
1576  if (aCorrespondsToP) { pFactor = aFactor; qFactor = bFactor; }
1577  else                 { pFactor = bFactor; qFactor = aFactor; }
1578  return theGcd;
1579}
1580
1581/*2
1582* returns the partial differentiate of a by the k-th variable
1583* does not destroy the input
1584*/
1585poly p_Diff(poly a, int k, const ring r)
1586{
1587  poly res, f, last;
1588  number t;
1589
1590  last = res = NULL;
1591  while (a!=NULL)
1592  {
1593    if (p_GetExp(a,k,r)!=0)
1594    {
1595      f = p_LmInit(a,r);
1596      t = n_Init(p_GetExp(a,k,r),r->cf);
1597      pSetCoeff0(f,n_Mult(t,pGetCoeff(a),r->cf));
1598      n_Delete(&t,r->cf);
1599      if (n_IsZero(pGetCoeff(f),r->cf))
1600        p_LmDelete(&f,r);
1601      else
1602      {
1603        p_DecrExp(f,k,r);
1604        p_Setm(f,r);
1605        if (res==NULL)
1606        {
1607          res=last=f;
1608        }
1609        else
1610        {
1611          pNext(last)=f;
1612          last=f;
1613        }
1614      }
1615    }
1616    pIter(a);
1617  }
1618  return res;
1619}
1620
1621static poly p_DiffOpM(poly a, poly b,BOOLEAN multiply, const ring r)
1622{
1623  int i,j,s;
1624  number n,h,hh;
1625  poly p=p_One(r);
1626  n=n_Mult(pGetCoeff(a),pGetCoeff(b),r->cf);
1627  for(i=rVar(r);i>0;i--)
1628  {
1629    s=p_GetExp(b,i,r);
1630    if (s<p_GetExp(a,i,r))
1631    {
1632      n_Delete(&n,r->cf);
1633      p_LmDelete(&p,r);
1634      return NULL;
1635    }
1636    if (multiply)
1637    {
1638      for(j=p_GetExp(a,i,r); j>0;j--)
1639      {
1640        h = n_Init(s,r->cf);
1641        hh=n_Mult(n,h,r->cf);
1642        n_Delete(&h,r->cf);
1643        n_Delete(&n,r->cf);
1644        n=hh;
1645        s--;
1646      }
1647      p_SetExp(p,i,s,r);
1648    }
1649    else
1650    {
1651      p_SetExp(p,i,s-p_GetExp(a,i,r),r);
1652    }
1653  }
1654  p_Setm(p,r);
1655  /*if (multiply)*/ p_SetCoeff(p,n,r);
1656  if (n_IsZero(n,r->cf))  p=p_LmDeleteAndNext(p,r); // return NULL as p is a monomial
1657  return p;
1658}
1659
1660poly p_DiffOp(poly a, poly b,BOOLEAN multiply, const ring r)
1661{
1662  poly result=NULL;
1663  poly h;
1664  for(;a!=NULL;pIter(a))
1665  {
1666    for(h=b;h!=NULL;pIter(h))
1667    {
1668      result=p_Add_q(result,p_DiffOpM(a,h,multiply,r),r);
1669    }
1670  }
1671  return result;
1672}
1673/*2
1674* subtract p2 from p1, p1 and p2 are destroyed
1675* do not put attention on speed: the procedure is only used in the interpreter
1676*/
1677poly p_Sub(poly p1, poly p2, const ring r)
1678{
1679  return p_Add_q(p1, p_Neg(p2,r),r);
1680}
1681
1682/*3
1683* compute for a monomial m
1684* the power m^exp, exp > 1
1685* destroys p
1686*/
1687static poly p_MonPower(poly p, int exp, const ring r)
1688{
1689  int i;
1690
1691  if(!n_IsOne(pGetCoeff(p),r->cf))
1692  {
1693    number x, y;
1694    y = pGetCoeff(p);
1695    n_Power(y,exp,&x,r->cf);
1696    n_Delete(&y,r->cf);
1697    pSetCoeff0(p,x);
1698  }
1699  for (i=rVar(r); i!=0; i--)
1700  {
1701    p_MultExp(p,i, exp,r);
1702  }
1703  p_Setm(p,r);
1704  return p;
1705}
1706
1707/*3
1708* compute for monomials p*q
1709* destroys p, keeps q
1710*/
1711static void p_MonMult(poly p, poly q, const ring r)
1712{
1713  number x, y;
1714
1715  y = pGetCoeff(p);
1716  x = n_Mult(y,pGetCoeff(q),r->cf);
1717  n_Delete(&y,r->cf);
1718  pSetCoeff0(p,x);
1719  //for (int i=pVariables; i!=0; i--)
1720  //{
1721  //  pAddExp(p,i, pGetExp(q,i));
1722  //}
1723  //p->Order += q->Order;
1724  p_ExpVectorAdd(p,q,r);
1725}
1726
1727/*3
1728* compute for monomials p*q
1729* keeps p, q
1730*/
1731static poly p_MonMultC(poly p, poly q, const ring rr)
1732{
1733  number x;
1734  poly r = p_Init(rr);
1735
1736  x = n_Mult(pGetCoeff(p),pGetCoeff(q),rr->cf);
1737  pSetCoeff0(r,x);
1738  p_ExpVectorSum(r,p, q, rr);
1739  return r;
1740}
1741
1742/*3
1743*  create binomial coef.
1744*/
1745static number* pnBin(int exp, const ring r)
1746{
1747  int e, i, h;
1748  number x, y, *bin=NULL;
1749
1750  x = n_Init(exp,r->cf);
1751  if (n_IsZero(x,r->cf))
1752  {
1753    n_Delete(&x,r->cf);
1754    return bin;
1755  }
1756  h = (exp >> 1) + 1;
1757  bin = (number *)omAlloc0(h*sizeof(number));
1758  bin[1] = x;
1759  if (exp < 4)
1760    return bin;
1761  i = exp - 1;
1762  for (e=2; e<h; e++)
1763  {
1764      x = n_Init(i,r->cf);
1765      i--;
1766      y = n_Mult(x,bin[e-1],r->cf);
1767      n_Delete(&x,r->cf);
1768      x = n_Init(e,r->cf);
1769      bin[e] = n_IntDiv(y,x,r->cf);
1770      n_Delete(&x,r->cf);
1771      n_Delete(&y,r->cf);
1772  }
1773  return bin;
1774}
1775
1776static void pnFreeBin(number *bin, int exp,const coeffs r)
1777{
1778  int e, h = (exp >> 1) + 1;
1779
1780  if (bin[1] != NULL)
1781  {
1782    for (e=1; e<h; e++)
1783      n_Delete(&(bin[e]),r);
1784  }
1785  omFreeSize((ADDRESS)bin, h*sizeof(number));
1786}
1787
1788/*
1789*  compute for a poly p = head+tail, tail is monomial
1790*          (head + tail)^exp, exp > 1
1791*          with binomial coef.
1792*/
1793static poly p_TwoMonPower(poly p, int exp, const ring r)
1794{
1795  int eh, e;
1796  long al;
1797  poly *a;
1798  poly tail, b, res, h;
1799  number x;
1800  number *bin = pnBin(exp,r);
1801
1802  tail = pNext(p);
1803  if (bin == NULL)
1804  {
1805    p_MonPower(p,exp,r);
1806    p_MonPower(tail,exp,r);
1807#ifdef PDEBUG
1808    p_Test(p,r);
1809#endif
1810    return p;
1811  }
1812  eh = exp >> 1;
1813  al = (exp + 1) * sizeof(poly);
1814  a = (poly *)omAlloc(al);
1815  a[1] = p;
1816  for (e=1; e<exp; e++)
1817  {
1818    a[e+1] = p_MonMultC(a[e],p,r);
1819  }
1820  res = a[exp];
1821  b = p_Head(tail,r);
1822  for (e=exp-1; e>eh; e--)
1823  {
1824    h = a[e];
1825    x = n_Mult(bin[exp-e],pGetCoeff(h),r->cf);
1826    p_SetCoeff(h,x,r);
1827    p_MonMult(h,b,r);
1828    res = pNext(res) = h;
1829    p_MonMult(b,tail,r);
1830  }
1831  for (e=eh; e!=0; e--)
1832  {
1833    h = a[e];
1834    x = n_Mult(bin[e],pGetCoeff(h),r->cf);
1835    p_SetCoeff(h,x,r);
1836    p_MonMult(h,b,r);
1837    res = pNext(res) = h;
1838    p_MonMult(b,tail,r);
1839  }
1840  p_LmDelete(&tail,r);
1841  pNext(res) = b;
1842  pNext(b) = NULL;
1843  res = a[exp];
1844  omFreeSize((ADDRESS)a, al);
1845  pnFreeBin(bin, exp, r->cf);
1846//  tail=res;
1847// while((tail!=NULL)&&(pNext(tail)!=NULL))
1848// {
1849//   if(nIsZero(pGetCoeff(pNext(tail))))
1850//   {
1851//     pLmDelete(&pNext(tail));
1852//   }
1853//   else
1854//     pIter(tail);
1855// }
1856#ifdef PDEBUG
1857  p_Test(res,r);
1858#endif
1859  return res;
1860}
1861
1862static poly p_Pow(poly p, int i, const ring r)
1863{
1864  poly rc = p_Copy(p,r);
1865  i -= 2;
1866  do
1867  {
1868    rc = p_Mult_q(rc,p_Copy(p,r),r);
1869    p_Normalize(rc,r);
1870    i--;
1871  }
1872  while (i != 0);
1873  return p_Mult_q(rc,p,r);
1874}
1875
1876/*2
1877* returns the i-th power of p
1878* p will be destroyed
1879*/
1880poly p_Power(poly p, int i, const ring r)
1881{
1882  poly rc=NULL;
1883
1884  if (i==0)
1885  {
1886    p_Delete(&p,r);
1887    return p_One(r);
1888  }
1889
1890  if(p!=NULL)
1891  {
1892    if ( (i > 0) && ((unsigned long ) i > (r->bitmask)))
1893    {
1894      Werror("exponent %d is too large, max. is %ld",i,r->bitmask);
1895      return NULL;
1896    }
1897    switch (i)
1898    {
1899// cannot happen, see above
1900//      case 0:
1901//      {
1902//        rc=pOne();
1903//        pDelete(&p);
1904//        break;
1905//      }
1906      case 1:
1907        rc=p;
1908        break;
1909      case 2:
1910        rc=p_Mult_q(p_Copy(p,r),p,r);
1911        break;
1912      default:
1913        if (i < 0)
1914        {
1915          p_Delete(&p,r);
1916          return NULL;
1917        }
1918        else
1919        {
1920#ifdef HAVE_PLURAL
1921          if (rIsPluralRing(r)) /* in the NC case nothing helps :-( */
1922          {
1923            int j=i;
1924            rc = p_Copy(p,r);
1925            while (j>1)
1926            {
1927              rc = p_Mult_q(p_Copy(p,r),rc,r);
1928              j--;
1929            }
1930            p_Delete(&p,r);
1931            return rc;
1932          }
1933#endif
1934          rc = pNext(p);
1935          if (rc == NULL)
1936            return p_MonPower(p,i,r);
1937          /* else: binom ?*/
1938          int char_p=rChar(r);
1939          if ((pNext(rc) != NULL)
1940#ifdef HAVE_RINGS
1941             || rField_is_Ring(r)
1942#endif
1943             )
1944            return p_Pow(p,i,r);
1945          if ((char_p==0) || (i<=char_p))
1946            return p_TwoMonPower(p,i,r);
1947          poly p_p=p_TwoMonPower(p_Copy(p,r),char_p,r);
1948          return p_Mult_q(p_Power(p,i-char_p,r),p_p,r);
1949        }
1950      /*end default:*/
1951    }
1952  }
1953  return rc;
1954}
1955
1956/* --------------------------------------------------------------------------------*/
1957/* content suff                                                                   */
1958
1959static number p_InitContent(poly ph, const ring r);
1960static number p_InitContent_a(poly ph, const ring r);
1961
1962void p_Content(poly ph, const ring r)
1963{
1964#ifdef HAVE_RINGS
1965  if (rField_is_Ring(r))
1966  {
1967    if ((ph!=NULL) && rField_has_Units(r))
1968    {
1969      number k = n_GetUnit(pGetCoeff(ph),r->cf);
1970      if (!n_IsOne(k,r->cf))
1971      {
1972        number tmpGMP = k;
1973        k = n_Invers(k,r->cf);
1974        n_Delete(&tmpGMP,r->cf);
1975        poly h = pNext(ph);
1976        p_SetCoeff(ph, n_Mult(pGetCoeff(ph), k,r->cf),r);
1977        while (h != NULL)
1978        {
1979          p_SetCoeff(h, n_Mult(pGetCoeff(h), k,r->cf),r);
1980          pIter(h);
1981        }
1982      }
1983      n_Delete(&k,r->cf);
1984    }
1985    return;
1986  }
1987#endif
1988  number h,d;
1989  poly p;
1990
1991  if(TEST_OPT_CONTENTSB) return;
1992  if(pNext(ph)==NULL)
1993  {
1994    p_SetCoeff(ph,n_Init(1,r->cf),r);
1995  }
1996  else
1997  {
1998    n_Normalize(pGetCoeff(ph),r->cf);
1999    if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2000    if (rField_is_Q(r))
2001    {
2002      h=p_InitContent(ph,r);
2003      p=ph;
2004    }
2005    else if (rField_is_Extension(r)
2006             &&
2007             (
2008              (rPar(r)>1) || rMinpolyIsNULL(r)
2009             )
2010            )
2011    {
2012      h=p_InitContent_a(ph,r);
2013      p=ph;
2014    }
2015    else
2016    {
2017      h=n_Copy(pGetCoeff(ph),r->cf);
2018      p = pNext(ph);
2019    }
2020    while (p!=NULL)
2021    {
2022      n_Normalize(pGetCoeff(p),r->cf);
2023      d=n_Gcd(h,pGetCoeff(p),r->cf);
2024      n_Delete(&h,r->cf);
2025      h = d;
2026      if(n_IsOne(h,r->cf))
2027      {
2028        break;
2029      }
2030      pIter(p);
2031    }
2032    p = ph;
2033    //number tmp;
2034    if(!n_IsOne(h,r->cf))
2035    {
2036      while (p!=NULL)
2037      {
2038        //d = nDiv(pGetCoeff(p),h);
2039        //tmp = nIntDiv(pGetCoeff(p),h);
2040        //if (!nEqual(d,tmp))
2041        //{
2042        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
2043        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
2044        //  nWrite(tmp);Print(StringAppendS("\n"));
2045        //}
2046        //nDelete(&tmp);
2047        d = n_IntDiv(pGetCoeff(p),h,r->cf);
2048        p_SetCoeff(p,d,r);
2049        pIter(p);
2050      }
2051    }
2052    n_Delete(&h,r->cf);
2053#ifdef HAVE_FACTORY
2054    if ( (n_GetChar(r) == 1) || (n_GetChar(r) < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
2055    {
2056      singclap_divide_content(ph, r);
2057      if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2058    }
2059#endif
2060    if (rField_is_Q_a(r))
2061    {
2062      //number hzz = nlInit(1, r->cf);
2063      h = nlInit(1, r->cf);
2064      p=ph;
2065      Werror("longalg missing 1");
2066      #if 0
2067      while (p!=NULL)
2068      { // each monom: coeff in Q_a
2069        lnumber c_n_n=(lnumber)pGetCoeff(p);
2070        poly c_n=c_n_n->z;
2071        while (c_n!=NULL)
2072        { // each monom: coeff in Q
2073          d=nlLcm(hzz,pGetCoeff(c_n),r->extRing->cf);
2074          n_Delete(&hzz,r->extRing->cf);
2075          hzz=d;
2076          pIter(c_n);
2077        }
2078        c_n=c_n_n->n;
2079        while (c_n!=NULL)
2080        { // each monom: coeff in Q
2081          d=nlLcm(h,pGetCoeff(c_n),r->extRing->cf);
2082          n_Delete(&h,r->extRing->cf);
2083          h=d;
2084          pIter(c_n);
2085        }
2086        pIter(p);
2087      }
2088      /* hzz contains the 1/lcm of all denominators in c_n_n->z*/
2089      /* h contains the 1/lcm of all denominators in c_n_n->n*/
2090      number htmp=nlInvers(h,r->extRing->cf);
2091      number hzztmp=nlInvers(hzz,r->extRing->cf);
2092      number hh=nlMult(hzz,h,r->extRing->cf);
2093      nlDelete(&hzz,r->extRing->cf);
2094      nlDelete(&h,r->extRing->cf);
2095      number hg=nlGcd(hzztmp,htmp,r->extRing->cf);
2096      nlDelete(&hzztmp,r->extRing->cf);
2097      nlDelete(&htmp,r->extRing->cf);
2098      h=nlMult(hh,hg,r->extRing->cf);
2099      nlDelete(&hg,r->extRing->cf);
2100      nlDelete(&hh,r->extRing->cf);
2101      nlNormalize(h,r->extRing->cf);
2102      if(!nlIsOne(h,r->extRing->cf))
2103      {
2104        p=ph;
2105        while (p!=NULL)
2106        { // each monom: coeff in Q_a
2107          lnumber c_n_n=(lnumber)pGetCoeff(p);
2108          poly c_n=c_n_n->z;
2109          while (c_n!=NULL)
2110          { // each monom: coeff in Q
2111            d=nlMult(h,pGetCoeff(c_n),r->extRing->cf);
2112            nlNormalize(d,r->extRing->cf);
2113            nlDelete(&pGetCoeff(c_n),r->extRing->cf);
2114            pGetCoeff(c_n)=d;
2115            pIter(c_n);
2116          }
2117          c_n=c_n_n->n;
2118          while (c_n!=NULL)
2119          { // each monom: coeff in Q
2120            d=nlMult(h,pGetCoeff(c_n),r->extRing->cf);
2121            nlNormalize(d,r->extRing->cf);
2122            nlDelete(&pGetCoeff(c_n),r->extRing->cf);
2123            pGetCoeff(c_n)=d;
2124            pIter(c_n);
2125          }
2126          pIter(p);
2127        }
2128      }
2129      nlDelete(&h,r->extRing->cf);
2130      #endif
2131    }
2132  }
2133}
2134#if 0 // currently not used
2135void p_SimpleContent(poly ph,int smax, const ring r)
2136{
2137  if(TEST_OPT_CONTENTSB) return;
2138  if (ph==NULL) return;
2139  if (pNext(ph)==NULL)
2140  {
2141    p_SetCoeff(ph,n_Init(1,r_cf),r);
2142    return;
2143  }
2144  if ((pNext(pNext(ph))==NULL)||(!rField_is_Q(r)))
2145  {
2146    return;
2147  }
2148  number d=p_InitContent(ph,r);
2149  if (nlSize(d,r->cf)<=smax)
2150  {
2151    //if (TEST_OPT_PROT) PrintS("G");
2152    return;
2153  }
2154  poly p=ph;
2155  number h=d;
2156  if (smax==1) smax=2;
2157  while (p!=NULL)
2158  {
2159#if 0
2160    d=nlGcd(h,pGetCoeff(p),r->cf);
2161    nlDelete(&h,r->cf);
2162    h = d;
2163#else
2164    nlInpGcd(h,pGetCoeff(p),r->cf);
2165#endif
2166    if(nlSize(h,r->cf)<smax)
2167    {
2168      //if (TEST_OPT_PROT) PrintS("g");
2169      return;
2170    }
2171    pIter(p);
2172  }
2173  p = ph;
2174  if (!nlGreaterZero(pGetCoeff(p),r->cf)) h=nlNeg(h,r->cf);
2175  if(nlIsOne(h,r->cf)) return;
2176  //if (TEST_OPT_PROT) PrintS("c");
2177  while (p!=NULL)
2178  {
2179#if 1
2180    d = nlIntDiv(pGetCoeff(p),h,r->cf);
2181    p_SetCoeff(p,d,r);
2182#else
2183    nlInpIntDiv(pGetCoeff(p),h,r->cf);
2184#endif
2185    pIter(p);
2186  }
2187  nlDelete(&h,r->cf);
2188}
2189#endif
2190
2191static number p_InitContent(poly ph, const ring r)
2192// only for coefficients in Q
2193#if 0
2194{
2195  assume(!TEST_OPT_CONTENTSB);
2196  assume(ph!=NULL);
2197  assume(pNext(ph)!=NULL);
2198  assume(rField_is_Q(r));
2199  if (pNext(pNext(ph))==NULL)
2200  {
2201    return nlGetNom(pGetCoeff(pNext(ph)),r->cf);
2202  }
2203  poly p=ph;
2204  number n1=nlGetNom(pGetCoeff(p),r->cf);
2205  pIter(p);
2206  number n2=nlGetNom(pGetCoeff(p),r->cf);
2207  pIter(p);
2208  number d;
2209  number t;
2210  loop
2211  {
2212    nlNormalize(pGetCoeff(p),r->cf);
2213    t=nlGetNom(pGetCoeff(p),r->cf);
2214    if (nlGreaterZero(t,r->cf))
2215      d=nlAdd(n1,t,r->cf);
2216    else
2217      d=nlSub(n1,t,r->cf);
2218    nlDelete(&t,r->cf);
2219    nlDelete(&n1,r->cf);
2220    n1=d;
2221    pIter(p);
2222    if (p==NULL) break;
2223    nlNormalize(pGetCoeff(p),r->cf);
2224    t=nlGetNom(pGetCoeff(p),r->cf);
2225    if (nlGreaterZero(t,r->cf))
2226      d=nlAdd(n2,t,r->cf);
2227    else
2228      d=nlSub(n2,t,r->cf);
2229    nlDelete(&t,r->cf);
2230    nlDelete(&n2,r->cf);
2231    n2=d;
2232    pIter(p);
2233    if (p==NULL) break;
2234  }
2235  d=nlGcd(n1,n2,r->cf);
2236  nlDelete(&n1,r->cf);
2237  nlDelete(&n2,r->cf);
2238  return d;
2239}
2240#else
2241{
2242  number d=pGetCoeff(ph);
2243  if(SR_HDL(d)&SR_INT) return d;
2244  int s=mpz_size1(d->z);
2245  int s2=-1;
2246  number d2;
2247  loop
2248  {
2249    pIter(ph);
2250    if(ph==NULL)
2251    {
2252      if (s2==-1) return nlCopy(d,r->cf);
2253      break;
2254    }
2255    if (SR_HDL(pGetCoeff(ph))&SR_INT)
2256    {
2257      s2=s;
2258      d2=d;
2259      s=0;
2260      d=pGetCoeff(ph);
2261      if (s2==0) break;
2262    }
2263    else
2264    if (mpz_size1((pGetCoeff(ph)->z))<=s)
2265    {
2266      s2=s;
2267      d2=d;
2268      d=pGetCoeff(ph);
2269      s=mpz_size1(d->z);
2270    }
2271  }
2272  return nlGcd(d,d2,r->cf);
2273}
2274#endif
2275
2276number p_InitContent_a(poly ph, const ring r)
2277// only for coefficients in K(a) anf K(a,...)
2278{
2279  number d=pGetCoeff(ph);
2280  int s=n_ParDeg(d,r->cf);
2281  if (s /* n_ParDeg(d)*/ <=1) return n_Copy(d,r->cf);
2282  int s2=-1;
2283  number d2;
2284  int ss;
2285  loop
2286  {
2287    pIter(ph);
2288    if(ph==NULL)
2289    {
2290      if (s2==-1) return n_Copy(d,r->cf);
2291      break;
2292    }
2293    if ((ss=n_ParDeg(pGetCoeff(ph),r->cf))<s)
2294    {
2295      s2=s;
2296      d2=d;
2297      s=ss;
2298      d=pGetCoeff(ph);
2299      if (s2<=1) break;
2300    }
2301  }
2302  return n_Gcd(d,d2,r->cf);
2303}
2304
2305
2306//void pContent(poly ph)
2307//{
2308//  number h,d;
2309//  poly p;
2310//
2311//  p = ph;
2312//  if(pNext(p)==NULL)
2313//  {
2314//    pSetCoeff(p,nInit(1));
2315//  }
2316//  else
2317//  {
2318//#ifdef PDEBUG
2319//    if (!pTest(p)) return;
2320//#endif
2321//    nNormalize(pGetCoeff(p));
2322//    if(!nGreaterZero(pGetCoeff(ph)))
2323//    {
2324//      ph = pNeg(ph);
2325//      nNormalize(pGetCoeff(p));
2326//    }
2327//    h=pGetCoeff(p);
2328//    pIter(p);
2329//    while (p!=NULL)
2330//    {
2331//      nNormalize(pGetCoeff(p));
2332//      if (nGreater(h,pGetCoeff(p))) h=pGetCoeff(p);
2333//      pIter(p);
2334//    }
2335//    h=nCopy(h);
2336//    p=ph;
2337//    while (p!=NULL)
2338//    {
2339//      d=n_Gcd(h,pGetCoeff(p));
2340//      nDelete(&h);
2341//      h = d;
2342//      if(nIsOne(h))
2343//      {
2344//        break;
2345//      }
2346//      pIter(p);
2347//    }
2348//    p = ph;
2349//    //number tmp;
2350//    if(!nIsOne(h))
2351//    {
2352//      while (p!=NULL)
2353//      {
2354//        d = nIntDiv(pGetCoeff(p),h);
2355//        pSetCoeff(p,d);
2356//        pIter(p);
2357//      }
2358//    }
2359//    nDelete(&h);
2360//#ifdef HAVE_FACTORY
2361//    if ( (nGetChar() == 1) || (nGetChar() < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
2362//    {
2363//      pTest(ph);
2364//      singclap_divide_content(ph);
2365//      pTest(ph);
2366//    }
2367//#endif
2368//  }
2369//}
2370#if 0
2371void p_Content(poly ph, const ring r)
2372{
2373  number h,d;
2374  poly p;
2375
2376  if(pNext(ph)==NULL)
2377  {
2378    p_SetCoeff(ph,n_Init(1,r->cf),r);
2379  }
2380  else
2381  {
2382    n_Normalize(pGetCoeff(ph),r->cf);
2383    if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2384    h=n_Copy(pGetCoeff(ph),r->cf);
2385    p = pNext(ph);
2386    while (p!=NULL)
2387    {
2388      n_Normalize(pGetCoeff(p),r->cf);
2389      d=n_Gcd(h,pGetCoeff(p),r->cf);
2390      n_Delete(&h,r->cf);
2391      h = d;
2392      if(n_IsOne(h,r->cf))
2393      {
2394        break;
2395      }
2396      pIter(p);
2397    }
2398    p = ph;
2399    //number tmp;
2400    if(!n_IsOne(h,r->cf))
2401    {
2402      while (p!=NULL)
2403      {
2404        //d = nDiv(pGetCoeff(p),h);
2405        //tmp = nIntDiv(pGetCoeff(p),h);
2406        //if (!nEqual(d,tmp))
2407        //{
2408        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
2409        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
2410        //  nWrite(tmp);Print(StringAppendS("\n"));
2411        //}
2412        //nDelete(&tmp);
2413        d = n_IntDiv(pGetCoeff(p),h,r->cf);
2414        p_SetCoeff(p,d,r->cf);
2415        pIter(p);
2416      }
2417    }
2418    n_Delete(&h,r->cf);
2419#ifdef HAVE_FACTORY
2420    //if ( (n_GetChar(r) == 1) || (n_GetChar(r) < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
2421    //{
2422    //  singclap_divide_content(ph);
2423    //  if(!n_GreaterZero(pGetCoeff(ph),r)) ph = p_Neg(ph,r);
2424    //}
2425#endif
2426  }
2427}
2428#endif
2429/* ---------------------------------------------------------------------------*/
2430/* cleardenom suff                                                           */
2431poly p_Cleardenom(poly ph, const ring r)
2432{
2433  poly start=ph;
2434  number d, h;
2435  poly p;
2436
2437#ifdef HAVE_RINGS
2438  if (rField_is_Ring(r))
2439  {
2440    p_Content(ph,r);
2441    return start;
2442  }
2443#endif
2444  if (rField_is_Zp(r) && TEST_OPT_INTSTRATEGY) return start;
2445  p = ph;
2446  if(pNext(p)==NULL)
2447  {
2448    if (TEST_OPT_CONTENTSB)
2449    {
2450      number n=n_GetDenom(pGetCoeff(p),r->cf);
2451      if (!n_IsOne(n,r->cf))
2452      {
2453        number nn=n_Mult(pGetCoeff(p),n,r->cf);
2454        n_Normalize(nn,r->cf);
2455        p_SetCoeff(p,nn,r);
2456      }
2457      n_Delete(&n,r->cf);
2458    }
2459    else
2460      p_SetCoeff(p,n_Init(1,r->cf),r);
2461  }
2462  else
2463  {
2464    h = n_Init(1,r->cf);
2465    while (p!=NULL)
2466    {
2467      n_Normalize(pGetCoeff(p),r->cf);
2468      d=n_Lcm(h,pGetCoeff(p),r->cf);
2469      n_Delete(&h,r->cf);
2470      h=d;
2471      pIter(p);
2472    }
2473    /* contains the 1/lcm of all denominators */
2474    if(!n_IsOne(h,r->cf))
2475    {
2476      p = ph;
2477      while (p!=NULL)
2478      {
2479        /* should be:
2480        * number hh;
2481        * nGetDenom(p->coef,&hh);
2482        * nMult(&h,&hh,&d);
2483        * nNormalize(d);
2484        * nDelete(&hh);
2485        * nMult(d,p->coef,&hh);
2486        * nDelete(&d);
2487        * nDelete(&(p->coef));
2488        * p->coef =hh;
2489        */
2490        d=n_Mult(h,pGetCoeff(p),r->cf);
2491        n_Normalize(d,r->cf);
2492        p_SetCoeff(p,d,r);
2493        pIter(p);
2494      }
2495      n_Delete(&h,r->cf);
2496      if (n_GetChar(r->cf)==1)
2497      {
2498        loop
2499        {
2500          h = n_Init(1,r->cf);
2501          p=ph;
2502          while (p!=NULL)
2503          {
2504            d=n_Lcm(h,pGetCoeff(p),r->cf);
2505            n_Delete(&h,r->cf);
2506            h=d;
2507            pIter(p);
2508          }
2509          /* contains the 1/lcm of all denominators */
2510          if(!n_IsOne(h,r->cf))
2511          {
2512            p = ph;
2513            while (p!=NULL)
2514            {
2515              /* should be:
2516              * number hh;
2517              * nGetDenom(p->coef,&hh);
2518              * nMult(&h,&hh,&d);
2519              * nNormalize(d);
2520              * nDelete(&hh);
2521              * nMult(d,p->coef,&hh);
2522              * nDelete(&d);
2523              * nDelete(&(p->coef));
2524              * p->coef =hh;
2525              */
2526              d=n_Mult(h,pGetCoeff(p),r->cf);
2527              n_Normalize(d,r->cf);
2528              p_SetCoeff(p,d,r);
2529              pIter(p);
2530            }
2531            n_Delete(&h,r->cf);
2532          }
2533          else
2534          {
2535            n_Delete(&h,r->cf);
2536            break;
2537          }
2538        }
2539      }
2540    }
2541    if (h!=NULL) n_Delete(&h,r->cf);
2542
2543    p_Content(ph,r);
2544#ifdef HAVE_RATGRING
2545    if (rIsRatGRing(r))
2546    {
2547      /* quick unit detection in the rational case is done in gr_nc_bba */
2548      pContentRat(ph);
2549      start=ph;
2550    }
2551#endif
2552  }
2553  return start;
2554}
2555
2556void p_Cleardenom_n(poly ph,const ring r,number &c)
2557{
2558  number d, h;
2559  poly p;
2560
2561  p = ph;
2562  if(pNext(p)==NULL)
2563  {
2564    c=n_Invers(pGetCoeff(p),r->cf);
2565    p_SetCoeff(p,n_Init(1,r->cf),r);
2566  }
2567  else
2568  {
2569    h = n_Init(1,r->cf);
2570    while (p!=NULL)
2571    {
2572      n_Normalize(pGetCoeff(p),r->cf);
2573      d=n_Lcm(h,pGetCoeff(p),r->cf);
2574      n_Delete(&h,r->cf);
2575      h=d;
2576      pIter(p);
2577    }
2578    c=h;
2579    /* contains the 1/lcm of all denominators */
2580    if(!n_IsOne(h,r->cf))
2581    {
2582      p = ph;
2583      while (p!=NULL)
2584      {
2585        /* should be:
2586        * number hh;
2587        * nGetDenom(p->coef,&hh);
2588        * nMult(&h,&hh,&d);
2589        * nNormalize(d);
2590        * nDelete(&hh);
2591        * nMult(d,p->coef,&hh);
2592        * nDelete(&d);
2593        * nDelete(&(p->coef));
2594        * p->coef =hh;
2595        */
2596        d=n_Mult(h,pGetCoeff(p),r->cf);
2597        n_Normalize(d,r->cf);
2598        p_SetCoeff(p,d,r);
2599        pIter(p);
2600      }
2601      if (rField_is_Q_a(r))
2602      {
2603        loop
2604        {
2605          h = n_Init(1,r->cf);
2606          p=ph;
2607          while (p!=NULL)
2608          {
2609            d=n_Lcm(h,pGetCoeff(p),r->cf);
2610            n_Delete(&h,r->cf);
2611            h=d;
2612            pIter(p);
2613          }
2614          /* contains the 1/lcm of all denominators */
2615          if(!n_IsOne(h,r->cf))
2616          {
2617            p = ph;
2618            while (p!=NULL)
2619            {
2620              /* should be:
2621              * number hh;
2622              * nGetDenom(p->coef,&hh);
2623              * nMult(&h,&hh,&d);
2624              * nNormalize(d);
2625              * nDelete(&hh);
2626              * nMult(d,p->coef,&hh);
2627              * nDelete(&d);
2628              * nDelete(&(p->coef));
2629              * p->coef =hh;
2630              */
2631              d=n_Mult(h,pGetCoeff(p),r->cf);
2632              n_Normalize(d,r->cf);
2633              p_SetCoeff(p,d,r);
2634              pIter(p);
2635            }
2636            number t=n_Mult(c,h,r->cf);
2637            n_Delete(&c,r->cf);
2638            c=t;
2639          }
2640          else
2641          {
2642            break;
2643          }
2644          n_Delete(&h,r->cf);
2645        }
2646      }
2647    }
2648  }
2649}
2650
2651number p_GetAllDenom(poly ph, const ring r)
2652{
2653  number d=n_Init(1,r->cf);
2654  poly p = ph;
2655
2656  while (p!=NULL)
2657  {
2658    number h=n_GetDenom(pGetCoeff(p),r->cf);
2659    if (!n_IsOne(h,r->cf))
2660    {
2661      number dd=n_Mult(d,h,r->cf);
2662      n_Delete(&d,r->cf);
2663      d=dd;
2664    }
2665    n_Delete(&h,r->cf);
2666    pIter(p);
2667  }
2668  return d;
2669}
2670
2671int p_Size(poly p, const ring r)
2672{
2673  int count = 0;
2674  while ( p != NULL )
2675  {
2676    count+= n_Size( pGetCoeff( p ), r->cf );
2677    pIter( p );
2678  }
2679  return count;
2680}
2681
2682/*2
2683*make p homogeneous by multiplying the monomials by powers of x_varnum
2684*assume: deg(var(varnum))==1
2685*/
2686poly p_Homogen (poly p, int varnum, const ring r)
2687{
2688  pFDegProc deg;
2689  if (r->pLexOrder && (r->order[0]==ringorder_lp))
2690    deg=p_Totaldegree;
2691  else
2692    deg=r->pFDeg;
2693
2694  poly q=NULL, qn;
2695  int  o,ii;
2696  sBucket_pt bp;
2697
2698  if (p!=NULL)
2699  {
2700    if ((varnum < 1) || (varnum > rVar(r)))
2701    {
2702      return NULL;
2703    }
2704    o=deg(p,r);
2705    q=pNext(p);
2706    while (q != NULL)
2707    {
2708      ii=deg(q,r);
2709      if (ii>o) o=ii;
2710      pIter(q);
2711    }
2712    q = p_Copy(p,r);
2713    bp = sBucketCreate(r);
2714    while (q != NULL)
2715    {
2716      ii = o-deg(q,r);
2717      if (ii!=0)
2718      {
2719        p_AddExp(q,varnum, (long)ii,r);
2720        p_Setm(q,r);
2721      }
2722      qn = pNext(q);
2723      pNext(q) = NULL;
2724      sBucket_Add_p(bp, q, 1);
2725      q = qn;
2726    }
2727    sBucketDestroyAdd(bp, &q, &ii);
2728  }
2729  return q;
2730}
2731
2732/*2
2733*tests if p is homogeneous with respect to the actual weigths
2734*/
2735BOOLEAN p_IsHomogeneous (poly p, const ring r)
2736{
2737  poly qp=p;
2738  int o;
2739
2740  if ((p == NULL) || (pNext(p) == NULL)) return TRUE;
2741  pFDegProc d;
2742  if (r->pLexOrder && (r->order[0]==ringorder_lp))
2743    d=p_Totaldegree;
2744  else
2745    d=r->pFDeg;
2746  o = d(p,r);
2747  do
2748  {
2749    if (d(qp,r) != o) return FALSE;
2750    pIter(qp);
2751  }
2752  while (qp != NULL);
2753  return TRUE;
2754}
2755
2756/*----------utilities for syzygies--------------*/
2757BOOLEAN   p_VectorHasUnitB(poly p, int * k, const ring r)
2758{
2759  poly q=p,qq;
2760  int i;
2761
2762  while (q!=NULL)
2763  {
2764    if (p_LmIsConstantComp(q,r))
2765    {
2766      i = p_GetComp(q,r);
2767      qq = p;
2768      while ((qq != q) && (p_GetComp(qq,r) != i)) pIter(qq);
2769      if (qq == q)
2770      {
2771        *k = i;
2772        return TRUE;
2773      }
2774      else
2775        pIter(q);
2776    }
2777    else pIter(q);
2778  }
2779  return FALSE;
2780}
2781
2782void   p_VectorHasUnit(poly p, int * k, int * len, const ring r)
2783{
2784  poly q=p,qq;
2785  int i,j=0;
2786
2787  *len = 0;
2788  while (q!=NULL)
2789  {
2790    if (p_LmIsConstantComp(q,r))
2791    {
2792      i = p_GetComp(q,r);
2793      qq = p;
2794      while ((qq != q) && (p_GetComp(qq,r) != i)) pIter(qq);
2795      if (qq == q)
2796      {
2797       j = 0;
2798       while (qq!=NULL)
2799       {
2800         if (p_GetComp(qq,r)==i) j++;
2801        pIter(qq);
2802       }
2803       if ((*len == 0) || (j<*len))
2804       {
2805         *len = j;
2806         *k = i;
2807       }
2808      }
2809    }
2810    pIter(q);
2811  }
2812}
2813
2814poly p_TakeOutComp1(poly * p, int k, const ring r)
2815{
2816  poly q = *p;
2817
2818  if (q==NULL) return NULL;
2819
2820  poly qq=NULL,result = NULL;
2821
2822  if (p_GetComp(q,r)==k)
2823  {
2824    result = q; /* *p */
2825    while ((q!=NULL) && (p_GetComp(q,r)==k))
2826    {
2827      p_SetComp(q,0,r);
2828      p_SetmComp(q,r);
2829      qq = q;
2830      pIter(q);
2831    }
2832    *p = q;
2833    pNext(qq) = NULL;
2834  }
2835  if (q==NULL) return result;
2836//  if (pGetComp(q) > k) pGetComp(q)--;
2837  while (pNext(q)!=NULL)
2838  {
2839    if (p_GetComp(pNext(q),r)==k)
2840    {
2841      if (result==NULL)
2842      {
2843        result = pNext(q);
2844        qq = result;
2845      }
2846      else
2847      {
2848        pNext(qq) = pNext(q);
2849        pIter(qq);
2850      }
2851      pNext(q) = pNext(pNext(q));
2852      pNext(qq) =NULL;
2853      p_SetComp(qq,0,r);
2854      p_SetmComp(qq,r);
2855    }
2856    else
2857    {
2858      pIter(q);
2859//      if (pGetComp(q) > k) pGetComp(q)--;
2860    }
2861  }
2862  return result;
2863}
2864
2865poly p_TakeOutComp(poly * p, int k, const ring r)
2866{
2867  poly q = *p,qq=NULL,result = NULL;
2868
2869  if (q==NULL) return NULL;
2870  BOOLEAN use_setmcomp=rOrd_SetCompRequiresSetm(r);
2871  if (p_GetComp(q,r)==k)
2872  {
2873    result = q;
2874    do
2875    {
2876      p_SetComp(q,0,r);
2877      if (use_setmcomp) p_SetmComp(q,r);
2878      qq = q;
2879      pIter(q);
2880    }
2881    while ((q!=NULL) && (p_GetComp(q,r)==k));
2882    *p = q;
2883    pNext(qq) = NULL;
2884  }
2885  if (q==NULL) return result;
2886  if (p_GetComp(q,r) > k)
2887  {
2888    p_SubComp(q,1,r);
2889    if (use_setmcomp) p_SetmComp(q,r);
2890  }
2891  poly pNext_q;
2892  while ((pNext_q=pNext(q))!=NULL)
2893  {
2894    if (p_GetComp(pNext_q,r)==k)
2895    {
2896      if (result==NULL)
2897      {
2898        result = pNext_q;
2899        qq = result;
2900      }
2901      else
2902      {
2903        pNext(qq) = pNext_q;
2904        pIter(qq);
2905      }
2906      pNext(q) = pNext(pNext_q);
2907      pNext(qq) =NULL;
2908      p_SetComp(qq,0,r);
2909      if (use_setmcomp) p_SetmComp(qq,r);
2910    }
2911    else
2912    {
2913      /*pIter(q);*/ q=pNext_q;
2914      if (p_GetComp(q,r) > k)
2915      {
2916        p_SubComp(q,1,r);
2917        if (use_setmcomp) p_SetmComp(q,r);
2918      }
2919    }
2920  }
2921  return result;
2922}
2923
2924// Splits *p into two polys: *q which consists of all monoms with
2925// component == comp and *p of all other monoms *lq == pLength(*q)
2926void p_TakeOutComp(poly *r_p, long comp, poly *r_q, int *lq, const ring r)
2927{
2928  spolyrec pp, qq;
2929  poly p, q, p_prev;
2930  int l = 0;
2931
2932#ifdef HAVE_ASSUME
2933  int lp = pLength(*r_p);
2934#endif
2935
2936  pNext(&pp) = *r_p;
2937  p = *r_p;
2938  p_prev = &pp;
2939  q = &qq;
2940
2941  while(p != NULL)
2942  {
2943    while (p_GetComp(p,r) == comp)
2944    {
2945      pNext(q) = p;
2946      pIter(q);
2947      p_SetComp(p, 0,r);
2948      p_SetmComp(p,r);
2949      pIter(p);
2950      l++;
2951      if (p == NULL)
2952      {
2953        pNext(p_prev) = NULL;
2954        goto Finish;
2955      }
2956    }
2957    pNext(p_prev) = p;
2958    p_prev = p;
2959    pIter(p);
2960  }
2961
2962  Finish:
2963  pNext(q) = NULL;
2964  *r_p = pNext(&pp);
2965  *r_q = pNext(&qq);
2966  *lq = l;
2967#ifdef HAVE_ASSUME
2968  assume(pLength(*r_p) + pLength(*r_q) == lp);
2969#endif
2970  p_Test(*r_p,r);
2971  p_Test(*r_q,r);
2972}
2973
2974void p_DeleteComp(poly * p,int k, const ring r)
2975{
2976  poly q;
2977
2978  while ((*p!=NULL) && (p_GetComp(*p,r)==k)) p_LmDelete(p,r);
2979  if (*p==NULL) return;
2980  q = *p;
2981  if (p_GetComp(q,r)>k)
2982  {
2983    p_SubComp(q,1,r);
2984    p_SetmComp(q,r);
2985  }
2986  while (pNext(q)!=NULL)
2987  {
2988    if (p_GetComp(pNext(q),r)==k)
2989      p_LmDelete(&(pNext(q)),r);
2990    else
2991    {
2992      pIter(q);
2993      if (p_GetComp(q,r)>k)
2994      {
2995        p_SubComp(q,1,r);
2996        p_SetmComp(q,r);
2997      }
2998    }
2999  }
3000}
3001
3002/*2
3003* convert a vector to a set of polys,
3004* allocates the polyset, (entries 0..(*len)-1)
3005* the vector will not be changed
3006*/
3007void  p_Vec2Polys(poly v, poly* *p, int *len, const ring r)
3008{
3009  poly h;
3010  int k;
3011
3012  *len=p_MaxComp(v,r);
3013  if (*len==0) *len=1;
3014  *p=(poly*)omAlloc0((*len)*sizeof(poly));
3015  while (v!=NULL)
3016  {
3017    h=p_Head(v,r);
3018    k=p_GetComp(h,r);
3019    p_SetComp(h,0,r);
3020    (*p)[k-1]=p_Add_q((*p)[k-1],h,r);
3021    pIter(v);
3022  }
3023}
3024
3025/* -------------------------------------------------------- */
3026/*2
3027* change all global variables to fit the description of the new ring
3028*/
3029
3030void p_SetGlobals(const ring r, BOOLEAN complete)
3031{
3032  if (r->ppNoether!=NULL) p_Delete(&r->ppNoether,r);
3033
3034  if (complete)
3035  {
3036    test &= ~ TEST_RINGDEP_OPTS;
3037    test |= r->options;
3038  }
3039}
3040//
3041// resets the pFDeg and pLDeg: if pLDeg is not given, it is
3042// set to currRing->pLDegOrig, i.e. to the respective LDegProc which
3043// only uses pFDeg (and not p_Deg, or pTotalDegree, etc)
3044void pSetDegProcs(ring r, pFDegProc new_FDeg, pLDegProc new_lDeg)
3045{
3046  assume(new_FDeg != NULL);
3047  r->pFDeg = new_FDeg;
3048
3049  if (new_lDeg == NULL)
3050    new_lDeg = r->pLDegOrig;
3051
3052  r->pLDeg = new_lDeg;
3053}
3054
3055// restores pFDeg and pLDeg:
3056void pRestoreDegProcs(ring r, pFDegProc old_FDeg, pLDegProc old_lDeg)
3057{
3058  assume(old_FDeg != NULL && old_lDeg != NULL);
3059  r->pFDeg = old_FDeg;
3060  r->pLDeg = old_lDeg;
3061}
3062
3063/*-------- several access procedures to monomials -------------------- */
3064/*
3065* the module weights for std
3066*/
3067static pFDegProc pOldFDeg;
3068static pLDegProc pOldLDeg;
3069static intvec * pModW;
3070static BOOLEAN pOldLexOrder;
3071
3072static long pModDeg(poly p, ring r)
3073{
3074  long d=pOldFDeg(p, r);
3075  int c=p_GetComp(p, r);
3076  if ((c>0) && ((r->pModW)->range(c-1))) d+= (*(r->pModW))[c-1];
3077  return d;
3078  //return pOldFDeg(p, r)+(*pModW)[p_GetComp(p, r)-1];
3079}
3080
3081void p_SetModDeg(intvec *w, ring r)
3082{
3083  if (w!=NULL)
3084  {
3085    r->pModW = w;
3086    pOldFDeg = r->pFDeg;
3087    pOldLDeg = r->pLDeg;
3088    pOldLexOrder = r->pLexOrder;
3089    pSetDegProcs(r,pModDeg);
3090    r->pLexOrder = TRUE;
3091  }
3092  else
3093  {
3094    r->pModW = NULL;
3095    pRestoreDegProcs(r,pOldFDeg, pOldLDeg);
3096    r->pLexOrder = pOldLexOrder;
3097  }
3098}
3099
3100/*2
3101* handle memory request for sets of polynomials (ideals)
3102* l is the length of *p, increment is the difference (may be negative)
3103*/
3104void pEnlargeSet(poly* *p, int l, int increment)
3105{
3106  poly* h;
3107
3108  h=(poly*)omReallocSize((poly*)*p,l*sizeof(poly),(l+increment)*sizeof(poly));
3109  if (increment>0)
3110  {
3111    //for (i=l; i<l+increment; i++)
3112    //  h[i]=NULL;
3113    memset(&(h[l]),0,increment*sizeof(poly));
3114  }
3115  *p=h;
3116}
3117
3118/*2
3119*divides p1 by its leading coefficient
3120*/
3121void p_Norm(poly p1, const ring r)
3122{
3123#ifdef HAVE_RINGS
3124  if (rField_is_Ring(r))
3125  {
3126    if (!n_IsUnit(pGetCoeff(p1), r->cf)) return;
3127    // Werror("p_Norm not possible in the case of coefficient rings.");
3128  }
3129  else
3130#endif
3131  if (p1!=NULL)
3132  {
3133    if (pNext(p1)==NULL)
3134    {
3135      p_SetCoeff(p1,n_Init(1,r->cf),r);
3136      return;
3137    }
3138    poly h;
3139    if (!n_IsOne(pGetCoeff(p1),r->cf))
3140    {
3141      number k, c;
3142      n_Normalize(pGetCoeff(p1),r->cf);
3143      k = pGetCoeff(p1);
3144      c = n_Init(1,r->cf);
3145      pSetCoeff0(p1,c);
3146      h = pNext(p1);
3147      while (h!=NULL)
3148      {
3149        c=n_Div(pGetCoeff(h),k,r->cf);
3150        // no need to normalize: Z/p, R
3151        // normalize already in nDiv: Q_a, Z/p_a
3152        // remains: Q
3153        if (rField_is_Q(r) && (!n_IsOne(c,r->cf))) n_Normalize(c,r->cf);
3154        p_SetCoeff(h,c,r);
3155        pIter(h);
3156      }
3157      n_Delete(&k,r->cf);
3158    }
3159    else
3160    {
3161      //if (r->cf->cfNormalize != nDummy2) //TODO: OPTIMIZE
3162      {
3163        h = pNext(p1);
3164        while (h!=NULL)
3165        {
3166          n_Normalize(pGetCoeff(h),r->cf);
3167          pIter(h);
3168        }
3169      }
3170    }
3171  }
3172}
3173
3174/*2
3175*normalize all coefficients
3176*/
3177void p_Normalize(poly p,const ring r)
3178{
3179  if (rField_has_simple_inverse(r)) return; /* Z/p, GF(p,n), R, long R/C */
3180  while (p!=NULL)
3181  {
3182#ifdef LDEBUG
3183    n_Test(pGetCoeff(p), r->cf);
3184#endif
3185    n_Normalize(pGetCoeff(p),r->cf);
3186    pIter(p);
3187  }
3188}
3189
3190// splits p into polys with Exp(n) == 0 and Exp(n) != 0
3191// Poly with Exp(n) != 0 is reversed
3192static void p_SplitAndReversePoly(poly p, int n, poly *non_zero, poly *zero, const ring r)
3193{
3194  if (p == NULL)
3195  {
3196    *non_zero = NULL;
3197    *zero = NULL;
3198    return;
3199  }
3200  spolyrec sz;
3201  poly z, n_z, next;
3202  z = &sz;
3203  n_z = NULL;
3204
3205  while(p != NULL)
3206  {
3207    next = pNext(p);
3208    if (p_GetExp(p, n,r) == 0)
3209    {
3210      pNext(z) = p;
3211      pIter(z);
3212    }
3213    else
3214    {
3215      pNext(p) = n_z;
3216      n_z = p;
3217    }
3218    p = next;
3219  }
3220  pNext(z) = NULL;
3221  *zero = pNext(&sz);
3222  *non_zero = n_z;
3223}
3224/*3
3225* substitute the n-th variable by 1 in p
3226* destroy p
3227*/
3228static poly p_Subst1 (poly p,int n, const ring r)
3229{
3230  poly qq=NULL, result = NULL;
3231  poly zero=NULL, non_zero=NULL;
3232
3233  // reverse, so that add is likely to be linear
3234  p_SplitAndReversePoly(p, n, &non_zero, &zero,r);
3235
3236  while (non_zero != NULL)
3237  {
3238    assume(p_GetExp(non_zero, n,r) != 0);
3239    qq = non_zero;
3240    pIter(non_zero);
3241    qq->next = NULL;
3242    p_SetExp(qq,n,0,r);
3243    p_Setm(qq,r);
3244    result = p_Add_q(result,qq,r);
3245  }
3246  p = p_Add_q(result, zero,r);
3247  p_Test(p,r);
3248  return p;
3249}
3250
3251/*3
3252* substitute the n-th variable by number e in p
3253* destroy p
3254*/
3255static poly p_Subst2 (poly p,int n, number e, const ring r)
3256{
3257  assume( ! n_IsZero(e,r->cf) );
3258  poly qq,result = NULL;
3259  number nn, nm;
3260  poly zero, non_zero;
3261
3262  // reverse, so that add is likely to be linear
3263  p_SplitAndReversePoly(p, n, &non_zero, &zero,r);
3264
3265  while (non_zero != NULL)
3266  {
3267    assume(p_GetExp(non_zero, n, r) != 0);
3268    qq = non_zero;
3269    pIter(non_zero);
3270    qq->next = NULL;
3271    n_Power(e, p_GetExp(qq, n, r), &nn,r->cf);
3272    nm = n_Mult(nn, pGetCoeff(qq),r->cf);
3273#ifdef HAVE_RINGS
3274    if (n_IsZero(nm,r->cf))
3275    {
3276      p_LmFree(&qq,r);
3277      n_Delete(&nm,r->cf);
3278    }
3279    else
3280#endif
3281    {
3282      p_SetCoeff(qq, nm,r);
3283      p_SetExp(qq, n, 0,r);
3284      p_Setm(qq,r);
3285      result = p_Add_q(result,qq,r);
3286    }
3287    n_Delete(&nn,r->cf);
3288  }
3289  p = p_Add_q(result, zero,r);
3290  p_Test(p,r);
3291  return p;
3292}
3293
3294
3295/* delete monoms whose n-th exponent is different from zero */
3296static poly p_Subst0(poly p, int n, const ring r)
3297{
3298  spolyrec res;
3299  poly h = &res;
3300  pNext(h) = p;
3301
3302  while (pNext(h)!=NULL)
3303  {
3304    if (p_GetExp(pNext(h),n,r)!=0)
3305    {
3306      p_LmDelete(&pNext(h),r);
3307    }
3308    else
3309    {
3310      pIter(h);
3311    }
3312  }
3313  p_Test(pNext(&res),r);
3314  return pNext(&res);
3315}
3316
3317/*2
3318* substitute the n-th variable by e in p
3319* destroy p
3320*/
3321poly p_Subst(poly p, int n, poly e, const ring r)
3322{
3323  if (e == NULL) return p_Subst0(p, n,r);
3324
3325  if (p_IsConstant(e,r))
3326  {
3327    if (n_IsOne(pGetCoeff(e),r->cf)) return p_Subst1(p,n,r);
3328    else return p_Subst2(p, n, pGetCoeff(e),r);
3329  }
3330
3331#ifdef HAVE_PLURAL
3332  if (rIsPluralRing(r))
3333  {
3334    return nc_pSubst(p,n,e,r);
3335  }
3336#endif
3337
3338  int exponent,i;
3339  poly h, res, m;
3340  int *me,*ee;
3341  number nu,nu1;
3342
3343  me=(int *)omAlloc((rVar(r)+1)*sizeof(int));
3344  ee=(int *)omAlloc((rVar(r)+1)*sizeof(int));
3345  if (e!=NULL) p_GetExpV(e,ee,r);
3346  res=NULL;
3347  h=p;
3348  while (h!=NULL)
3349  {
3350    if ((e!=NULL) || (p_GetExp(h,n,r)==0))
3351    {
3352      m=p_Head(h,r);
3353      p_GetExpV(m,me,r);
3354      exponent=me[n];
3355      me[n]=0;
3356      for(i=rVar(r);i>0;i--)
3357        me[i]+=exponent*ee[i];
3358      p_SetExpV(m,me,r);
3359      if (e!=NULL)
3360      {
3361        n_Power(pGetCoeff(e),exponent,&nu,r->cf);
3362        nu1=n_Mult(pGetCoeff(m),nu,r->cf);
3363        n_Delete(&nu,r->cf);
3364        p_SetCoeff(m,nu1,r);
3365      }
3366      res=p_Add_q(res,m,r);
3367    }
3368    p_LmDelete(&h,r);
3369  }
3370  omFreeSize((ADDRESS)me,(rVar(r)+1)*sizeof(int));
3371  omFreeSize((ADDRESS)ee,(rVar(r)+1)*sizeof(int));
3372  return res;
3373}
3374/*2
3375*returns a re-ordered copy of a polynomial, with permutation of the variables
3376*/
3377poly p_PermPoly (poly p, int * perm, const ring oldRing, const ring dst,
3378       nMapFunc nMap, int *par_perm, int OldPar)
3379{
3380  int OldpVariables = oldRing->N;
3381  poly result = NULL;
3382  poly result_last = NULL;
3383  poly aq=NULL; /* the map coefficient */
3384  poly qq; /* the mapped monomial */
3385
3386  while (p != NULL)
3387  {
3388    if ((OldPar==0)||(rField_is_GF(oldRing)))
3389    {
3390      qq = p_Init(dst);
3391      number n=nMap(pGetCoeff(p),oldRing->cf,dst->cf);
3392      if ((!rMinpolyIsNULL(dst))
3393      && ((rField_is_Zp_a(dst)) || (rField_is_Q_a(dst))))
3394      {
3395        n_Normalize(n,dst->cf);
3396      }
3397      pGetCoeff(qq)=n;
3398    // coef may be zero:  pTest(qq);
3399    }
3400    else
3401    {
3402      qq=p_One(dst);
3403      WerrorS("longalg missing 2");
3404      #if 0
3405      aq=naPermNumber(pGetCoeff(p),par_perm,OldPar, oldRing);
3406      if ((!rMinpolyIsNULL(dst))
3407      && ((rField_is_Zp_a(dst)) || (rField_is_Q_a(dst))))
3408      {
3409        poly tmp=aq;
3410        while (tmp!=NULL)
3411        {
3412          number n=pGetCoeff(tmp);
3413          n_Normalize(n,dst->cf);
3414          pGetCoeff(tmp)=n;
3415          pIter(tmp);
3416        }
3417      }
3418      p_Test(aq,dst);
3419      #endif
3420    }
3421    if (rRing_has_Comp(dst)) p_SetComp(qq, p_GetComp(p,oldRing),dst);
3422    if (n_IsZero(pGetCoeff(qq),dst->cf))
3423    {
3424      p_LmDelete(&qq,dst);
3425    }
3426    else
3427    {
3428      int i;
3429      int mapped_to_par=0;
3430      for(i=1; i<=OldpVariables; i++)
3431      {
3432        int e=p_GetExp(p,i,oldRing);
3433        if (e!=0)
3434        {
3435          if (perm==NULL)
3436          {
3437            p_SetExp(qq,i, e, dst);
3438          }
3439          else if (perm[i]>0)
3440            p_AddExp(qq,perm[i], e/*p_GetExp( p,i,oldRing)*/, dst);
3441          else if (perm[i]<0)
3442          {
3443            if (rField_is_GF(dst))
3444            {
3445              number c=pGetCoeff(qq);
3446              number ee=n_Par(1,dst->cf);
3447              number eee;n_Power(ee,e,&eee,dst->cf); //nfDelete(ee,dst);
3448              ee=n_Mult(c,eee,dst->cf);
3449              //nfDelete(c,dst);nfDelete(eee,dst);
3450              pSetCoeff0(qq,ee);
3451            }
3452            else
3453            {
3454              WerrorS("longalg missing 3");
3455              #if 0
3456              lnumber c=(lnumber)pGetCoeff(qq);
3457              if (c->z->next==NULL)
3458                p_AddExp(c->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/,dst->extRing);
3459              else /* more difficult: we have really to multiply: */
3460              {
3461                lnumber mmc=(lnumber)naInit(1,dst);
3462                p_SetExp(mmc->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/,dst->extRing);
3463                p_Setm(mmc->z,dst->extRing->cf);
3464                pGetCoeff(qq)=n_Mult((number)c,(number)mmc,dst->cf);
3465                n_Delete((number *)&c,dst->cf);
3466                n_Delete((number *)&mmc,dst->cf);
3467              }
3468              mapped_to_par=1;
3469              #endif
3470            }
3471          }
3472          else
3473          {
3474            /* this variable maps to 0 !*/
3475            p_LmDelete(&qq,dst);
3476            break;
3477          }
3478        }
3479      }
3480      if (mapped_to_par
3481      && (!rMinpolyIsNULL(dst)))
3482      {
3483        number n=pGetCoeff(qq);
3484        n_Normalize(n,dst->cf);
3485        pGetCoeff(qq)=n;
3486      }
3487    }
3488    pIter(p);
3489#if 1
3490    if (qq!=NULL)
3491    {
3492      p_Setm(qq,dst);
3493      p_Test(aq,dst);
3494      p_Test(qq,dst);
3495      if (aq!=NULL) qq=p_Mult_q(aq,qq,dst);
3496      aq = qq;
3497      while (pNext(aq) != NULL) pIter(aq);
3498      if (result_last==NULL)
3499      {
3500        result=qq;
3501      }
3502      else
3503      {
3504        pNext(result_last)=qq;
3505      }
3506      result_last=aq;
3507      aq = NULL;
3508    }
3509    else if (aq!=NULL)
3510    {
3511      p_Delete(&aq,dst);
3512    }
3513  }
3514  result=p_SortAdd(result,dst);
3515#else
3516  //  if (qq!=NULL)
3517  //  {
3518  //    pSetm(qq);
3519  //    pTest(qq);
3520  //    pTest(aq);
3521  //    if (aq!=NULL) qq=pMult(aq,qq);
3522  //    aq = qq;
3523  //    while (pNext(aq) != NULL) pIter(aq);
3524  //    pNext(aq) = result;
3525  //    aq = NULL;
3526  //    result = qq;
3527  //  }
3528  //  else if (aq!=NULL)
3529  //  {
3530  //    pDelete(&aq);
3531  //  }
3532  //}
3533  //p = result;
3534  //result = NULL;
3535  //while (p != NULL)
3536  //{
3537  //  qq = p;
3538  //  pIter(p);
3539  //  qq->next = NULL;
3540  //  result = pAdd(result, qq);
3541  //}
3542#endif
3543  p_Test(result,dst);
3544  return result;
3545}
3546/**************************************************************
3547 *
3548 * Jet
3549 *
3550 **************************************************************/
3551
3552poly pp_Jet(poly p, int m, const ring R)
3553{
3554  poly r=NULL;
3555  poly t=NULL;
3556
3557  while (p!=NULL)
3558  {
3559    if (p_Totaldegree(p,R)<=m)
3560    {
3561      if (r==NULL)
3562        r=p_Head(p,R);
3563      else
3564      if (t==NULL)
3565      {
3566        pNext(r)=p_Head(p,R);
3567        t=pNext(r);
3568      }
3569      else
3570      {
3571        pNext(t)=p_Head(p,R);
3572        pIter(t);
3573      }
3574    }
3575    pIter(p);
3576  }
3577  return r;
3578}
3579
3580poly p_Jet(poly p, int m,const ring R)
3581{
3582  poly t=NULL;
3583
3584  while((p!=NULL) && (p_Totaldegree(p,R)>m)) p_LmDelete(&p,R);
3585  if (p==NULL) return NULL;
3586  poly r=p;
3587  while (pNext(p)!=NULL)
3588  {
3589    if (p_Totaldegree(pNext(p),R)>m)
3590    {
3591      p_LmDelete(&pNext(p),R);
3592    }
3593    else
3594      pIter(p);
3595  }
3596  return r;
3597}
3598
3599poly pp_JetW(poly p, int m, short *w, const ring R)
3600{
3601  poly r=NULL;
3602  poly t=NULL;
3603  while (p!=NULL)
3604  {
3605    if (totaldegreeWecart_IV(p,R,w)<=m)
3606    {
3607      if (r==NULL)
3608        r=p_Head(p,R);
3609      else
3610      if (t==NULL)
3611      {
3612        pNext(r)=p_Head(p,R);
3613        t=pNext(r);
3614      }
3615      else
3616      {
3617        pNext(t)=p_Head(p,R);
3618        pIter(t);
3619      }
3620    }
3621    pIter(p);
3622  }
3623  return r;
3624}
3625
3626poly p_JetW(poly p, int m, short *w, const ring R)
3627{
3628  while((p!=NULL) && (totaldegreeWecart_IV(p,R,w)>m)) p_LmDelete(&p,R);
3629  if (p==NULL) return NULL;
3630  poly r=p;
3631  while (pNext(p)!=NULL)
3632  {
3633    if (totaldegreeWecart_IV(pNext(p),R,w)>m)
3634    {
3635      p_LmDelete(&pNext(p),R);
3636    }
3637    else
3638      pIter(p);
3639  }
3640  return r;
3641}
3642
3643/*************************************************************/
3644int p_MinDeg(poly p,intvec *w, const ring R)
3645{
3646  if(p==NULL)
3647    return -1;
3648  int d=-1;
3649  while(p!=NULL)
3650  {
3651    int d0=0;
3652    for(int j=0;j<rVar(R);j++)
3653      if(w==NULL||j>=w->length())
3654        d0+=p_GetExp(p,j+1,R);
3655      else
3656        d0+=(*w)[j]*p_GetExp(p,j+1,R);
3657    if(d0<d||d==-1)
3658      d=d0;
3659    pIter(p);
3660  }
3661  return d;
3662}
3663
3664/***************************************************************/
3665
3666poly p_Series(int n,poly p,poly u, intvec *w, const ring R)
3667{
3668  short *ww=iv2array(w,R);
3669  if(p!=NULL)
3670  {
3671    if(u==NULL)
3672      p=p_JetW(p,n,ww,R);
3673    else
3674      p=p_JetW(p_Mult_q(p,p_Invers(n-p_MinDeg(p,w,R),u,w,R),R),n,ww,R);
3675  }
3676  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
3677  return p;
3678}
3679
3680poly p_Invers(int n,poly u,intvec *w, const ring R)
3681{
3682  if(n<0)
3683    return NULL;
3684  number u0=n_Invers(pGetCoeff(u),R->cf);
3685  poly v=p_NSet(u0,R);
3686  if(n==0)
3687    return v;
3688  short *ww=iv2array(w,R);
3689  poly u1=p_JetW(p_Sub(p_One(R),p_Mult_nn(u,u0,R),R),n,ww,R);
3690  if(u1==NULL)
3691  {
3692    omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
3693    return v;
3694  }
3695  poly v1=p_Mult_nn(p_Copy(u1,R),u0,R);
3696  v=p_Add_q(v,p_Copy(v1,R),R);
3697  for(int i=n/p_MinDeg(u1,w,R);i>1;i--)
3698  {
3699    v1=p_JetW(p_Mult_q(v1,p_Copy(u1,R),R),n,ww,R);
3700    v=p_Add_q(v,p_Copy(v1,R),R);
3701  }
3702  p_Delete(&u1,R);
3703  p_Delete(&v1,R);
3704  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
3705  return v;
3706}
3707
3708BOOLEAN p_EqualPolys(poly p1,poly p2, const ring r)
3709{
3710  while ((p1 != NULL) && (p2 != NULL))
3711  {
3712    if (! p_LmEqual(p1, p2,r))
3713      return FALSE;
3714    if (! n_Equal(p_GetCoeff(p1,r), p_GetCoeff(p2,r),r ))
3715      return FALSE;
3716    pIter(p1);
3717    pIter(p2);
3718  }
3719  return (p1==p2);
3720}
3721
3722/*2
3723*returns TRUE if p1 is a skalar multiple of p2
3724*assume p1 != NULL and p2 != NULL
3725*/
3726BOOLEAN p_ComparePolys(poly p1,poly p2, const ring r)
3727{
3728  number n,nn;
3729  pAssume(p1 != NULL && p2 != NULL);
3730
3731  if (!p_LmEqual(p1,p2,r)) //compare leading mons
3732      return FALSE;
3733  if ((pNext(p1)==NULL) && (pNext(p2)!=NULL))
3734     return FALSE;
3735  if ((pNext(p2)==NULL) && (pNext(p1)!=NULL))
3736     return FALSE;
3737  if (pLength(p1) != pLength(p2))
3738    return FALSE;
3739#ifdef HAVE_RINGS
3740  if (rField_is_Ring(r))
3741  {
3742    if (!n_DivBy(p_GetCoeff(p1, r), p_GetCoeff(p2, r), r)) return FALSE;
3743  }
3744#endif
3745  n=n_Div(p_GetCoeff(p1,r),p_GetCoeff(p2,r),r);
3746  while ((p1 != NULL) /*&& (p2 != NULL)*/)
3747  {
3748    if ( ! p_LmEqual(p1, p2,r))
3749    {
3750        n_Delete(&n, r);
3751        return FALSE;
3752    }
3753    if (!n_Equal(p_GetCoeff(p1, r), nn = n_Mult(p_GetCoeff(p2, r),n, r), r))
3754    {
3755      n_Delete(&n, r);
3756      n_Delete(&nn, r);
3757      return FALSE;
3758    }
3759    n_Delete(&nn, r);
3760    pIter(p1);
3761    pIter(p2);
3762  }
3763  n_Delete(&n, r);
3764  return TRUE;
3765}
3766
3767
3768/***************************************************************
3769 *
3770 * p_ShallowDelete
3771 *
3772 ***************************************************************/
3773#undef LINKAGE
3774#define LINKAGE
3775#undef p_Delete__T
3776#define p_Delete__T p_ShallowDelete
3777#undef n_Delete__T
3778#define n_Delete__T(n, r) ((void)0)
3779
3780#include <polys/templates/p_Delete__T.cc>
3781
3782#ifdef HAVE_RINGS
3783/* TRUE iff LT(f) | LT(g) */
3784BOOLEAN p_DivisibleByRingCase(poly f, poly g, const ring r)
3785{
3786  int exponent;
3787  for(int i = (int)r->N; i; i--)
3788  {
3789    exponent = p_GetExp(g, i, r) - p_GetExp(f, i, r);
3790    if (exponent < 0) return FALSE;
3791  }
3792  return n_DivBy(p_GetCoeff(g,r), p_GetCoeff(f,r),r->cf);
3793}
3794#endif
Note: See TracBrowser for help on using the repository browser.