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

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