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

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