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

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