source: git/libpolys/polys/monomials/p_polys.cc @ 3d0808

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