source: git/libpolys/polys/monomials/p_polys.cc @ 7a8011

fieker-DuValspielwiese
Last change on this file since 7a8011 was 01c1d0, checked in by Oleksandr Motsak <motsak@…>, 13 years ago
FIX: moved P/minpoly/parameters from ring to coeff
  • Property mode set to 100644
File size: 74.7 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->cf->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=r->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=r->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* convert a vector to a set of polys,
2853* allocates the polyset, (entries 0..(*len)-1)
2854* the vector will not be changed
2855*/
2856void  p_Vec2Polys(poly v, poly* *p, int *len, const ring r)
2857{
2858  poly h;
2859  int k;
2860
2861  *len=p_MaxComp(v,r);
2862  if (*len==0) *len=1;
2863  *p=(poly*)omAlloc0((*len)*sizeof(poly));
2864  while (v!=NULL)
2865  {
2866    h=p_Head(v,r);
2867    k=p_GetComp(h,r);
2868    p_SetComp(h,0,r);
2869    (*p)[k-1]=p_Add_q((*p)[k-1],h,r);
2870    pIter(v);
2871  }
2872}
2873
2874/* -------------------------------------------------------- */
2875/*2
2876* change all global variables to fit the description of the new ring
2877*/
2878
2879void p_SetGlobals(const ring r, BOOLEAN complete)
2880{
2881  int i;
2882  if (r->ppNoether!=NULL) p_Delete(&r->ppNoether,r);
2883
2884  if (complete)
2885  {
2886    test &= ~ TEST_RINGDEP_OPTS;
2887    test |= r->options;
2888  }
2889}
2890//
2891// resets the pFDeg and pLDeg: if pLDeg is not given, it is
2892// set to currRing->pLDegOrig, i.e. to the respective LDegProc which
2893// only uses pFDeg (and not p_Deg, or pTotalDegree, etc)
2894void pSetDegProcs(ring r, pFDegProc new_FDeg, pLDegProc new_lDeg)
2895{
2896  assume(new_FDeg != NULL);
2897  r->pFDeg = new_FDeg;
2898
2899  if (new_lDeg == NULL)
2900    new_lDeg = r->pLDegOrig;
2901
2902  r->pLDeg = new_lDeg;
2903}
2904
2905// restores pFDeg and pLDeg:
2906void pRestoreDegProcs(ring r, pFDegProc old_FDeg, pLDegProc old_lDeg)
2907{
2908  assume(old_FDeg != NULL && old_lDeg != NULL);
2909  r->pFDeg = old_FDeg;
2910  r->pLDeg = old_lDeg;
2911}
2912
2913/*-------- several access procedures to monomials -------------------- */
2914/*
2915* the module weights for std
2916*/
2917static pFDegProc pOldFDeg;
2918static pLDegProc pOldLDeg;
2919static intvec * pModW;
2920static BOOLEAN pOldLexOrder;
2921
2922static long pModDeg(poly p, ring r)
2923{
2924  long d=pOldFDeg(p, r);
2925  int c=p_GetComp(p, r);
2926  if ((c>0) && ((r->pModW)->range(c-1))) d+= (*(r->pModW))[c-1];
2927  return d;
2928  //return pOldFDeg(p, r)+(*pModW)[p_GetComp(p, r)-1];
2929}
2930
2931void p_SetModDeg(intvec *w, ring r)
2932{
2933  if (w!=NULL)
2934  {
2935    r->pModW = w;
2936    pOldFDeg = r->pFDeg;
2937    pOldLDeg = r->pLDeg;
2938    pOldLexOrder = r->pLexOrder;
2939    pSetDegProcs(r,pModDeg);
2940    r->pLexOrder = TRUE;
2941  }
2942  else
2943  {
2944    r->pModW = NULL;
2945    pRestoreDegProcs(r,pOldFDeg, pOldLDeg);
2946    r->pLexOrder = pOldLexOrder;
2947  }
2948}
2949
2950/*2
2951* handle memory request for sets of polynomials (ideals)
2952* l is the length of *p, increment is the difference (may be negative)
2953*/
2954void pEnlargeSet(poly* *p, int l, int increment)
2955{
2956  poly* h;
2957
2958  h=(poly*)omReallocSize((poly*)*p,l*sizeof(poly),(l+increment)*sizeof(poly));
2959  if (increment>0)
2960  {
2961    //for (i=l; i<l+increment; i++)
2962    //  h[i]=NULL;
2963    memset(&(h[l]),0,increment*sizeof(poly));
2964  }
2965  *p=h;
2966}
2967
2968/*2
2969*divides p1 by its leading coefficient
2970*/
2971void p_Norm(poly p1, const ring r)
2972{
2973#ifdef HAVE_RINGS
2974  if (rField_is_Ring(r))
2975  {
2976    if (!n_IsUnit(pGetCoeff(p1), r->cf)) return;
2977    // Werror("p_Norm not possible in the case of coefficient rings.");
2978  }
2979  else
2980#endif
2981  if (p1!=NULL)
2982  {
2983    if (pNext(p1)==NULL)
2984    {
2985      p_SetCoeff(p1,n_Init(1,r->cf),r);
2986      return;
2987    }
2988    poly h;
2989    if (!n_IsOne(pGetCoeff(p1),r->cf))
2990    {
2991      number k, c;
2992      n_Normalize(pGetCoeff(p1),r->cf);
2993      k = pGetCoeff(p1);
2994      c = n_Init(1,r->cf);
2995      pSetCoeff0(p1,c);
2996      h = pNext(p1);
2997      while (h!=NULL)
2998      {
2999        c=n_Div(pGetCoeff(h),k,r->cf);
3000        // no need to normalize: Z/p, R
3001        // normalize already in nDiv: Q_a, Z/p_a
3002        // remains: Q
3003        if (rField_is_Q(r) && (!n_IsOne(c,r->cf))) n_Normalize(c,r->cf);
3004        p_SetCoeff(h,c,r);
3005        pIter(h);
3006      }
3007      n_Delete(&k,r->cf);
3008    }
3009    else
3010    {
3011      //if (r->cf->cfNormalize != nDummy2) //TODO: OPTIMIZE
3012      {
3013        h = pNext(p1);
3014        while (h!=NULL)
3015        {
3016          n_Normalize(pGetCoeff(h),r->cf);
3017          pIter(h);
3018        }
3019      }
3020    }
3021  }
3022}
3023
3024/*2
3025*normalize all coefficients
3026*/
3027void p_Normalize(poly p,const ring r)
3028{
3029  if (rField_has_simple_inverse(r)) return; /* Z/p, GF(p,n), R, long R/C */
3030  while (p!=NULL)
3031  {
3032#ifdef LDEBUG
3033    n_Test(pGetCoeff(p), r->cf);
3034#endif
3035    n_Normalize(pGetCoeff(p),r->cf);
3036    pIter(p);
3037  }
3038}
3039
3040// splits p into polys with Exp(n) == 0 and Exp(n) != 0
3041// Poly with Exp(n) != 0 is reversed
3042static void p_SplitAndReversePoly(poly p, int n, poly *non_zero, poly *zero, const ring r)
3043{
3044  if (p == NULL)
3045  {
3046    *non_zero = NULL;
3047    *zero = NULL;
3048    return;
3049  }
3050  spolyrec sz;
3051  poly z, n_z, next;
3052  z = &sz;
3053  n_z = NULL;
3054
3055  while(p != NULL)
3056  {
3057    next = pNext(p);
3058    if (p_GetExp(p, n,r) == 0)
3059    {
3060      pNext(z) = p;
3061      pIter(z);
3062    }
3063    else
3064    {
3065      pNext(p) = n_z;
3066      n_z = p;
3067    }
3068    p = next;
3069  }
3070  pNext(z) = NULL;
3071  *zero = pNext(&sz);
3072  *non_zero = n_z;
3073}
3074/*3
3075* substitute the n-th variable by 1 in p
3076* destroy p
3077*/
3078static poly p_Subst1 (poly p,int n, const ring r)
3079{
3080  poly qq=NULL, result = NULL;
3081  poly zero=NULL, non_zero=NULL;
3082
3083  // reverse, so that add is likely to be linear
3084  p_SplitAndReversePoly(p, n, &non_zero, &zero,r);
3085
3086  while (non_zero != NULL)
3087  {
3088    assume(p_GetExp(non_zero, n,r) != 0);
3089    qq = non_zero;
3090    pIter(non_zero);
3091    qq->next = NULL;
3092    p_SetExp(qq,n,0,r);
3093    p_Setm(qq,r);
3094    result = p_Add_q(result,qq,r);
3095  }
3096  p = p_Add_q(result, zero,r);
3097  p_Test(p,r);
3098  return p;
3099}
3100
3101/*3
3102* substitute the n-th variable by number e in p
3103* destroy p
3104*/
3105static poly p_Subst2 (poly p,int n, number e, const ring r)
3106{
3107  assume( ! n_IsZero(e,r->cf) );
3108  poly qq,result = NULL;
3109  number nn, nm;
3110  poly zero, non_zero;
3111
3112  // reverse, so that add is likely to be linear
3113  p_SplitAndReversePoly(p, n, &non_zero, &zero,r);
3114
3115  while (non_zero != NULL)
3116  {
3117    assume(p_GetExp(non_zero, n, r) != 0);
3118    qq = non_zero;
3119    pIter(non_zero);
3120    qq->next = NULL;
3121    n_Power(e, p_GetExp(qq, n, r), &nn,r->cf);
3122    nm = n_Mult(nn, pGetCoeff(qq),r->cf);
3123#ifdef HAVE_RINGS
3124    if (n_IsZero(nm,r->cf))
3125    {
3126      p_LmFree(&qq,r);
3127      n_Delete(&nm,r->cf);
3128    }
3129    else
3130#endif
3131    {
3132      p_SetCoeff(qq, nm,r);
3133      p_SetExp(qq, n, 0,r);
3134      p_Setm(qq,r);
3135      result = p_Add_q(result,qq,r);
3136    }
3137    n_Delete(&nn,r->cf);
3138  }
3139  p = p_Add_q(result, zero,r);
3140  p_Test(p,r);
3141  return p;
3142}
3143
3144
3145/* delete monoms whose n-th exponent is different from zero */
3146static poly p_Subst0(poly p, int n, const ring r)
3147{
3148  spolyrec res;
3149  poly h = &res;
3150  pNext(h) = p;
3151
3152  while (pNext(h)!=NULL)
3153  {
3154    if (p_GetExp(pNext(h),n,r)!=0)
3155    {
3156      p_LmDelete(&pNext(h),r);
3157    }
3158    else
3159    {
3160      pIter(h);
3161    }
3162  }
3163  p_Test(pNext(&res),r);
3164  return pNext(&res);
3165}
3166
3167/*2
3168* substitute the n-th variable by e in p
3169* destroy p
3170*/
3171poly p_Subst(poly p, int n, poly e, const ring r)
3172{
3173  if (e == NULL) return p_Subst0(p, n,r);
3174
3175  if (p_IsConstant(e,r))
3176  {
3177    if (n_IsOne(pGetCoeff(e),r->cf)) return p_Subst1(p,n,r);
3178    else return p_Subst2(p, n, pGetCoeff(e),r);
3179  }
3180
3181#ifdef HAVE_PLURAL
3182  if (rIsPluralRing(r))
3183  {
3184    return nc_pSubst(p,n,e,r);
3185  }
3186#endif
3187
3188  int exponent,i;
3189  poly h, res, m;
3190  int *me,*ee;
3191  number nu,nu1;
3192
3193  me=(int *)omAlloc((rVar(r)+1)*sizeof(int));
3194  ee=(int *)omAlloc((rVar(r)+1)*sizeof(int));
3195  if (e!=NULL) p_GetExpV(e,ee,r);
3196  res=NULL;
3197  h=p;
3198  while (h!=NULL)
3199  {
3200    if ((e!=NULL) || (p_GetExp(h,n,r)==0))
3201    {
3202      m=p_Head(h,r);
3203      p_GetExpV(m,me,r);
3204      exponent=me[n];
3205      me[n]=0;
3206      for(i=rVar(r);i>0;i--)
3207        me[i]+=exponent*ee[i];
3208      p_SetExpV(m,me,r);
3209      if (e!=NULL)
3210      {
3211        n_Power(pGetCoeff(e),exponent,&nu,r->cf);
3212        nu1=n_Mult(pGetCoeff(m),nu,r->cf);
3213        n_Delete(&nu,r->cf);
3214        p_SetCoeff(m,nu1,r);
3215      }
3216      res=p_Add_q(res,m,r);
3217    }
3218    p_LmDelete(&h,r);
3219  }
3220  omFreeSize((ADDRESS)me,(rVar(r)+1)*sizeof(int));
3221  omFreeSize((ADDRESS)ee,(rVar(r)+1)*sizeof(int));
3222  return res;
3223}
3224/*2
3225*returns a re-ordered copy of a polynomial, with permutation of the variables
3226*/
3227poly p_PermPoly (poly p, int * perm, const ring oldRing, const ring dst,
3228       nMapFunc nMap, int *par_perm, int OldPar)
3229{
3230  int OldpVariables = oldRing->N;
3231  poly result = NULL;
3232  poly result_last = NULL;
3233  poly aq=NULL; /* the map coefficient */
3234  poly qq; /* the mapped monomial */
3235
3236  while (p != NULL)
3237  {
3238    if ((OldPar==0)||(rField_is_GF(oldRing)))
3239    {
3240      qq = p_Init(dst);
3241      number n=nMap(pGetCoeff(p),oldRing->cf,dst->cf);
3242      if ((dst->cf->minpoly!=NULL)
3243      && ((rField_is_Zp_a(dst)) || (rField_is_Q_a(dst))))
3244      {
3245        n_Normalize(n,dst->cf);
3246      }
3247      pGetCoeff(qq)=n;
3248    // coef may be zero:  pTest(qq);
3249    }
3250    else
3251    {
3252      qq=p_One(dst);
3253      WerrorS("longalg missing");
3254      #if 0
3255      aq=naPermNumber(pGetCoeff(p),par_perm,OldPar, oldRing);
3256      if ((dst->cf->minpoly!=NULL)
3257      && ((rField_is_Zp_a(dst)) || (rField_is_Q_a(dst))))
3258      {
3259        poly tmp=aq;
3260        while (tmp!=NULL)
3261        {
3262          number n=pGetCoeff(tmp);
3263          n_Normalize(n,dst->cf);
3264          pGetCoeff(tmp)=n;
3265          pIter(tmp);
3266        }
3267      }
3268      p_Test(aq,dst);
3269      #endif
3270    }
3271    if (rRing_has_Comp(dst)) p_SetComp(qq, p_GetComp(p,oldRing),dst);
3272    if (n_IsZero(pGetCoeff(qq),dst->cf))
3273    {
3274      p_LmDelete(&qq,dst);
3275    }
3276    else
3277    {
3278      int i;
3279      int mapped_to_par=0;
3280      for(i=1; i<=OldpVariables; i++)
3281      {
3282        int e=p_GetExp(p,i,oldRing);
3283        if (e!=0)
3284        {
3285          if (perm==NULL)
3286          {
3287            p_SetExp(qq,i, e, dst);
3288          }
3289          else if (perm[i]>0)
3290            p_AddExp(qq,perm[i], e/*p_GetExp( p,i,oldRing)*/, dst);
3291          else if (perm[i]<0)
3292          {
3293            if (rField_is_GF(dst))
3294            {
3295              number c=pGetCoeff(qq);
3296              number ee=n_Par(1,dst->cf);
3297              number eee;n_Power(ee,e,&eee,dst->cf); //nfDelete(ee,dst);
3298              ee=n_Mult(c,eee,dst->cf);
3299              //nfDelete(c,dst);nfDelete(eee,dst);
3300              pSetCoeff0(qq,ee);
3301            }
3302            else
3303            {
3304              WerrorS("longalg missing");
3305              #if 0
3306              lnumber c=(lnumber)pGetCoeff(qq);
3307              if (c->z->next==NULL)
3308                p_AddExp(c->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/,dst->algring);
3309              else /* more difficult: we have really to multiply: */
3310              {
3311                lnumber mmc=(lnumber)naInit(1,dst);
3312                p_SetExp(mmc->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/,dst->algring);
3313                p_Setm(mmc->z,dst->algring->cf);
3314                pGetCoeff(qq)=n_Mult((number)c,(number)mmc,dst->cf);
3315                n_Delete((number *)&c,dst->cf);
3316                n_Delete((number *)&mmc,dst->cf);
3317              }
3318              mapped_to_par=1;
3319              #endif
3320            }
3321          }
3322          else
3323          {
3324            /* this variable maps to 0 !*/
3325            p_LmDelete(&qq,dst);
3326            break;
3327          }
3328        }
3329      }
3330      if (mapped_to_par
3331      && (dst->cf->minpoly!=NULL))
3332      {
3333        number n=pGetCoeff(qq);
3334        n_Normalize(n,dst->cf);
3335        pGetCoeff(qq)=n;
3336      }
3337    }
3338    pIter(p);
3339#if 1
3340    if (qq!=NULL)
3341    {
3342      p_Setm(qq,dst);
3343      p_Test(aq,dst);
3344      p_Test(qq,dst);
3345      if (aq!=NULL) qq=p_Mult_q(aq,qq,dst);
3346      aq = qq;
3347      while (pNext(aq) != NULL) pIter(aq);
3348      if (result_last==NULL)
3349      {
3350        result=qq;
3351      }
3352      else
3353      {
3354        pNext(result_last)=qq;
3355      }
3356      result_last=aq;
3357      aq = NULL;
3358    }
3359    else if (aq!=NULL)
3360    {
3361      p_Delete(&aq,dst);
3362    }
3363  }
3364  result=p_SortAdd(result,dst);
3365#else
3366  //  if (qq!=NULL)
3367  //  {
3368  //    pSetm(qq);
3369  //    pTest(qq);
3370  //    pTest(aq);
3371  //    if (aq!=NULL) qq=pMult(aq,qq);
3372  //    aq = qq;
3373  //    while (pNext(aq) != NULL) pIter(aq);
3374  //    pNext(aq) = result;
3375  //    aq = NULL;
3376  //    result = qq;
3377  //  }
3378  //  else if (aq!=NULL)
3379  //  {
3380  //    pDelete(&aq);
3381  //  }
3382  //}
3383  //p = result;
3384  //result = NULL;
3385  //while (p != NULL)
3386  //{
3387  //  qq = p;
3388  //  pIter(p);
3389  //  qq->next = NULL;
3390  //  result = pAdd(result, qq);
3391  //}
3392#endif
3393  p_Test(result,dst);
3394  return result;
3395}
3396/**************************************************************
3397 *
3398 * Jet
3399 *
3400 **************************************************************/
3401
3402poly pp_Jet(poly p, int m, const ring R)
3403{
3404  poly r=NULL;
3405  poly t=NULL;
3406
3407  while (p!=NULL)
3408  {
3409    if (p_Totaldegree(p,R)<=m)
3410    {
3411      if (r==NULL)
3412        r=p_Head(p,R);
3413      else
3414      if (t==NULL)
3415      {
3416        pNext(r)=p_Head(p,R);
3417        t=pNext(r);
3418      }
3419      else
3420      {
3421        pNext(t)=p_Head(p,R);
3422        pIter(t);
3423      }
3424    }
3425    pIter(p);
3426  }
3427  return r;
3428}
3429
3430poly p_Jet(poly p, int m,const ring R)
3431{
3432  poly t=NULL;
3433
3434  while((p!=NULL) && (p_Totaldegree(p,R)>m)) p_LmDelete(&p,R);
3435  if (p==NULL) return NULL;
3436  poly r=p;
3437  while (pNext(p)!=NULL)
3438  {
3439    if (p_Totaldegree(pNext(p),R)>m)
3440    {
3441      p_LmDelete(&pNext(p),R);
3442    }
3443    else
3444      pIter(p);
3445  }
3446  return r;
3447}
3448
3449poly pp_JetW(poly p, int m, short *w, const ring R)
3450{
3451  poly r=NULL;
3452  poly t=NULL;
3453  while (p!=NULL)
3454  {
3455    if (totaldegreeWecart_IV(p,R,w)<=m)
3456    {
3457      if (r==NULL)
3458        r=p_Head(p,R);
3459      else
3460      if (t==NULL)
3461      {
3462        pNext(r)=p_Head(p,R);
3463        t=pNext(r);
3464      }
3465      else
3466      {
3467        pNext(t)=p_Head(p,R);
3468        pIter(t);
3469      }
3470    }
3471    pIter(p);
3472  }
3473  return r;
3474}
3475
3476poly p_JetW(poly p, int m, short *w, const ring R)
3477{
3478  poly t=NULL;
3479  while((p!=NULL) && (totaldegreeWecart_IV(p,R,w)>m)) p_LmDelete(&p,R);
3480  if (p==NULL) return NULL;
3481  poly r=p;
3482  while (pNext(p)!=NULL)
3483  {
3484    if (totaldegreeWecart_IV(pNext(p),R,w)>m)
3485    {
3486      p_LmDelete(&pNext(p),R);
3487    }
3488    else
3489      pIter(p);
3490  }
3491  return r;
3492}
3493
3494/*************************************************************/
3495int p_MinDeg(poly p,intvec *w, const ring R)
3496{
3497  if(p==NULL)
3498    return -1;
3499  int d=-1;
3500  while(p!=NULL)
3501  {
3502    int d0=0;
3503    for(int j=0;j<rVar(R);j++)
3504      if(w==NULL||j>=w->length())
3505        d0+=p_GetExp(p,j+1,R);
3506      else
3507        d0+=(*w)[j]*p_GetExp(p,j+1,R);
3508    if(d0<d||d==-1)
3509      d=d0;
3510    pIter(p);
3511  }
3512  return d;
3513}
3514
3515/***************************************************************/
3516
3517poly p_Series(int n,poly p,poly u, intvec *w, const ring R)
3518{
3519  short *ww=iv2array(w,R);
3520  if(p!=NULL)
3521  {
3522    if(u==NULL)
3523      p=p_JetW(p,n,ww,R);
3524    else
3525      p=p_JetW(p_Mult_q(p,p_Invers(n-p_MinDeg(p,w,R),u,w,R),R),n,ww,R);
3526  }
3527  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
3528  return p;
3529}
3530
3531poly p_Invers(int n,poly u,intvec *w, const ring R)
3532{
3533  if(n<0)
3534    return NULL;
3535  number u0=n_Invers(pGetCoeff(u),R->cf);
3536  poly v=p_NSet(u0,R);
3537  if(n==0)
3538    return v;
3539  short *ww=iv2array(w,R);
3540  poly u1=p_JetW(p_Sub(p_One(R),p_Mult_nn(u,u0,R),R),n,ww,R);
3541  if(u1==NULL)
3542  {
3543    omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
3544    return v;
3545  }
3546  poly v1=p_Mult_nn(p_Copy(u1,R),u0,R);
3547  v=p_Add_q(v,p_Copy(v1,R),R);
3548  for(int i=n/p_MinDeg(u1,w,R);i>1;i--)
3549  {
3550    v1=p_JetW(p_Mult_q(v1,p_Copy(u1,R),R),n,ww,R);
3551    v=p_Add_q(v,p_Copy(v1,R),R);
3552  }
3553  p_Delete(&u1,R);
3554  p_Delete(&v1,R);
3555  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
3556  return v;
3557}
3558
3559BOOLEAN p_EqualPolys(poly p1,poly p2, const ring r)
3560{
3561  while ((p1 != NULL) && (p2 != NULL))
3562  {
3563    if (! p_LmEqual(p1, p2,r))
3564      return FALSE;
3565    if (! n_Equal(p_GetCoeff(p1,r), p_GetCoeff(p2,r),r ))
3566      return FALSE;
3567    pIter(p1);
3568    pIter(p2);
3569  }
3570  return (p1==p2);
3571}
3572
3573/*2
3574*returns TRUE if p1 is a skalar multiple of p2
3575*assume p1 != NULL and p2 != NULL
3576*/
3577BOOLEAN p_ComparePolys(poly p1,poly p2, const ring r)
3578{
3579  number n,nn;
3580  int i;
3581  pAssume(p1 != NULL && p2 != NULL);
3582
3583  if (!p_LmEqual(p1,p2,r)) //compare leading mons
3584      return FALSE;
3585  if ((pNext(p1)==NULL) && (pNext(p2)!=NULL))
3586     return FALSE;
3587  if ((pNext(p2)==NULL) && (pNext(p1)!=NULL))
3588     return FALSE;
3589  if (pLength(p1) != pLength(p2))
3590    return FALSE;
3591#ifdef HAVE_RINGS
3592  if (rField_is_Ring(r))
3593  {
3594    if (!n_DivBy(p_GetCoeff(p1, r), p_GetCoeff(p2, r), r)) return FALSE;
3595  }
3596#endif
3597  n=n_Div(p_GetCoeff(p1,r),p_GetCoeff(p2,r),r);
3598  while ((p1 != NULL) /*&& (p2 != NULL)*/)
3599  {
3600    if ( ! p_LmEqual(p1, p2,r))
3601    {
3602        n_Delete(&n, r);
3603        return FALSE;
3604    }
3605    if (!n_Equal(p_GetCoeff(p1, r), nn = n_Mult(p_GetCoeff(p2, r),n, r), r))
3606    {
3607      n_Delete(&n, r);
3608      n_Delete(&nn, r);
3609      return FALSE;
3610    }
3611    n_Delete(&nn, r);
3612    pIter(p1);
3613    pIter(p2);
3614  }
3615  n_Delete(&n, r);
3616  return TRUE;
3617}
3618
3619
3620/***************************************************************
3621 *
3622 * p_ShallowDelete
3623 *
3624 ***************************************************************/
3625#undef LINKAGE
3626#define LINKAGE
3627#undef p_Delete__T
3628#define p_Delete__T p_ShallowDelete
3629#undef n_Delete__T
3630#define n_Delete__T(n, r) ((void)0)
3631
3632#include <polys/templates/p_Delete__T.cc>
3633
3634#ifdef HAVE_RINGS
3635/* TRUE iff LT(f) | LT(g) */
3636BOOLEAN p_DivisibleByRingCase(poly f, poly g, const ring r)
3637{
3638  int exponent;
3639  for(int i = (int)r->N; i; i--)
3640  {
3641    exponent = p_GetExp(g, i, r) - p_GetExp(f, i, r);
3642    if (exponent < 0) return FALSE;
3643  }
3644  return n_DivBy(p_GetCoeff(g,r), p_GetCoeff(f,r),r->cf);
3645}
3646#endif
Note: See TracBrowser for help on using the repository browser.