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

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