source: git/libpolys/polys/monomials/p_polys.cc @ 1745e5

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