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

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