source: git/libpolys/polys/monomials/p_polys.cc @ 76fead

spielwiese
Last change on this file since 76fead was 76fead, checked in by Hans Schoenemann <hannes@…>, 13 years ago
syntax fix after rebase
  • Property mode set to 100644
File size: 79.0 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/***************************************************************
5 *  File:    p_polys.cc
6 *  Purpose: implementation of ring independent poly procedures?
7 *  Author:  obachman (Olaf Bachmann)
8 *  Created: 8/00
9 *  Version: $Id$
10 *******************************************************************/
11
12#include <ctype.h>
13
14
15#include <omalloc/omalloc.h>
16#include <misc/auxiliary.h>
17#include <misc/options.h>
18#include <misc/intvec.h>
19
20#include <coeffs/longrat.h> // ???
21
22#include "weight.h"
23#include "simpleideals.h"
24
25#include "monomials/ring.h"
26#include "monomials/p_polys.h"
27#include <polys/templates/p_MemCmp.h>
28#include <polys/templates/p_MemAdd.h>
29#include <polys/templates/p_MemCopy.h>
30
31
32// #include <???/ideals.h>
33// #include <???/int64vec.h>
34
35#ifndef NDEBUG
36// #include <???/febase.h>
37#endif
38
39#ifdef HAVE_PLURAL
40#include "nc/nc.h"
41#include "nc/sca.h"
42#endif
43
44#include "coeffrings.h"
45#ifdef HAVE_FACTORY
46#include "clapsing.h"
47#endif
48
49/***************************************************************
50 *
51 * Completing what needs to be set for the monomial
52 *
53 ***************************************************************/
54// this is special for the syz stuff
55static int* _components = NULL;
56static long* _componentsShifted = NULL;
57static int _componentsExternal = 0;
58
59BOOLEAN pSetm_error=0;
60
61#ifndef NDEBUG
62# define MYTEST 0
63#else /* ifndef NDEBUG */
64# define MYTEST 0
65#endif /* ifndef NDEBUG */
66
67void p_Setm_General(poly p, const ring r)
68{
69  p_LmCheckPolyRing(p, r);
70  int pos=0;
71  if (r->typ!=NULL)
72  {
73    loop
74    {
75      long ord=0;
76      sro_ord* o=&(r->typ[pos]);
77      switch(o->ord_typ)
78      {
79        case ro_dp:
80        {
81          int a,e;
82          a=o->data.dp.start;
83          e=o->data.dp.end;
84          for(int i=a;i<=e;i++) ord+=p_GetExp(p,i,r);
85          p->exp[o->data.dp.place]=ord;
86          break;
87        }
88        case ro_wp_neg:
89          ord=POLY_NEGWEIGHT_OFFSET;
90          // no break;
91        case ro_wp:
92        {
93          int a,e;
94          a=o->data.wp.start;
95          e=o->data.wp.end;
96          int *w=o->data.wp.weights;
97#if 1
98          for(int i=a;i<=e;i++) ord+=p_GetExp(p,i,r)*w[i-a];
99#else
100          long ai;
101          int ei,wi;
102          for(int i=a;i<=e;i++)
103          {
104             ei=p_GetExp(p,i,r);
105             wi=w[i-a];
106             ai=ei*wi;
107             if (ai/ei!=wi) pSetm_error=TRUE;
108             ord+=ai;
109             if (ord<ai) pSetm_error=TRUE;
110          }
111#endif
112          p->exp[o->data.wp.place]=ord;
113          break;
114        }
115      case ro_wp64:
116        {
117          int64 ord=0;
118          int a,e;
119          a=o->data.wp64.start;
120          e=o->data.wp64.end;
121          int64 *w=o->data.wp64.weights64;
122          int64 ei,wi,ai;
123          for(int i=a;i<=e;i++)
124          {
125            //Print("exp %d w %d \n",p_GetExp(p,i,r),(int)w[i-a]);
126            //ord+=((int64)p_GetExp(p,i,r))*w[i-a];
127            ei=(int64)p_GetExp(p,i,r);
128            wi=w[i-a];
129            ai=ei*wi;
130            if(ei!=0 && ai/ei!=wi)
131            {
132              pSetm_error=TRUE;
133              #if SIZEOF_LONG == 4
134              Print("ai %lld, wi %lld\n",ai,wi);
135              #else
136              Print("ai %ld, wi %ld\n",ai,wi);
137              #endif
138            }
139            ord+=ai;
140            if (ord<ai)
141            {
142              pSetm_error=TRUE;
143              #if SIZEOF_LONG == 4
144              Print("ai %lld, ord %lld\n",ai,ord);
145              #else
146              Print("ai %ld, ord %ld\n",ai,ord);
147              #endif
148            }
149          }
150          int64 mask=(int64)0x7fffffff;
151          long a_0=(long)(ord&mask); //2^31
152          long a_1=(long)(ord >>31 ); /*(ord/(mask+1));*/
153
154          //Print("mask: %x,  ord: %d,  a_0: %d,  a_1: %d\n"
155          //,(int)mask,(int)ord,(int)a_0,(int)a_1);
156                    //Print("mask: %d",mask);
157
158          p->exp[o->data.wp64.place]=a_1;
159          p->exp[o->data.wp64.place+1]=a_0;
160//            if(p_Setm_error) Print("***************************\n
161//                                    ***************************\n
162//                                    **WARNING: overflow error**\n
163//                                    ***************************\n
164//                                    ***************************\n");
165          break;
166        }
167        case ro_cp:
168        {
169          int a,e;
170          a=o->data.cp.start;
171          e=o->data.cp.end;
172          int pl=o->data.cp.place;
173          for(int i=a;i<=e;i++) { p->exp[pl]=p_GetExp(p,i,r); pl++; }
174          break;
175        }
176        case ro_syzcomp:
177        {
178          int c=p_GetComp(p,r);
179          long sc = c;
180          int* Components = (_componentsExternal ? _components :
181                             o->data.syzcomp.Components);
182          long* ShiftedComponents = (_componentsExternal ? _componentsShifted:
183                                     o->data.syzcomp.ShiftedComponents);
184          if (ShiftedComponents != NULL)
185          {
186            assume(Components != NULL);
187            assume(c == 0 || Components[c] != 0);
188            sc = ShiftedComponents[Components[c]];
189            assume(c == 0 || sc != 0);
190          }
191          p->exp[o->data.syzcomp.place]=sc;
192          break;
193        }
194        case ro_syz:
195        {
196          const unsigned long c = p_GetComp(p, r);
197          const short place = o->data.syz.place;
198          const int limit = o->data.syz.limit;
199         
200          if (c > limit)
201            p->exp[place] = o->data.syz.curr_index;
202          else if (c > 0)
203          {
204            assume( (1 <= c) && (c <= limit) );
205            p->exp[place]= o->data.syz.syz_index[c];
206          }
207          else
208          {
209            assume(c == 0);
210            p->exp[place]= 0;
211          }
212          break;
213        }
214        // Prefix for Induced Schreyer ordering
215        case ro_isTemp: // Do nothing?? (to be removed into suffix later on...?)
216        {
217          assume(p != NULL);
218
219#ifndef NDEBUG
220#if MYTEST
221          Print("p_Setm_General: isTemp ord: pos: %d, p: ", pos);  p_DebugPrint(p, r, r, 1);
222#endif
223#endif
224          int c = p_GetComp(p, r);
225
226          assume( c >= 0 );
227
228          // Let's simulate case ro_syz above....
229          // Should accumulate (by Suffix) and be a level indicator
230          const int* const pVarOffset = o->data.isTemp.pVarOffset;
231
232          assume( pVarOffset != NULL );
233
234          // TODO: Can this be done in the suffix???
235          for( int i = 1; i <= r->N; i++ ) // No v[0] here!!!
236          {
237            const int vo = pVarOffset[i];
238            if( vo != -1) // TODO: optimize: can be done once!
239            {
240              // Hans! Please don't break it again! p_SetExp(p, ..., r, vo) is correct:
241              p_SetExp(p, p_GetExp(p, i, r), r, vo); // copy put them verbatim
242              // Hans! Please don't break it again! p_GetExp(p, r, vo) is correct:
243              assume( p_GetExp(p, r, vo) == p_GetExp(p, i, r) ); // copy put them verbatim
244            }
245          }
246#ifndef NDEBUG
247          for( int i = 1; i <= r->N; i++ ) // No v[0] here!!!
248          {
249            const int vo = pVarOffset[i];
250            if( vo != -1) // TODO: optimize: can be done once!
251            {
252              // Hans! Please don't break it again! p_GetExp(p, r, vo) is correct:
253              assume( p_GetExp(p, r, vo) == p_GetExp(p, i, r) ); // copy put them verbatim
254            }
255          }
256#if MYTEST
257//          if( p->exp[o->data.isTemp.start] > 0 )
258//          {
259//            PrintS("Initial Value: "); p_DebugPrint(p, r, r, 1);
260//          }
261#endif
262#endif
263          break;
264        }
265
266        // Suffix for Induced Schreyer ordering
267        case ro_is:
268        {
269#ifndef NDEBUG
270#if MYTEST
271          Print("p_Setm_General: ro_is ord: pos: %d, p: ", pos);  p_DebugPrint(p, r, r, 1);
272#endif
273#endif
274
275          assume(p != NULL);
276
277          int c = p_GetComp(p, r);
278
279          assume( c >= 0 );
280          const ideal F = o->data.is.F;
281          const int limit = o->data.is.limit;
282
283          if( F != NULL && c > limit )
284          {
285#ifndef NDEBUG
286#if MYTEST
287            Print("p_Setm_General: ro_is : in rSetm: pos: %d, c: %d >  limit: %d\n", c, pos, limit); // p_DebugPrint(p, r, r, 1);
288#endif
289#endif
290
291            c -= limit;
292            assume( c > 0 );
293            c--;
294
295            assume( c < IDELEMS(F) ); // What about others???
296
297            const poly pp = F->m[c]; // get reference monomial!!!
298
299#ifndef NDEBUG
300#if MYTEST
301            Print("Respective F[c - %d: %d] pp: ", limit, c); 
302            p_DebugPrint(pp, r, r, 1);
303#endif
304#endif
305
306
307            assume(pp != NULL);
308            if(pp == NULL) break;
309
310            const int start = o->data.is.start;
311            const int end = o->data.is.end;
312
313            assume(start <= end);
314             
315//          const int limit = o->data.is.limit;
316          assume( limit >= 0 );
317
318//        const int st = o->data.isTemp.start;       
319
320          if( c > limit )
321            p->exp[start] = 1;
322//          else
323//            p->exp[start] = 0;
324
325             
326#ifndef NDEBUG
327            Print("p_Setm_General: is(-Temp-) :: c: %d, limit: %d, [st:%d] ===>>> %ld\n", c, limit, start, p->exp[start]);
328#endif       
329   
330
331            for( int i = start; i <= end; i++) // v[0] may be here...
332              p->exp[i] += pp->exp[i]; // !!!!!!!! ADD corresponding LT(F)
333
334       
335
336             
337#ifndef NDEBUG
338            const int* const pVarOffset = o->data.is.pVarOffset;
339
340            assume( pVarOffset != NULL );
341
342            for( int i = 1; i <= r->N; i++ ) // No v[0] here!!!
343            {
344              const int vo = pVarOffset[i];
345              if( vo != -1) // TODO: optimize: can be done once!
346                // Hans! Please don't break it again! p_GetExp(p/pp, r, vo) is correct:
347                assume( p_GetExp(p, r, vo) == (p_GetExp(p, i, r) + p_GetExp(pp, r, vo)) );
348            }
349            // TODO: how to check this for computed values???
350#endif
351          } else
352          {
353            const int* const pVarOffset = o->data.is.pVarOffset;
354
355            // What about v[0] - component: it will be added later by
356            // suffix!!!
357            // TODO: Test it!
358            const int vo = pVarOffset[0];
359            if( vo != -1 )
360              p->exp[vo] = c; // initial component v[0]!
361
362#ifndef NDEBUG
363#if MYTEST
364            Print("p_Setm_General: ro_is :: c: %d <= limit: %d, vo: %d, exp: %d\n", c, limit, vo, p->exp[vo]);
365            p_DebugPrint(p, r, r, 1);
366#endif       
367#endif       
368          }
369           
370
371          break;
372        }
373        default:
374          dReportError("wrong ord in rSetm:%d\n",o->ord_typ);
375          return;
376      }
377      pos++;
378      if (pos == r->OrdSize) return;
379    }
380  }
381}
382
383void p_Setm_Syz(poly p, ring r, int* Components, long* ShiftedComponents)
384{
385  _components = Components;
386  _componentsShifted = ShiftedComponents;
387  _componentsExternal = 1;
388  p_Setm_General(p, r);
389  _componentsExternal = 0;
390}
391
392// dummy for lp, ls, etc
393void p_Setm_Dummy(poly p, const ring r)
394{
395  p_LmCheckPolyRing(p, r);
396}
397
398// for dp, Dp, ds, etc
399void p_Setm_TotalDegree(poly p, const ring r)
400{
401  p_LmCheckPolyRing(p, r);
402  p->exp[r->pOrdIndex] = p_Totaldegree(p, r);
403}
404
405// for wp, Wp, ws, etc
406void p_Setm_WFirstTotalDegree(poly p, const ring r)
407{
408  p_LmCheckPolyRing(p, r);
409  p->exp[r->pOrdIndex] = p_WFirstTotalDegree(p, r);
410}
411
412p_SetmProc p_GetSetmProc(ring r)
413{
414  // covers lp, rp, ls,
415  if (r->typ == NULL) return p_Setm_Dummy;
416
417  if (r->OrdSize == 1)
418  {
419    if (r->typ[0].ord_typ == ro_dp &&
420        r->typ[0].data.dp.start == 1 &&
421        r->typ[0].data.dp.end == r->N &&
422        r->typ[0].data.dp.place == r->pOrdIndex)
423      return p_Setm_TotalDegree;
424    if (r->typ[0].ord_typ == ro_wp &&
425        r->typ[0].data.wp.start == 1 &&
426        r->typ[0].data.wp.end == r->N &&
427        r->typ[0].data.wp.place == r->pOrdIndex &&
428        r->typ[0].data.wp.weights == r->firstwv)
429      return p_Setm_WFirstTotalDegree;
430  }
431  return p_Setm_General;
432}
433
434
435/* -------------------------------------------------------------------*/
436/* several possibilities for pFDeg: the degree of the head term       */
437
438/* comptible with ordering */
439long p_Deg(poly a, const ring r)
440{
441  p_LmCheckPolyRing(a, r);
442  assume(p_GetOrder(a, r) == p_WTotaldegree(a, r));
443  return p_GetOrder(a, r);
444}
445
446// p_WTotalDegree for weighted orderings
447// whose first block covers all variables
448long p_WFirstTotalDegree(poly p, const ring r)
449{
450  int i;
451  long sum = 0;
452
453  for (i=1; i<= r->firstBlockEnds; i++)
454  {
455    sum += p_GetExp(p, i, r)*r->firstwv[i-1];
456  }
457  return sum;
458}
459
460/*2
461* compute the degree of the leading monomial of p
462* with respect to weigths from the ordering
463* the ordering is not compatible with degree so do not use p->Order
464*/
465long p_WTotaldegree(poly p, const ring r)
466{
467  p_LmCheckPolyRing(p, r);
468  int i, k;
469  long j =0;
470
471  // iterate through each block:
472  for (i=0;r->order[i]!=0;i++)
473  {
474    int b0=r->block0[i];
475    int b1=r->block1[i];
476    switch(r->order[i])
477    {
478      case ringorder_M:
479        for (k=b0 /*r->block0[i]*/;k<=b1 /*r->block1[i]*/;k++)
480        { // in jedem block:
481          j+= p_GetExp(p,k,r)*r->wvhdl[i][k - b0 /*r->block0[i]*/]*r->OrdSgn;
482        }
483        break;
484      case ringorder_wp:
485      case ringorder_ws:
486      case ringorder_Wp:
487      case ringorder_Ws:
488        for (k=b0 /*r->block0[i]*/;k<=b1 /*r->block1[i]*/;k++)
489        { // in jedem block:
490          j+= p_GetExp(p,k,r)*r->wvhdl[i][k - b0 /*r->block0[i]*/];
491        }
492        break;
493      case ringorder_lp:
494      case ringorder_ls:
495      case ringorder_rs:
496      case ringorder_dp:
497      case ringorder_ds:
498      case ringorder_Dp:
499      case ringorder_Ds:
500      case ringorder_rp:
501        for (k=b0 /*r->block0[i]*/;k<=b1 /*r->block1[i]*/;k++)
502        {
503          j+= p_GetExp(p,k,r);
504        }
505        break;
506      case ringorder_a64:
507        {
508          int64* w=(int64*)r->wvhdl[i];
509          for (k=0;k<=(b1 /*r->block1[i]*/ - b0 /*r->block0[i]*/);k++)
510          {
511            //there should be added a line which checks if w[k]>2^31
512            j+= p_GetExp(p,k+1, r)*(long)w[k];
513          }
514          //break;
515          return j;
516        }
517      case ringorder_c:
518      case ringorder_C:
519      case ringorder_S:
520      case ringorder_s:
521      case ringorder_IS:
522      case ringorder_aa:
523        break;
524      case ringorder_a:
525        for (k=b0 /*r->block0[i]*/;k<=b1 /*r->block1[i]*/;k++)
526        { // only one line
527          j+= p_GetExp(p,k, r)*r->wvhdl[i][ k- b0 /*r->block0[i]*/];
528        }
529        //break;
530        return j;
531
532#ifndef NDEBUG
533      default:
534        Print("missing order %d in p_WTotaldegree\n",r->order[i]);
535        break;
536#endif
537    }
538  }
539  return  j;
540}
541
542long p_DegW(poly p, const short *w, const ring R)
543{
544  long r=~0L;
545
546  while (p!=NULL)
547  {
548    long t=totaldegreeWecart_IV(p,R,w);
549    if (t>r) r=t;
550    pIter(p);
551  }
552  return r;
553}
554
555int p_Weight(int i, const ring r)
556{
557  if ((r->firstwv==NULL) || (i>r->firstBlockEnds))
558  {
559    return 1;
560  }
561  return r->firstwv[i-1];
562}
563
564long p_WDegree(poly p, const ring r)
565{
566  if (r->firstwv==NULL) return p_Totaldegree(p, r);
567  p_LmCheckPolyRing(p, r);
568  int i;
569  long j =0;
570
571  for(i=1;i<=r->firstBlockEnds;i++)
572    j+=p_GetExp(p, i, r)*r->firstwv[i-1];
573
574  for (;i<=r->N;i++)
575    j+=p_GetExp(p,i, r)*p_Weight(i, r);
576
577  return j;
578}
579
580
581/* ---------------------------------------------------------------------*/
582/* several possibilities for pLDeg: the maximal degree of a monomial in p*/
583/*  compute in l also the pLength of p                                   */
584
585/*2
586* compute the length of a polynomial (in l)
587* and the degree of the monomial with maximal degree: the last one
588*/
589long pLDeg0(poly p,int *l, const ring r)
590{
591  p_CheckPolyRing(p, r);
592  long k= p_GetComp(p, r);
593  int ll=1;
594
595  if (k > 0)
596  {
597    while ((pNext(p)!=NULL) && (p_GetComp(pNext(p), r)==k))
598    {
599      pIter(p);
600      ll++;
601    }
602  }
603  else
604  {
605     while (pNext(p)!=NULL)
606     {
607       pIter(p);
608       ll++;
609     }
610  }
611  *l=ll;
612  return r->pFDeg(p, r);
613}
614
615/*2
616* compute the length of a polynomial (in l)
617* and the degree of the monomial with maximal degree: the last one
618* but search in all components before syzcomp
619*/
620long pLDeg0c(poly p,int *l, const ring r)
621{
622  assume(p!=NULL);
623#ifdef PDEBUG
624  _p_Test(p,r,PDEBUG);
625#endif
626  p_CheckPolyRing(p, r);
627  long o;
628  int ll=1;
629
630  if (! rIsSyzIndexRing(r))
631  {
632    while (pNext(p) != NULL)
633    {
634      pIter(p);
635      ll++;
636    }
637    o = r->pFDeg(p, r);
638  }
639  else
640  {
641    int curr_limit = rGetCurrSyzLimit(r);
642    poly pp = p;
643    while ((p=pNext(p))!=NULL)
644    {
645      if (p_GetComp(p, r)<=curr_limit/*syzComp*/)
646        ll++;
647      else break;
648      pp = p;
649    }
650#ifdef PDEBUG
651    _p_Test(pp,r,PDEBUG);
652#endif
653    o = r->pFDeg(pp, r);
654  }
655  *l=ll;
656  return o;
657}
658
659/*2
660* compute the length of a polynomial (in l)
661* and the degree of the monomial with maximal degree: the first one
662* this works for the polynomial case with degree orderings
663* (both c,dp and dp,c)
664*/
665long pLDegb(poly p,int *l, const ring r)
666{
667  p_CheckPolyRing(p, r);
668  long k= p_GetComp(p, r);
669  long o = r->pFDeg(p, r);
670  int ll=1;
671
672  if (k != 0)
673  {
674    while (((p=pNext(p))!=NULL) && (p_GetComp(p, r)==k))
675    {
676      ll++;
677    }
678  }
679  else
680  {
681    while ((p=pNext(p)) !=NULL)
682    {
683      ll++;
684    }
685  }
686  *l=ll;
687  return o;
688}
689
690/*2
691* compute the length of a polynomial (in l)
692* and the degree of the monomial with maximal degree:
693* this is NOT the last one, we have to look for it
694*/
695long pLDeg1(poly p,int *l, const ring r)
696{
697  p_CheckPolyRing(p, r);
698  long k= p_GetComp(p, r);
699  int ll=1;
700  long  t,max;
701
702  max=r->pFDeg(p, r);
703  if (k > 0)
704  {
705    while (((p=pNext(p))!=NULL) && (p_GetComp(p, r)==k))
706    {
707      t=r->pFDeg(p, r);
708      if (t>max) max=t;
709      ll++;
710    }
711  }
712  else
713  {
714    while ((p=pNext(p))!=NULL)
715    {
716      t=r->pFDeg(p, r);
717      if (t>max) max=t;
718      ll++;
719    }
720  }
721  *l=ll;
722  return max;
723}
724
725/*2
726* compute the length of a polynomial (in l)
727* and the degree of the monomial with maximal degree:
728* this is NOT the last one, we have to look for it
729* in all components
730*/
731long pLDeg1c(poly p,int *l, const ring r)
732{
733  p_CheckPolyRing(p, r);
734  int ll=1;
735  long  t,max;
736
737  max=r->pFDeg(p, r);
738  if (rIsSyzIndexRing(r))
739  {
740    long limit = rGetCurrSyzLimit(r);
741    while ((p=pNext(p))!=NULL)
742    {
743      if (p_GetComp(p, r)<=limit)
744      {
745        if ((t=r->pFDeg(p, r))>max) max=t;
746        ll++;
747      }
748      else break;
749    }
750  }
751  else
752  {
753    while ((p=pNext(p))!=NULL)
754    {
755      if ((t=r->pFDeg(p, r))>max) max=t;
756      ll++;
757    }
758  }
759  *l=ll;
760  return max;
761}
762
763// like pLDeg1, only pFDeg == pDeg
764long pLDeg1_Deg(poly p,int *l, const ring r)
765{
766  assume(r->pFDeg == p_Deg);
767  p_CheckPolyRing(p, r);
768  long k= p_GetComp(p, r);
769  int ll=1;
770  long  t,max;
771
772  max=p_GetOrder(p, r);
773  if (k > 0)
774  {
775    while (((p=pNext(p))!=NULL) && (p_GetComp(p, r)==k))
776    {
777      t=p_GetOrder(p, r);
778      if (t>max) max=t;
779      ll++;
780    }
781  }
782  else
783  {
784    while ((p=pNext(p))!=NULL)
785    {
786      t=p_GetOrder(p, r);
787      if (t>max) max=t;
788      ll++;
789    }
790  }
791  *l=ll;
792  return max;
793}
794
795long pLDeg1c_Deg(poly p,int *l, const ring r)
796{
797  assume(r->pFDeg == p_Deg);
798  p_CheckPolyRing(p, r);
799  int ll=1;
800  long  t,max;
801
802  max=p_GetOrder(p, r);
803  if (rIsSyzIndexRing(r))
804  {
805    long limit = rGetCurrSyzLimit(r);
806    while ((p=pNext(p))!=NULL)
807    {
808      if (p_GetComp(p, r)<=limit)
809      {
810        if ((t=p_GetOrder(p, r))>max) max=t;
811        ll++;
812      }
813      else break;
814    }
815  }
816  else
817  {
818    while ((p=pNext(p))!=NULL)
819    {
820      if ((t=p_GetOrder(p, r))>max) max=t;
821      ll++;
822    }
823  }
824  *l=ll;
825  return max;
826}
827
828// like pLDeg1, only pFDeg == pTotoalDegree
829long pLDeg1_Totaldegree(poly p,int *l, const ring r)
830{
831  p_CheckPolyRing(p, r);
832  long k= p_GetComp(p, r);
833  int ll=1;
834  long  t,max;
835
836  max=p_Totaldegree(p, r);
837  if (k > 0)
838  {
839    while (((p=pNext(p))!=NULL) && (p_GetComp(p, r)==k))
840    {
841      t=p_Totaldegree(p, r);
842      if (t>max) max=t;
843      ll++;
844    }
845  }
846  else
847  {
848    while ((p=pNext(p))!=NULL)
849    {
850      t=p_Totaldegree(p, r);
851      if (t>max) max=t;
852      ll++;
853    }
854  }
855  *l=ll;
856  return max;
857}
858
859long pLDeg1c_Totaldegree(poly p,int *l, const ring r)
860{
861  p_CheckPolyRing(p, r);
862  int ll=1;
863  long  t,max;
864
865  max=p_Totaldegree(p, r);
866  if (rIsSyzIndexRing(r))
867  {
868    long limit = rGetCurrSyzLimit(r);
869    while ((p=pNext(p))!=NULL)
870    {
871      if (p_GetComp(p, r)<=limit)
872      {
873        if ((t=p_Totaldegree(p, r))>max) max=t;
874        ll++;
875      }
876      else break;
877    }
878  }
879  else
880  {
881    while ((p=pNext(p))!=NULL)
882    {
883      if ((t=p_Totaldegree(p, r))>max) max=t;
884      ll++;
885    }
886  }
887  *l=ll;
888  return max;
889}
890
891// like pLDeg1, only pFDeg == p_WFirstTotalDegree
892long pLDeg1_WFirstTotalDegree(poly p,int *l, const ring r)
893{
894  p_CheckPolyRing(p, r);
895  long k= p_GetComp(p, r);
896  int ll=1;
897  long  t,max;
898
899  max=p_WFirstTotalDegree(p, r);
900  if (k > 0)
901  {
902    while (((p=pNext(p))!=NULL) && (p_GetComp(p, r)==k))
903    {
904      t=p_WFirstTotalDegree(p, r);
905      if (t>max) max=t;
906      ll++;
907    }
908  }
909  else
910  {
911    while ((p=pNext(p))!=NULL)
912    {
913      t=p_WFirstTotalDegree(p, r);
914      if (t>max) max=t;
915      ll++;
916    }
917  }
918  *l=ll;
919  return max;
920}
921
922long pLDeg1c_WFirstTotalDegree(poly p,int *l, const ring r)
923{
924  p_CheckPolyRing(p, r);
925  int ll=1;
926  long  t,max;
927
928  max=p_WFirstTotalDegree(p, r);
929  if (rIsSyzIndexRing(r))
930  {
931    long limit = rGetCurrSyzLimit(r);
932    while ((p=pNext(p))!=NULL)
933    {
934      if (p_GetComp(p, r)<=limit)
935      {
936        if ((t=p_Totaldegree(p, r))>max) max=t;
937        ll++;
938      }
939      else break;
940    }
941  }
942  else
943  {
944    while ((p=pNext(p))!=NULL)
945    {
946      if ((t=p_Totaldegree(p, r))>max) max=t;
947      ll++;
948    }
949  }
950  *l=ll;
951  return max;
952}
953
954/***************************************************************
955 *
956 * Maximal Exponent business
957 *
958 ***************************************************************/
959
960static inline unsigned long
961p_GetMaxExpL2(unsigned long l1, unsigned long l2, const ring r,
962              unsigned long number_of_exp)
963{
964  const unsigned long bitmask = r->bitmask;
965  unsigned long ml1 = l1 & bitmask;
966  unsigned long ml2 = l2 & bitmask;
967  unsigned long max = (ml1 > ml2 ? ml1 : ml2);
968  unsigned long j = number_of_exp - 1;
969
970  if (j > 0)
971  {
972    unsigned long mask = bitmask << r->BitsPerExp;
973    while (1)
974    {
975      ml1 = l1 & mask;
976      ml2 = l2 & mask;
977      max |= ((ml1 > ml2 ? ml1 : ml2) & mask);
978      j--;
979      if (j == 0) break;
980      mask = mask << r->BitsPerExp;
981    }
982  }
983  return max;
984}
985
986static inline unsigned long
987p_GetMaxExpL2(unsigned long l1, unsigned long l2, const ring r)
988{
989  return p_GetMaxExpL2(l1, l2, r, r->ExpPerLong);
990}
991
992poly p_GetMaxExpP(poly p, const ring r)
993{
994  p_CheckPolyRing(p, r);
995  if (p == NULL) return p_Init(r);
996  poly max = p_LmInit(p, r);
997  pIter(p);
998  if (p == NULL) return max;
999  int i, offset;
1000  unsigned long l_p, l_max;
1001  unsigned long divmask = r->divmask;
1002
1003  do
1004  {
1005    offset = r->VarL_Offset[0];
1006    l_p = p->exp[offset];
1007    l_max = max->exp[offset];
1008    // do the divisibility trick to find out whether l has an exponent
1009    if (l_p > l_max ||
1010        (((l_max & divmask) ^ (l_p & divmask)) != ((l_max-l_p) & divmask)))
1011      max->exp[offset] = p_GetMaxExpL2(l_max, l_p, r);
1012
1013    for (i=1; i<r->VarL_Size; i++)
1014    {
1015      offset = r->VarL_Offset[i];
1016      l_p = p->exp[offset];
1017      l_max = max->exp[offset];
1018      // do the divisibility trick to find out whether l has an exponent
1019      if (l_p > l_max ||
1020          (((l_max & divmask) ^ (l_p & divmask)) != ((l_max-l_p) & divmask)))
1021        max->exp[offset] = p_GetMaxExpL2(l_max, l_p, r);
1022    }
1023    pIter(p);
1024  }
1025  while (p != NULL);
1026  return max;
1027}
1028
1029unsigned long p_GetMaxExpL(poly p, const ring r, unsigned long l_max)
1030{
1031  unsigned long l_p, divmask = r->divmask;
1032  int i;
1033
1034  while (p != NULL)
1035  {
1036    l_p = p->exp[r->VarL_Offset[0]];
1037    if (l_p > l_max ||
1038        (((l_max & divmask) ^ (l_p & divmask)) != ((l_max-l_p) & divmask)))
1039      l_max = p_GetMaxExpL2(l_max, l_p, r);
1040    for (i=1; i<r->VarL_Size; i++)
1041    {
1042      l_p = p->exp[r->VarL_Offset[i]];
1043      // do the divisibility trick to find out whether l has an exponent
1044      if (l_p > l_max ||
1045          (((l_max & divmask) ^ (l_p & divmask)) != ((l_max-l_p) & divmask)))
1046        l_max = p_GetMaxExpL2(l_max, l_p, r);
1047    }
1048    pIter(p);
1049  }
1050  return l_max;
1051}
1052
1053
1054
1055
1056/***************************************************************
1057 *
1058 * Misc things
1059 *
1060 ***************************************************************/
1061// returns TRUE, if all monoms have the same component
1062BOOLEAN p_OneComp(poly p, const ring r)
1063{
1064  if(p!=NULL)
1065  {
1066    long i = p_GetComp(p, r);
1067    while (pNext(p)!=NULL)
1068    {
1069      pIter(p);
1070      if(i != p_GetComp(p, r)) return FALSE;
1071    }
1072  }
1073  return TRUE;
1074}
1075
1076/*2
1077*test if a monomial /head term is a pure power
1078*/
1079int p_IsPurePower(const poly p, const ring r)
1080{
1081  int i,k=0;
1082
1083  for (i=r->N;i;i--)
1084  {
1085    if (p_GetExp(p,i, r)!=0)
1086    {
1087      if(k!=0) return 0;
1088      k=i;
1089    }
1090  }
1091  return k;
1092}
1093
1094/*2
1095*test if a polynomial is univariate
1096* return -1 for constant,
1097* 0 for not univariate,s
1098* i if dep. on var(i)
1099*/
1100int p_IsUnivariate(poly p, const ring r)
1101{
1102  int i,k=-1;
1103
1104  while (p!=NULL)
1105  {
1106    for (i=r->N;i;i--)
1107    {
1108      if (p_GetExp(p,i, r)!=0)
1109      {
1110        if((k!=-1)&&(k!=i)) return 0;
1111        k=i;
1112      }
1113    }
1114    pIter(p);
1115  }
1116  return k;
1117}
1118
1119// set entry e[i] to 1 if var(i) occurs in p, ignore var(j) if e[j]>0
1120int  p_GetVariables(poly p, int * e, const ring r)
1121{
1122  int i;
1123  int n=0;
1124  while(p!=NULL)
1125  {
1126    n=0;
1127    for(i=r->N; i>0; i--)
1128    {
1129      if(e[i]==0)
1130      {
1131        if (p_GetExp(p,i,r)>0)
1132        {
1133          e[i]=1;
1134          n++;
1135        }
1136      }
1137      else
1138        n++;
1139    }
1140    if (n==r->N) break;
1141    pIter(p);
1142  }
1143  return n;
1144}
1145
1146
1147/*2
1148* returns a polynomial representing the integer i
1149*/
1150poly p_ISet(int i, const ring r)
1151{
1152  poly rc = NULL;
1153  if (i!=0)
1154  {
1155    rc = p_Init(r);
1156    pSetCoeff0(rc,n_Init(i,r->cf));
1157    if (n_IsZero(pGetCoeff(rc),r->cf))
1158      p_LmDelete(&rc,r);
1159  }
1160  return rc;
1161}
1162
1163/*2
1164* an optimized version of p_ISet for the special case 1
1165*/
1166poly p_One(const ring r)
1167{
1168  poly rc = p_Init(r);
1169  pSetCoeff0(rc,n_Init(1,r->cf));
1170  return rc;
1171}
1172
1173void p_Split(poly p, poly *h)
1174{
1175  *h=pNext(p);
1176  pNext(p)=NULL;
1177}
1178
1179/*2
1180* pair has no common factor ? or is no polynomial
1181*/
1182BOOLEAN p_HasNotCF(poly p1, poly p2, const ring r)
1183{
1184
1185  if (p_GetComp(p1,r) > 0 || p_GetComp(p2,r) > 0)
1186    return FALSE;
1187  int i = rVar(r);
1188  loop
1189  {
1190    if ((p_GetExp(p1, i, r) > 0) && (p_GetExp(p2, i, r) > 0))
1191      return FALSE;
1192    i--;
1193    if (i == 0)
1194      return TRUE;
1195  }
1196}
1197
1198/*2
1199* convert monomial given as string to poly, e.g. 1x3y5z
1200*/
1201const char * p_Read(const char *st, poly &rc, const ring r)
1202{
1203  if (r==NULL) { rc=NULL;return st;}
1204  int i,j;
1205  rc = p_Init(r);
1206  const char *s = r->cf->cfRead(st,&(rc->coef),r->cf);
1207  if (s==st)
1208  /* i.e. it does not start with a coeff: test if it is a ringvar*/
1209  {
1210    j = r_IsRingVar(s,r);
1211    if (j >= 0)
1212    {
1213      p_IncrExp(rc,1+j,r);
1214      while (*s!='\0') s++;
1215      goto done;
1216    }
1217  }
1218  while (*s!='\0')
1219  {
1220    char ss[2];
1221    ss[0] = *s++;
1222    ss[1] = '\0';
1223    j = r_IsRingVar(ss,r);
1224    if (j >= 0)
1225    {
1226      const char *s_save=s;
1227      s = eati(s,&i);
1228      if (((unsigned long)i) >  r->bitmask)
1229      {
1230        // exponent to large: it is not a monomial
1231        p_LmDelete(&rc,r);
1232        return s_save;
1233      }
1234      p_AddExp(rc,1+j, (long)i, r);
1235    }
1236    else
1237    {
1238      // 1st char of is not a varname
1239      p_LmDelete(&rc,r);
1240      s--;
1241      return s;
1242    }
1243  }
1244done:
1245  if (n_IsZero(pGetCoeff(rc),r->cf)) p_LmDelete(&rc,r);
1246  else
1247  {
1248#ifdef HAVE_PLURAL
1249    // in super-commutative ring
1250    // squares of anti-commutative variables are zeroes!
1251    if(rIsSCA(r))
1252    {
1253      const unsigned int iFirstAltVar = scaFirstAltVar(r);
1254      const unsigned int iLastAltVar  = scaLastAltVar(r);
1255
1256      assume(rc != NULL);
1257
1258      for(unsigned int k = iFirstAltVar; k <= iLastAltVar; k++)
1259        if( p_GetExp(rc, k, r) > 1 )
1260        {
1261          p_LmDelete(&rc, r);
1262          goto finish;
1263        }
1264    }
1265#endif
1266
1267    p_Setm(rc,r);
1268  }
1269finish:
1270  return s;
1271}
1272poly p_mInit(const char *st, BOOLEAN &ok, const ring r)
1273{
1274  poly p;
1275  const char *s=p_Read(st,p,r);
1276  if (*s!='\0')
1277  {
1278    if ((s!=st)&&isdigit(st[0]))
1279    {
1280      errorreported=TRUE;
1281    }
1282    ok=FALSE;
1283    p_Delete(&p,r);
1284    return NULL;
1285  }
1286  #ifdef PDEBUG
1287  _p_Test(p,r,PDEBUG);
1288  #endif
1289  ok=!errorreported;
1290  return p;
1291}
1292
1293/*2
1294* returns a polynomial representing the number n
1295* destroys n
1296*/
1297poly p_NSet(number n, const ring r)
1298{
1299  if (n_IsZero(n,r->cf))
1300  {
1301    n_Delete(&n, r->cf);
1302    return NULL;
1303  }
1304  else
1305  {
1306    poly rc = p_Init(r);
1307    pSetCoeff0(rc,n);
1308    return rc;
1309  }
1310}
1311/*2
1312* assumes that LM(a) = LM(b)*m, for some monomial m,
1313* returns the multiplicant m,
1314* leaves a and b unmodified
1315*/
1316poly p_Divide(poly a, poly b, const ring r)
1317{
1318  assume((p_GetComp(a,r)==p_GetComp(b,r)) || (p_GetComp(b,r)==0));
1319  int i;
1320  poly result = p_Init(r);
1321
1322  for(i=(int)r->N; i; i--)
1323    p_SetExp(result,i, p_GetExp(a,i,r)- p_GetExp(b,i,r),r);
1324  p_SetComp(result, p_GetComp(a,r) - p_GetComp(b,r),r);
1325  p_Setm(result,r);
1326  return result;
1327}
1328
1329poly p_Div_nn(poly p, const number n, const ring r)
1330{
1331  pAssume(!n_IsZero(n,r->cf));
1332  p_Test(p, r);
1333
1334  poly q = p;
1335  while (p != NULL)
1336  {
1337    number nc = pGetCoeff(p);
1338    pSetCoeff0(p, n_Div(nc, n, r->cf));
1339    n_Delete(&nc, r->cf);
1340    pIter(p);
1341  }
1342  p_Test(q, r);
1343  return q;
1344}
1345
1346/*2
1347* divides a by the monomial b, ignores monomials which are not divisible
1348* assumes that b is not NULL, destroyes b
1349*/
1350poly p_DivideM(poly a, poly b, const ring r)
1351{
1352  if (a==NULL) { p_Delete(&b,r); return NULL; }
1353  poly result=a;
1354  poly prev=NULL;
1355  int i;
1356#ifdef HAVE_RINGS
1357  number inv=pGetCoeff(b);
1358#else
1359  number inv=n_Invers(pGetCoeff(b),r->cf);
1360#endif
1361
1362  while (a!=NULL)
1363  {
1364    if (p_DivisibleBy(b,a,r))
1365    {
1366      for(i=(int)r->N; i; i--)
1367         p_SubExp(a,i, p_GetExp(b,i,r),r);
1368      p_SubComp(a, p_GetComp(b,r),r);
1369      p_Setm(a,r);
1370      prev=a;
1371      pIter(a);
1372    }
1373    else
1374    {
1375      if (prev==NULL)
1376      {
1377        p_LmDelete(&result,r);
1378        a=result;
1379      }
1380      else
1381      {
1382        p_LmDelete(&pNext(prev),r);
1383        a=pNext(prev);
1384      }
1385    }
1386  }
1387#ifdef HAVE_RINGS
1388  if (n_IsUnit(inv,r->cf))
1389  {
1390    inv = n_Invers(inv,r->cf);
1391    p_Mult_nn(result,inv,r);
1392    n_Delete(&inv, r->cf);
1393  }
1394  else
1395  {
1396    p_Div_nn(result,inv,r);
1397  }
1398#else
1399  p_Mult_nn(result,inv,r);
1400  n_Delete(&inv, r->cf);
1401#endif
1402  p_Delete(&b, r);
1403  return result;
1404}
1405
1406#ifdef HAVE_RINGS
1407/* TRUE iff LT(f) | LT(g) */
1408BOOLEAN p_DivisibleByRingCase(poly f, poly g, const ring r)
1409{
1410  int exponent;
1411  for(int i = (int)rVar(r); i>0; i--)
1412  {
1413    exponent = p_GetExp(g, i, r) - p_GetExp(f, i, r);
1414    if (exponent < 0) return FALSE;
1415  }
1416  return n_DivBy(pGetCoeff(g), pGetCoeff(f), r->cf);
1417}
1418#endif
1419
1420/*2
1421* returns the LCM of the head terms of a and b in *m
1422*/
1423void p_Lcm(poly a, poly b, poly m, const ring r)
1424{
1425  int i;
1426  for (i=rVar(r); i; i--)
1427  {
1428    p_SetExp(m,i, si_max( p_GetExp(a,i,r), p_GetExp(b,i,r)),r);
1429  }
1430  p_SetComp(m, si_max(p_GetComp(a,r), p_GetComp(b,r)),r);
1431  /* Don't do a pSetm here, otherwise hres/lres chockes */
1432}
1433
1434/* assumes that p and divisor are univariate polynomials in r,
1435   mentioning the same variable;
1436   assumes divisor != NULL;
1437   p may be NULL;
1438   assumes a global monomial ordering in r;
1439   performs polynomial division of p by divisor:
1440     - afterwards p contains the remainder of the division, i.e.,
1441       p_before = result * divisor + p_afterwards;
1442     - if needResult == TRUE, then the method computes and returns 'result',
1443       otherwise NULL is returned (This parametrization can be used when
1444       one is only interested in the remainder of the division. In this
1445       case, the method will be slightly faster.)
1446   leaves divisor unmodified */
1447poly p_PolyDiv(poly &p, poly divisor, BOOLEAN needResult, ring r)
1448{
1449  assume(divisor != NULL);
1450  if (p == NULL) return NULL;
1451 
1452  poly result = NULL;
1453  number divisorLC = p_GetCoeff(divisor, r);
1454  int divisorLE = p_GetExp(divisor, 1, r);
1455  while ((p != NULL) && (p_Deg(p, r) >= p_Deg(divisor, r)))
1456  {
1457    /* determine t = LT(p) / LT(divisor) */
1458    poly t = p_ISet(1, r);
1459    number c = n_Div(p_GetCoeff(p, r), divisorLC, r->cf);
1460    p_SetCoeff(t, c, r);
1461    int e = p_GetExp(p, 1, r) - divisorLE;
1462    p_SetExp(t, 1, e, r);
1463    p_Setm(t, r);
1464    if (needResult) result = p_Add_q(result, p_Copy(t, r), r);
1465    p = p_Add_q(p, p_Neg(p_Mult_q(t, p_Copy(divisor, r), r), r), r);
1466  }
1467  return result;
1468}
1469
1470/* returns NULL if p == NULL, otherwise makes p monic by dividing
1471   by its leading coefficient (only done if this is not already 1);
1472   this assumes that we are over a ground field so that division
1473   is well-defined;
1474   modifies p */
1475void p_Monic(poly &p, ring r)
1476{
1477  if (p == NULL) return;
1478  poly pp = p;
1479  number lc = p_GetCoeff(p, r);
1480  if (n_IsOne(lc, r->cf)) return;
1481  number lcInverse = n_Invers(lc, r->cf);
1482  number n = n_Init(1, r->cf);
1483  p_SetCoeff(p, n, r);   // destroys old leading coefficient!
1484  p = pIter(p);
1485  while (p != NULL)
1486  {
1487    number n = n_Mult(p_GetCoeff(p, r), lcInverse, r->cf);
1488    p_SetCoeff(p, n, r);   // destroys old leading coefficient!
1489    p = pIter(p);
1490  }
1491  n_Delete(&lcInverse, r->cf);
1492  p = pp;
1493}
1494
1495/* see p_Gcd;
1496   additional assumption: deg(p) >= deg(q);
1497   must destroy p and q (unless one of them is returned) */
1498poly p_GcdHelper(poly &p, poly &q, ring r)
1499{
1500  if (q == NULL)
1501  {
1502    /* We have to make p monic before we return it, so that if the
1503       gcd is a unit in the ground field, we will actually return 1. */
1504    p_Monic(p, r);
1505    return p;
1506  }
1507  else
1508  {
1509    p_PolyDiv(p, q, FALSE, r);
1510    return p_GcdHelper(q, p, r);
1511  }
1512}
1513
1514/* assumes that p and q are univariate polynomials in r,
1515   mentioning the same variable;
1516   assumes a global monomial ordering in r;
1517   assumes that not both p and q are NULL;
1518   returns the gcd of p and q;
1519   leaves p and q unmodified */
1520poly p_Gcd(poly p, poly q, ring r)
1521{
1522  assume((p != NULL) || (q != NULL));
1523 
1524  poly a = p; poly b = q;
1525  if (p_Deg(a, r) < p_Deg(b, r)) { a = q; b = p; }
1526  a = p_Copy(a, r); b = p_Copy(b, r);
1527  return p_GcdHelper(a, b, r);
1528}
1529
1530/* see p_ExtGcd;
1531   additional assumption: deg(p) >= deg(q);
1532   must destroy p and q (unless one of them is returned) */
1533poly p_ExtGcdHelper(poly &p, poly &pFactor, poly &q, poly &qFactor,
1534                    ring r)
1535{
1536  if (q == NULL)
1537  {
1538    qFactor = NULL;
1539    pFactor = p_ISet(1, r);
1540    p_SetCoeff(pFactor, n_Invers(p_GetCoeff(p, r), r->cf), r);
1541    p_Monic(p, r);
1542    return p;
1543  }
1544  else
1545  {
1546    poly pDivQ = p_PolyDiv(p, q, TRUE, r);
1547    poly ppFactor = NULL; poly qqFactor = NULL;
1548    poly theGcd = p_ExtGcdHelper(q, qqFactor, p, ppFactor, r);
1549    pFactor = ppFactor;
1550    qFactor = p_Add_q(qqFactor,
1551                      p_Neg(p_Mult_q(pDivQ, p_Copy(ppFactor, r), r), r),
1552                      r);
1553    return theGcd;
1554  }
1555}
1556
1557/* assumes that p and q are univariate polynomials in r,
1558   mentioning the same variable;
1559   assumes a global monomial ordering in r;
1560   assumes that not both p and q are NULL;
1561   returns the gcd of p and q;
1562   moreover, afterwards pFactor and qFactor contain appropriate
1563   factors such that gcd(p, q) = p * pFactor + q * qFactor;
1564   leaves p and q unmodified */
1565poly p_ExtGcd(poly p, poly &pFactor, poly q, poly &qFactor, ring r)
1566{
1567  assume((p != NULL) || (q != NULL)); 
1568  poly a = p; poly b = q; BOOLEAN aCorrespondsToP = TRUE;
1569  if (p_Deg(a, r) < p_Deg(b, r))
1570  { a = q; b = p; aCorrespondsToP = FALSE; }
1571  a = p_Copy(a, r); b = p_Copy(b, r);
1572  poly aFactor = NULL; poly bFactor = NULL;
1573  poly theGcd = p_ExtGcdHelper(a, aFactor, b, bFactor, r);
1574  if (aCorrespondsToP) { pFactor = aFactor; qFactor = bFactor; }
1575  else                 { pFactor = bFactor; qFactor = aFactor; }
1576  return theGcd;
1577}
1578
1579/*2
1580* returns the partial differentiate of a by the k-th variable
1581* does not destroy the input
1582*/
1583poly p_Diff(poly a, int k, const ring r)
1584{
1585  poly res, f, last;
1586  number t;
1587
1588  last = res = NULL;
1589  while (a!=NULL)
1590  {
1591    if (p_GetExp(a,k,r)!=0)
1592    {
1593      f = p_LmInit(a,r);
1594      t = n_Init(p_GetExp(a,k,r),r->cf);
1595      pSetCoeff0(f,n_Mult(t,pGetCoeff(a),r->cf));
1596      n_Delete(&t,r->cf);
1597      if (n_IsZero(pGetCoeff(f),r->cf))
1598        p_LmDelete(&f,r);
1599      else
1600      {
1601        p_DecrExp(f,k,r);
1602        p_Setm(f,r);
1603        if (res==NULL)
1604        {
1605          res=last=f;
1606        }
1607        else
1608        {
1609          pNext(last)=f;
1610          last=f;
1611        }
1612      }
1613    }
1614    pIter(a);
1615  }
1616  return res;
1617}
1618
1619static poly p_DiffOpM(poly a, poly b,BOOLEAN multiply, const ring r)
1620{
1621  int i,j,s;
1622  number n,h,hh;
1623  poly p=p_One(r);
1624  n=n_Mult(pGetCoeff(a),pGetCoeff(b),r->cf);
1625  for(i=rVar(r);i>0;i--)
1626  {
1627    s=p_GetExp(b,i,r);
1628    if (s<p_GetExp(a,i,r))
1629    {
1630      n_Delete(&n,r->cf);
1631      p_LmDelete(&p,r);
1632      return NULL;
1633    }
1634    if (multiply)
1635    {
1636      for(j=p_GetExp(a,i,r); j>0;j--)
1637      {
1638        h = n_Init(s,r->cf);
1639        hh=n_Mult(n,h,r->cf);
1640        n_Delete(&h,r->cf);
1641        n_Delete(&n,r->cf);
1642        n=hh;
1643        s--;
1644      }
1645      p_SetExp(p,i,s,r);
1646    }
1647    else
1648    {
1649      p_SetExp(p,i,s-p_GetExp(a,i,r),r);
1650    }
1651  }
1652  p_Setm(p,r);
1653  /*if (multiply)*/ p_SetCoeff(p,n,r);
1654  if (n_IsZero(n,r->cf))  p=p_LmDeleteAndNext(p,r); // return NULL as p is a monomial
1655  return p;
1656}
1657
1658poly p_DiffOp(poly a, poly b,BOOLEAN multiply, const ring r)
1659{
1660  poly result=NULL;
1661  poly h;
1662  for(;a!=NULL;pIter(a))
1663  {
1664    for(h=b;h!=NULL;pIter(h))
1665    {
1666      result=p_Add_q(result,p_DiffOpM(a,h,multiply,r),r);
1667    }
1668  }
1669  return result;
1670}
1671/*2
1672* subtract p2 from p1, p1 and p2 are destroyed
1673* do not put attention on speed: the procedure is only used in the interpreter
1674*/
1675poly p_Sub(poly p1, poly p2, const ring r)
1676{
1677  return p_Add_q(p1, p_Neg(p2,r),r);
1678}
1679
1680/*3
1681* compute for a monomial m
1682* the power m^exp, exp > 1
1683* destroys p
1684*/
1685static poly p_MonPower(poly p, int exp, const ring r)
1686{
1687  int i;
1688
1689  if(!n_IsOne(pGetCoeff(p),r->cf))
1690  {
1691    number x, y;
1692    y = pGetCoeff(p);
1693    n_Power(y,exp,&x,r->cf);
1694    n_Delete(&y,r->cf);
1695    pSetCoeff0(p,x);
1696  }
1697  for (i=rVar(r); i!=0; i--)
1698  {
1699    p_MultExp(p,i, exp,r);
1700  }
1701  p_Setm(p,r);
1702  return p;
1703}
1704
1705/*3
1706* compute for monomials p*q
1707* destroys p, keeps q
1708*/
1709static void p_MonMult(poly p, poly q, const ring r)
1710{
1711  number x, y;
1712
1713  y = pGetCoeff(p);
1714  x = n_Mult(y,pGetCoeff(q),r->cf);
1715  n_Delete(&y,r->cf);
1716  pSetCoeff0(p,x);
1717  //for (int i=pVariables; i!=0; i--)
1718  //{
1719  //  pAddExp(p,i, pGetExp(q,i));
1720  //}
1721  //p->Order += q->Order;
1722  p_ExpVectorAdd(p,q,r);
1723}
1724
1725/*3
1726* compute for monomials p*q
1727* keeps p, q
1728*/
1729static poly p_MonMultC(poly p, poly q, const ring rr)
1730{
1731  number x;
1732  poly r = p_Init(rr);
1733
1734  x = n_Mult(pGetCoeff(p),pGetCoeff(q),rr->cf);
1735  pSetCoeff0(r,x);
1736  p_ExpVectorSum(r,p, q, rr);
1737  return r;
1738}
1739
1740/*3
1741*  create binomial coef.
1742*/
1743static number* pnBin(int exp, const ring r)
1744{
1745  int e, i, h;
1746  number x, y, *bin=NULL;
1747
1748  x = n_Init(exp,r->cf);
1749  if (n_IsZero(x,r->cf))
1750  {
1751    n_Delete(&x,r->cf);
1752    return bin;
1753  }
1754  h = (exp >> 1) + 1;
1755  bin = (number *)omAlloc0(h*sizeof(number));
1756  bin[1] = x;
1757  if (exp < 4)
1758    return bin;
1759  i = exp - 1;
1760  for (e=2; e<h; e++)
1761  {
1762      x = n_Init(i,r->cf);
1763      i--;
1764      y = n_Mult(x,bin[e-1],r->cf);
1765      n_Delete(&x,r->cf);
1766      x = n_Init(e,r->cf);
1767      bin[e] = n_IntDiv(y,x,r->cf);
1768      n_Delete(&x,r->cf);
1769      n_Delete(&y,r->cf);
1770  }
1771  return bin;
1772}
1773
1774static void pnFreeBin(number *bin, int exp,const coeffs r)
1775{
1776  int e, h = (exp >> 1) + 1;
1777
1778  if (bin[1] != NULL)
1779  {
1780    for (e=1; e<h; e++)
1781      n_Delete(&(bin[e]),r);
1782  }
1783  omFreeSize((ADDRESS)bin, h*sizeof(number));
1784}
1785
1786/*
1787*  compute for a poly p = head+tail, tail is monomial
1788*          (head + tail)^exp, exp > 1
1789*          with binomial coef.
1790*/
1791static poly p_TwoMonPower(poly p, int exp, const ring r)
1792{
1793  int eh, e;
1794  long al;
1795  poly *a;
1796  poly tail, b, res, h;
1797  number x;
1798  number *bin = pnBin(exp,r);
1799
1800  tail = pNext(p);
1801  if (bin == NULL)
1802  {
1803    p_MonPower(p,exp,r);
1804    p_MonPower(tail,exp,r);
1805#ifdef PDEBUG
1806    p_Test(p,r);
1807#endif
1808    return p;
1809  }
1810  eh = exp >> 1;
1811  al = (exp + 1) * sizeof(poly);
1812  a = (poly *)omAlloc(al);
1813  a[1] = p;
1814  for (e=1; e<exp; e++)
1815  {
1816    a[e+1] = p_MonMultC(a[e],p,r);
1817  }
1818  res = a[exp];
1819  b = p_Head(tail,r);
1820  for (e=exp-1; e>eh; e--)
1821  {
1822    h = a[e];
1823    x = n_Mult(bin[exp-e],pGetCoeff(h),r->cf);
1824    p_SetCoeff(h,x,r);
1825    p_MonMult(h,b,r);
1826    res = pNext(res) = h;
1827    p_MonMult(b,tail,r);
1828  }
1829  for (e=eh; e!=0; e--)
1830  {
1831    h = a[e];
1832    x = n_Mult(bin[e],pGetCoeff(h),r->cf);
1833    p_SetCoeff(h,x,r);
1834    p_MonMult(h,b,r);
1835    res = pNext(res) = h;
1836    p_MonMult(b,tail,r);
1837  }
1838  p_LmDelete(&tail,r);
1839  pNext(res) = b;
1840  pNext(b) = NULL;
1841  res = a[exp];
1842  omFreeSize((ADDRESS)a, al);
1843  pnFreeBin(bin, exp, r->cf);
1844//  tail=res;
1845// while((tail!=NULL)&&(pNext(tail)!=NULL))
1846// {
1847//   if(nIsZero(pGetCoeff(pNext(tail))))
1848//   {
1849//     pLmDelete(&pNext(tail));
1850//   }
1851//   else
1852//     pIter(tail);
1853// }
1854#ifdef PDEBUG
1855  p_Test(res,r);
1856#endif
1857  return res;
1858}
1859
1860static poly p_Pow(poly p, int i, const ring r)
1861{
1862  poly rc = p_Copy(p,r);
1863  i -= 2;
1864  do
1865  {
1866    rc = p_Mult_q(rc,p_Copy(p,r),r);
1867    p_Normalize(rc,r);
1868    i--;
1869  }
1870  while (i != 0);
1871  return p_Mult_q(rc,p,r);
1872}
1873
1874/*2
1875* returns the i-th power of p
1876* p will be destroyed
1877*/
1878poly p_Power(poly p, int i, const ring r)
1879{
1880  poly rc=NULL;
1881
1882  if (i==0)
1883  {
1884    p_Delete(&p,r);
1885    return p_One(r);
1886  }
1887
1888  if(p!=NULL)
1889  {
1890    if ( (i > 0) && ((unsigned long ) i > (r->bitmask)))
1891    {
1892      Werror("exponent %d is too large, max. is %ld",i,r->bitmask);
1893      return NULL;
1894    }
1895    switch (i)
1896    {
1897// cannot happen, see above
1898//      case 0:
1899//      {
1900//        rc=pOne();
1901//        pDelete(&p);
1902//        break;
1903//      }
1904      case 1:
1905        rc=p;
1906        break;
1907      case 2:
1908        rc=p_Mult_q(p_Copy(p,r),p,r);
1909        break;
1910      default:
1911        if (i < 0)
1912        {
1913          p_Delete(&p,r);
1914          return NULL;
1915        }
1916        else
1917        {
1918#ifdef HAVE_PLURAL
1919          if (rIsPluralRing(r)) /* in the NC case nothing helps :-( */
1920          {
1921            int j=i;
1922            rc = p_Copy(p,r);
1923            while (j>1)
1924            {
1925              rc = p_Mult_q(p_Copy(p,r),rc,r);
1926              j--;
1927            }
1928            p_Delete(&p,r);
1929            return rc;
1930          }
1931#endif
1932          rc = pNext(p);
1933          if (rc == NULL)
1934            return p_MonPower(p,i,r);
1935          /* else: binom ?*/
1936          int char_p=rChar(r);
1937          if ((pNext(rc) != NULL)
1938#ifdef HAVE_RINGS
1939             || rField_is_Ring(r)
1940#endif
1941             )
1942            return p_Pow(p,i,r);
1943          if ((char_p==0) || (i<=char_p))
1944            return p_TwoMonPower(p,i,r);
1945          poly p_p=p_TwoMonPower(p_Copy(p,r),char_p,r);
1946          return p_Mult_q(p_Power(p,i-char_p,r),p_p,r);
1947        }
1948      /*end default:*/
1949    }
1950  }
1951  return rc;
1952}
1953
1954/* --------------------------------------------------------------------------------*/
1955/* content suff                                                                   */
1956
1957static number p_InitContent(poly ph, const ring r);
1958static number p_InitContent_a(poly ph, const ring r);
1959
1960void p_Content(poly ph, const ring r)
1961{
1962#ifdef HAVE_RINGS
1963  if (rField_is_Ring(r))
1964  {
1965    if ((ph!=NULL) && rField_has_Units(r))
1966    {
1967      number k = n_GetUnit(pGetCoeff(ph),r->cf);
1968      if (!n_IsOne(k,r->cf))
1969      {
1970        number tmpGMP = k;
1971        k = n_Invers(k,r->cf);
1972        n_Delete(&tmpGMP,r->cf);
1973        poly h = pNext(ph);
1974        p_SetCoeff(ph, n_Mult(pGetCoeff(ph), k,r->cf),r);
1975        while (h != NULL)
1976        {
1977          p_SetCoeff(h, n_Mult(pGetCoeff(h), k,r->cf),r);
1978          pIter(h);
1979        }
1980      }
1981      n_Delete(&k,r->cf);
1982    }
1983    return;
1984  }
1985#endif
1986  number h,d;
1987  poly p;
1988
1989  if(TEST_OPT_CONTENTSB) return;
1990  if(pNext(ph)==NULL)
1991  {
1992    p_SetCoeff(ph,n_Init(1,r->cf),r);
1993  }
1994  else
1995  {
1996    n_Normalize(pGetCoeff(ph),r->cf);
1997    if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
1998    if (rField_is_Q(r))
1999    {
2000      h=p_InitContent(ph,r);
2001      p=ph;
2002    }
2003    else if (rField_is_Extension(r)
2004             &&
2005             (
2006              (rPar(r)>1) || rMinpolyIsNULL(r)
2007             )
2008            )
2009    {
2010      h=p_InitContent_a(ph,r);
2011      p=ph;
2012    }
2013    else
2014    {
2015      h=n_Copy(pGetCoeff(ph),r->cf);
2016      p = pNext(ph);
2017    }
2018    while (p!=NULL)
2019    {
2020      n_Normalize(pGetCoeff(p),r->cf);
2021      d=n_Gcd(h,pGetCoeff(p),r->cf);
2022      n_Delete(&h,r->cf);
2023      h = d;
2024      if(n_IsOne(h,r->cf))
2025      {
2026        break;
2027      }
2028      pIter(p);
2029    }
2030    p = ph;
2031    //number tmp;
2032    if(!n_IsOne(h,r->cf))
2033    {
2034      while (p!=NULL)
2035      {
2036        //d = nDiv(pGetCoeff(p),h);
2037        //tmp = nIntDiv(pGetCoeff(p),h);
2038        //if (!nEqual(d,tmp))
2039        //{
2040        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
2041        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
2042        //  nWrite(tmp);Print(StringAppendS("\n"));
2043        //}
2044        //nDelete(&tmp);
2045        d = n_IntDiv(pGetCoeff(p),h,r->cf);
2046        p_SetCoeff(p,d,r);
2047        pIter(p);
2048      }
2049    }
2050    n_Delete(&h,r->cf);
2051#ifdef HAVE_FACTORY
2052    if ( (n_GetChar(r) == 1) || (n_GetChar(r) < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
2053    {
2054      singclap_divide_content(ph, r);
2055      if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2056    }
2057#endif
2058    if (rField_is_Q_a(r))
2059    {
2060      //number hzz = nlInit(1, r->cf);
2061      h = nlInit(1, r->cf);
2062      p=ph;
2063      Werror("longalg missing 1");
2064      #if 0
2065      while (p!=NULL)
2066      { // each monom: coeff in Q_a
2067        lnumber c_n_n=(lnumber)pGetCoeff(p);
2068        poly c_n=c_n_n->z;
2069        while (c_n!=NULL)
2070        { // each monom: coeff in Q
2071          d=nlLcm(hzz,pGetCoeff(c_n),r->extRing->cf);
2072          n_Delete(&hzz,r->extRing->cf);
2073          hzz=d;
2074          pIter(c_n);
2075        }
2076        c_n=c_n_n->n;
2077        while (c_n!=NULL)
2078        { // each monom: coeff in Q
2079          d=nlLcm(h,pGetCoeff(c_n),r->extRing->cf);
2080          n_Delete(&h,r->extRing->cf);
2081          h=d;
2082          pIter(c_n);
2083        }
2084        pIter(p);
2085      }
2086      /* hzz contains the 1/lcm of all denominators in c_n_n->z*/
2087      /* h contains the 1/lcm of all denominators in c_n_n->n*/
2088      number htmp=nlInvers(h,r->extRing->cf);
2089      number hzztmp=nlInvers(hzz,r->extRing->cf);
2090      number hh=nlMult(hzz,h,r->extRing->cf);
2091      nlDelete(&hzz,r->extRing->cf);
2092      nlDelete(&h,r->extRing->cf);
2093      number hg=nlGcd(hzztmp,htmp,r->extRing->cf);
2094      nlDelete(&hzztmp,r->extRing->cf);
2095      nlDelete(&htmp,r->extRing->cf);
2096      h=nlMult(hh,hg,r->extRing->cf);
2097      nlDelete(&hg,r->extRing->cf);
2098      nlDelete(&hh,r->extRing->cf);
2099      nlNormalize(h,r->extRing->cf);
2100      if(!nlIsOne(h,r->extRing->cf))
2101      {
2102        p=ph;
2103        while (p!=NULL)
2104        { // each monom: coeff in Q_a
2105          lnumber c_n_n=(lnumber)pGetCoeff(p);
2106          poly c_n=c_n_n->z;
2107          while (c_n!=NULL)
2108          { // each monom: coeff in Q
2109            d=nlMult(h,pGetCoeff(c_n),r->extRing->cf);
2110            nlNormalize(d,r->extRing->cf);
2111            nlDelete(&pGetCoeff(c_n),r->extRing->cf);
2112            pGetCoeff(c_n)=d;
2113            pIter(c_n);
2114          }
2115          c_n=c_n_n->n;
2116          while (c_n!=NULL)
2117          { // each monom: coeff in Q
2118            d=nlMult(h,pGetCoeff(c_n),r->extRing->cf);
2119            nlNormalize(d,r->extRing->cf);
2120            nlDelete(&pGetCoeff(c_n),r->extRing->cf);
2121            pGetCoeff(c_n)=d;
2122            pIter(c_n);
2123          }
2124          pIter(p);
2125        }
2126      }
2127      nlDelete(&h,r->extRing->cf);
2128      #endif
2129    }
2130  }
2131}
2132#if 0 // currently not used
2133void p_SimpleContent(poly ph,int smax, const ring r)
2134{
2135  if(TEST_OPT_CONTENTSB) return;
2136  if (ph==NULL) return;
2137  if (pNext(ph)==NULL)
2138  {
2139    p_SetCoeff(ph,n_Init(1,r_cf),r);
2140    return;
2141  }
2142  if ((pNext(pNext(ph))==NULL)||(!rField_is_Q(r)))
2143  {
2144    return;
2145  }
2146  number d=p_InitContent(ph,r);
2147  if (nlSize(d,r->cf)<=smax)
2148  {
2149    //if (TEST_OPT_PROT) PrintS("G");
2150    return;
2151  }
2152  poly p=ph;
2153  number h=d;
2154  if (smax==1) smax=2;
2155  while (p!=NULL)
2156  {
2157#if 0
2158    d=nlGcd(h,pGetCoeff(p),r->cf);
2159    nlDelete(&h,r->cf);
2160    h = d;
2161#else
2162    nlInpGcd(h,pGetCoeff(p),r->cf);
2163#endif
2164    if(nlSize(h,r->cf)<smax)
2165    {
2166      //if (TEST_OPT_PROT) PrintS("g");
2167      return;
2168    }
2169    pIter(p);
2170  }
2171  p = ph;
2172  if (!nlGreaterZero(pGetCoeff(p),r->cf)) h=nlNeg(h,r->cf);
2173  if(nlIsOne(h,r->cf)) return;
2174  //if (TEST_OPT_PROT) PrintS("c");
2175  while (p!=NULL)
2176  {
2177#if 1
2178    d = nlIntDiv(pGetCoeff(p),h,r->cf);
2179    p_SetCoeff(p,d,r);
2180#else
2181    nlInpIntDiv(pGetCoeff(p),h,r->cf);
2182#endif
2183    pIter(p);
2184  }
2185  nlDelete(&h,r->cf);
2186}
2187#endif
2188
2189static number p_InitContent(poly ph, const ring r)
2190// only for coefficients in Q
2191#if 0
2192{
2193  assume(!TEST_OPT_CONTENTSB);
2194  assume(ph!=NULL);
2195  assume(pNext(ph)!=NULL);
2196  assume(rField_is_Q(r));
2197  if (pNext(pNext(ph))==NULL)
2198  {
2199    return nlGetNom(pGetCoeff(pNext(ph)),r->cf);
2200  }
2201  poly p=ph;
2202  number n1=nlGetNom(pGetCoeff(p),r->cf);
2203  pIter(p);
2204  number n2=nlGetNom(pGetCoeff(p),r->cf);
2205  pIter(p);
2206  number d;
2207  number t;
2208  loop
2209  {
2210    nlNormalize(pGetCoeff(p),r->cf);
2211    t=nlGetNom(pGetCoeff(p),r->cf);
2212    if (nlGreaterZero(t,r->cf))
2213      d=nlAdd(n1,t,r->cf);
2214    else
2215      d=nlSub(n1,t,r->cf);
2216    nlDelete(&t,r->cf);
2217    nlDelete(&n1,r->cf);
2218    n1=d;
2219    pIter(p);
2220    if (p==NULL) break;
2221    nlNormalize(pGetCoeff(p),r->cf);
2222    t=nlGetNom(pGetCoeff(p),r->cf);
2223    if (nlGreaterZero(t,r->cf))
2224      d=nlAdd(n2,t,r->cf);
2225    else
2226      d=nlSub(n2,t,r->cf);
2227    nlDelete(&t,r->cf);
2228    nlDelete(&n2,r->cf);
2229    n2=d;
2230    pIter(p);
2231    if (p==NULL) break;
2232  }
2233  d=nlGcd(n1,n2,r->cf);
2234  nlDelete(&n1,r->cf);
2235  nlDelete(&n2,r->cf);
2236  return d;
2237}
2238#else
2239{
2240  number d=pGetCoeff(ph);
2241  if(SR_HDL(d)&SR_INT) return d;
2242  int s=mpz_size1(d->z);
2243  int s2=-1;
2244  number d2;
2245  loop
2246  {
2247    pIter(ph);
2248    if(ph==NULL)
2249    {
2250      if (s2==-1) return nlCopy(d,r->cf);
2251      break;
2252    }
2253    if (SR_HDL(pGetCoeff(ph))&SR_INT)
2254    {
2255      s2=s;
2256      d2=d;
2257      s=0;
2258      d=pGetCoeff(ph);
2259      if (s2==0) break;
2260    }
2261    else
2262    if (mpz_size1((pGetCoeff(ph)->z))<=s)
2263    {
2264      s2=s;
2265      d2=d;
2266      d=pGetCoeff(ph);
2267      s=mpz_size1(d->z);
2268    }
2269  }
2270  return nlGcd(d,d2,r->cf);
2271}
2272#endif
2273
2274number p_InitContent_a(poly ph, const ring r)
2275// only for coefficients in K(a)/<minpoly(a)> and K(t_1, t_2, ..., t_n)
2276{
2277  number d=pGetCoeff(ph);
2278  /* old: int s=n_ParDeg(d,r->cf);   new: */
2279  int s = p_Totaldegree((poly)d, r->cf->extRing);
2280  if (s <=1) return n_Copy(d,r->cf);
2281  int s2=-1;
2282  number d2;
2283  int ss;
2284  loop
2285  {
2286    pIter(ph);
2287    if(ph==NULL)
2288    {
2289      if (s2==-1) return n_Copy(d,r->cf);
2290      break;
2291    }
2292    /* old: if ((ss=n_ParDeg(pGetCoeff(ph),r->cf))<s)   new: */
2293    if ((ss = p_Totaldegree((poly)pGetCoeff(ph), r->cf->extRing)) < 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        p_Normalize(aq,dst);
3410        if (aq==NULL)
3411          p_SetCoeff(qq,n_Init(0,dst->cf),dst);
3412      }
3413      p_Test(aq,dst);
3414      #endif
3415    }
3416    if (rRing_has_Comp(dst)) p_SetComp(qq, p_GetComp(p,oldRing),dst);
3417    if (n_IsZero(pGetCoeff(qq),dst->cf))
3418    {
3419      p_LmDelete(&qq,dst);
3420    }
3421    else
3422    {
3423      int i;
3424      int mapped_to_par=0;
3425      for(i=1; i<=OldpVariables; i++)
3426      {
3427        int e=p_GetExp(p,i,oldRing);
3428        if (e!=0)
3429        {
3430          if (perm==NULL)
3431          {
3432            p_SetExp(qq,i, e, dst);
3433          }
3434          else if (perm[i]>0)
3435            p_AddExp(qq,perm[i], e/*p_GetExp( p,i,oldRing)*/, dst);
3436          else if (perm[i]<0)
3437          {
3438            if (rField_is_GF(dst))
3439            {
3440              number c=pGetCoeff(qq);
3441              number ee=(number)rGetVar(1, dst->cf->extRing);
3442              number eee;n_Power(ee,e,&eee,dst->cf); //nfDelete(ee,dst);
3443              ee=n_Mult(c,eee,dst->cf);
3444              //nfDelete(c,dst);nfDelete(eee,dst);
3445              pSetCoeff0(qq,ee);
3446            }
3447            else
3448            {
3449              WerrorS("longalg missing 3");
3450              #if 0
3451              lnumber c=(lnumber)pGetCoeff(qq);
3452              if (c->z->next==NULL)
3453                p_AddExp(c->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/,dst->extRing);
3454              else /* more difficult: we have really to multiply: */
3455              {
3456                lnumber mmc=(lnumber)naInit(1,dst);
3457                p_SetExp(mmc->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/,dst->extRing);
3458                p_Setm(mmc->z,dst->extRing->cf);
3459                pGetCoeff(qq)=n_Mult((number)c,(number)mmc,dst->cf);
3460                n_Delete((number *)&c,dst->cf);
3461                n_Delete((number *)&mmc,dst->cf);
3462              }
3463              mapped_to_par=1;
3464              #endif
3465            }
3466          }
3467          else
3468          {
3469            /* this variable maps to 0 !*/
3470            p_LmDelete(&qq,dst);
3471            break;
3472          }
3473        }
3474      }
3475      if (mapped_to_par
3476      && (!rMinpolyIsNULL(dst)))
3477      {
3478        number n=pGetCoeff(qq);
3479        n_Normalize(n,dst->cf);
3480        pGetCoeff(qq)=n;
3481      }
3482    }
3483    pIter(p);
3484#if 1
3485    if (qq!=NULL)
3486    {
3487      p_Setm(qq,dst);
3488      p_Test(aq,dst);
3489      p_Test(qq,dst);
3490      if (aq!=NULL) qq=p_Mult_q(aq,qq,dst);
3491      aq = qq;
3492      while (pNext(aq) != NULL) pIter(aq);
3493      if (result_last==NULL)
3494      {
3495        result=qq;
3496      }
3497      else
3498      {
3499        pNext(result_last)=qq;
3500      }
3501      result_last=aq;
3502      aq = NULL;
3503    }
3504    else if (aq!=NULL)
3505    {
3506      p_Delete(&aq,dst);
3507    }
3508  }
3509  result=p_SortAdd(result,dst);
3510#else
3511  //  if (qq!=NULL)
3512  //  {
3513  //    pSetm(qq);
3514  //    pTest(qq);
3515  //    pTest(aq);
3516  //    if (aq!=NULL) qq=pMult(aq,qq);
3517  //    aq = qq;
3518  //    while (pNext(aq) != NULL) pIter(aq);
3519  //    pNext(aq) = result;
3520  //    aq = NULL;
3521  //    result = qq;
3522  //  }
3523  //  else if (aq!=NULL)
3524  //  {
3525  //    pDelete(&aq);
3526  //  }
3527  //}
3528  //p = result;
3529  //result = NULL;
3530  //while (p != NULL)
3531  //{
3532  //  qq = p;
3533  //  pIter(p);
3534  //  qq->next = NULL;
3535  //  result = pAdd(result, qq);
3536  //}
3537#endif
3538  p_Test(result,dst);
3539  return result;
3540}
3541/**************************************************************
3542 *
3543 * Jet
3544 *
3545 **************************************************************/
3546
3547poly pp_Jet(poly p, int m, const ring R)
3548{
3549  poly r=NULL;
3550  poly t=NULL;
3551
3552  while (p!=NULL)
3553  {
3554    if (p_Totaldegree(p,R)<=m)
3555    {
3556      if (r==NULL)
3557        r=p_Head(p,R);
3558      else
3559      if (t==NULL)
3560      {
3561        pNext(r)=p_Head(p,R);
3562        t=pNext(r);
3563      }
3564      else
3565      {
3566        pNext(t)=p_Head(p,R);
3567        pIter(t);
3568      }
3569    }
3570    pIter(p);
3571  }
3572  return r;
3573}
3574
3575poly p_Jet(poly p, int m,const ring R)
3576{
3577  poly t=NULL;
3578
3579  while((p!=NULL) && (p_Totaldegree(p,R)>m)) p_LmDelete(&p,R);
3580  if (p==NULL) return NULL;
3581  poly r=p;
3582  while (pNext(p)!=NULL)
3583  {
3584    if (p_Totaldegree(pNext(p),R)>m)
3585    {
3586      p_LmDelete(&pNext(p),R);
3587    }
3588    else
3589      pIter(p);
3590  }
3591  return r;
3592}
3593
3594poly pp_JetW(poly p, int m, short *w, const ring R)
3595{
3596  poly r=NULL;
3597  poly t=NULL;
3598  while (p!=NULL)
3599  {
3600    if (totaldegreeWecart_IV(p,R,w)<=m)
3601    {
3602      if (r==NULL)
3603        r=p_Head(p,R);
3604      else
3605      if (t==NULL)
3606      {
3607        pNext(r)=p_Head(p,R);
3608        t=pNext(r);
3609      }
3610      else
3611      {
3612        pNext(t)=p_Head(p,R);
3613        pIter(t);
3614      }
3615    }
3616    pIter(p);
3617  }
3618  return r;
3619}
3620
3621poly p_JetW(poly p, int m, short *w, const ring R)
3622{
3623  while((p!=NULL) && (totaldegreeWecart_IV(p,R,w)>m)) p_LmDelete(&p,R);
3624  if (p==NULL) return NULL;
3625  poly r=p;
3626  while (pNext(p)!=NULL)
3627  {
3628    if (totaldegreeWecart_IV(pNext(p),R,w)>m)
3629    {
3630      p_LmDelete(&pNext(p),R);
3631    }
3632    else
3633      pIter(p);
3634  }
3635  return r;
3636}
3637
3638/*************************************************************/
3639int p_MinDeg(poly p,intvec *w, const ring R)
3640{
3641  if(p==NULL)
3642    return -1;
3643  int d=-1;
3644  while(p!=NULL)
3645  {
3646    int d0=0;
3647    for(int j=0;j<rVar(R);j++)
3648      if(w==NULL||j>=w->length())
3649        d0+=p_GetExp(p,j+1,R);
3650      else
3651        d0+=(*w)[j]*p_GetExp(p,j+1,R);
3652    if(d0<d||d==-1)
3653      d=d0;
3654    pIter(p);
3655  }
3656  return d;
3657}
3658
3659/***************************************************************/
3660
3661poly p_Series(int n,poly p,poly u, intvec *w, const ring R)
3662{
3663  short *ww=iv2array(w,R);
3664  if(p!=NULL)
3665  {
3666    if(u==NULL)
3667      p=p_JetW(p,n,ww,R);
3668    else
3669      p=p_JetW(p_Mult_q(p,p_Invers(n-p_MinDeg(p,w,R),u,w,R),R),n,ww,R);
3670  }
3671  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
3672  return p;
3673}
3674
3675poly p_Invers(int n,poly u,intvec *w, const ring R)
3676{
3677  if(n<0)
3678    return NULL;
3679  number u0=n_Invers(pGetCoeff(u),R->cf);
3680  poly v=p_NSet(u0,R);
3681  if(n==0)
3682    return v;
3683  short *ww=iv2array(w,R);
3684  poly u1=p_JetW(p_Sub(p_One(R),p_Mult_nn(u,u0,R),R),n,ww,R);
3685  if(u1==NULL)
3686  {
3687    omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
3688    return v;
3689  }
3690  poly v1=p_Mult_nn(p_Copy(u1,R),u0,R);
3691  v=p_Add_q(v,p_Copy(v1,R),R);
3692  for(int i=n/p_MinDeg(u1,w,R);i>1;i--)
3693  {
3694    v1=p_JetW(p_Mult_q(v1,p_Copy(u1,R),R),n,ww,R);
3695    v=p_Add_q(v,p_Copy(v1,R),R);
3696  }
3697  p_Delete(&u1,R);
3698  p_Delete(&v1,R);
3699  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
3700  return v;
3701}
3702
3703BOOLEAN p_EqualPolys(poly p1,poly p2, const ring r)
3704{
3705  while ((p1 != NULL) && (p2 != NULL))
3706  {
3707    if (! p_LmEqual(p1, p2,r))
3708      return FALSE;
3709    if (! n_Equal(p_GetCoeff(p1,r), p_GetCoeff(p2,r),r ))
3710      return FALSE;
3711    pIter(p1);
3712    pIter(p2);
3713  }
3714  return (p1==p2);
3715}
3716
3717/*2
3718*returns TRUE if p1 is a skalar multiple of p2
3719*assume p1 != NULL and p2 != NULL
3720*/
3721BOOLEAN p_ComparePolys(poly p1,poly p2, const ring r)
3722{
3723  number n,nn;
3724  pAssume(p1 != NULL && p2 != NULL);
3725
3726  if (!p_LmEqual(p1,p2,r)) //compare leading mons
3727      return FALSE;
3728  if ((pNext(p1)==NULL) && (pNext(p2)!=NULL))
3729     return FALSE;
3730  if ((pNext(p2)==NULL) && (pNext(p1)!=NULL))
3731     return FALSE;
3732  if (pLength(p1) != pLength(p2))
3733    return FALSE;
3734#ifdef HAVE_RINGS
3735  if (rField_is_Ring(r))
3736  {
3737    if (!n_DivBy(p_GetCoeff(p1, r), p_GetCoeff(p2, r), r)) return FALSE;
3738  }
3739#endif
3740  n=n_Div(p_GetCoeff(p1,r),p_GetCoeff(p2,r),r);
3741  while ((p1 != NULL) /*&& (p2 != NULL)*/)
3742  {
3743    if ( ! p_LmEqual(p1, p2,r))
3744    {
3745        n_Delete(&n, r);
3746        return FALSE;
3747    }
3748    if (!n_Equal(p_GetCoeff(p1, r), nn = n_Mult(p_GetCoeff(p2, r),n, r), r))
3749    {
3750      n_Delete(&n, r);
3751      n_Delete(&nn, r);
3752      return FALSE;
3753    }
3754    n_Delete(&nn, r);
3755    pIter(p1);
3756    pIter(p2);
3757  }
3758  n_Delete(&n, r);
3759  return TRUE;
3760}
3761
3762
3763/***************************************************************
3764 *
3765 * p_ShallowDelete
3766 *
3767 ***************************************************************/
3768#undef LINKAGE
3769#define LINKAGE
3770#undef p_Delete__T
3771#define p_Delete__T p_ShallowDelete
3772#undef n_Delete__T
3773#define n_Delete__T(n, r) ((void)0)
3774
3775#include <polys/templates/p_Delete__T.cc>
3776
Note: See TracBrowser for help on using the repository browser.