source: git/libpolys/polys/monomials/p_polys.cc @ 4a2260e

spielwiese
Last change on this file since 4a2260e was 4a2260e, checked in by Frank Seelisch <seelisch@…>, 13 years ago
more tests run (alg ext fields); some omCheck problems in longrat.cc yet to be resolved
  • Property mode set to 100644
File size: 79.9 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");
1465//p_Write(t, r);
1466    if (needResult) result = p_Add_q(result, p_Copy(t, r), r);
1467    p = p_Add_q(p, p_Neg(p_Mult_q(t, p_Copy(divisor, r), r), r), r);
1468//printf("p\n");
1469//p_Write(p, r);
1470  }
1471  return result;
1472}
1473
1474/* returns NULL if p == NULL, otherwise makes p monic by dividing
1475   by its leading coefficient (only done if this is not already 1);
1476   this assumes that we are over a ground field so that division
1477   is well-defined;
1478   modifies p */
1479void p_Monic(poly &p, ring r)
1480{
1481  if (p == NULL) return;
1482  poly pp = p;
1483  number lc = p_GetCoeff(p, r);
1484  if (n_IsOne(lc, r->cf)) return;
1485  number n = n_Init(1, r->cf);
1486  p_SetCoeff(p, n, r);
1487  p = pIter(p);
1488  while (p != NULL)
1489  {
1490    number c = p_GetCoeff(p, r);
1491    number n = n_Div(c, lc, r->cf);
1492    n_Delete(&c, r->cf);
1493    p_SetCoeff(p, n, r);
1494    p = pIter(p);
1495  }
1496  n_Delete(&lc, r->cf);
1497  p = pp;
1498}
1499
1500/* see p_Gcd;
1501   additional assumption: deg(p) >= deg(q);
1502   must destroy p and q (unless one of them is returned) */
1503poly p_GcdHelper(poly &p, poly &q, ring r)
1504{
1505  if (q == NULL)
1506  {
1507    /* We have to make p monic before we return it, so that if the
1508       gcd is a unit in the ground field, we will actually return 1. */
1509    p_Monic(p, r);
1510    return p;
1511  }
1512  else
1513  {
1514    p_PolyDiv(p, q, FALSE, r);
1515    return p_GcdHelper(q, p, r);
1516  }
1517}
1518
1519/* assumes that p and q are univariate polynomials in r,
1520   mentioning the same variable;
1521   assumes a global monomial ordering in r;
1522   assumes that not both p and q are NULL;
1523   returns the gcd of p and q;
1524   leaves p and q unmodified */
1525poly p_Gcd(poly p, poly q, ring r)
1526{
1527  assume((p != NULL) || (q != NULL));
1528 
1529  poly a = p; poly b = q;
1530  if (p_Deg(a, r) < p_Deg(b, r)) { a = q; b = p; }
1531  a = p_Copy(a, r); b = p_Copy(b, r);
1532  return p_GcdHelper(a, b, r);
1533}
1534
1535/* see p_ExtGcd;
1536   additional assumption: deg(p) >= deg(q);
1537   must destroy p and q (unless one of them is returned) */
1538poly p_ExtGcdHelper(poly &p, poly &pFactor, poly &q, poly &qFactor,
1539                    ring r)
1540{
1541  if (q == NULL)
1542  {
1543    qFactor = NULL;
1544    pFactor = p_ISet(1, r);
1545    number n = p_GetCoeff(pFactor, r);
1546//printf("p_ExtGcdHelper0:\n");
1547//p_Write(p, r);
1548    p_SetCoeff(pFactor, n_Invers(p_GetCoeff(p, r), r->cf), r);
1549    n_Delete(&n, r->cf);
1550    p_Monic(p, r);
1551    return p;
1552  }
1553  else
1554  {
1555//printf("p_ExtGcdHelper1:\n");
1556//p_Write(p, r); p_Write(q, r);
1557    poly pDivQ = p_PolyDiv(p, q, TRUE, r);
1558    poly ppFactor = NULL; poly qqFactor = NULL;
1559//printf("p_ExtGcdHelper2:\n");
1560//p_Write(p, r); p_Write(ppFactor, r);
1561//p_Write(q, r); p_Write(qqFactor, r);
1562    poly theGcd = p_ExtGcdHelper(q, qqFactor, p, ppFactor, r);
1563//printf("p_ExtGcdHelper3:\n");
1564//p_Write(q, r); p_Write(qqFactor, r);
1565//p_Write(p, r); p_Write(ppFactor, r);
1566//p_Write(theGcd, r);
1567    pFactor = ppFactor;
1568    qFactor = p_Add_q(qqFactor,
1569                      p_Neg(p_Mult_q(pDivQ, p_Copy(ppFactor, r), r), r),
1570                      r);
1571//printf("p_ExtGcdHelper4:\n");
1572//p_Write(pFactor, r); p_Write(qFactor, r);
1573    return theGcd;
1574  }
1575}
1576
1577/* assumes that p and q are univariate polynomials in r,
1578   mentioning the same variable;
1579   assumes a global monomial ordering in r;
1580   assumes that not both p and q are NULL;
1581   returns the gcd of p and q;
1582   moreover, afterwards pFactor and qFactor contain appropriate
1583   factors such that gcd(p, q) = p * pFactor + q * qFactor;
1584   leaves p and q unmodified */
1585poly p_ExtGcd(poly p, poly &pFactor, poly q, poly &qFactor, ring r)
1586{
1587//printf("p_ExtGcd1:\n");
1588//p_Write(p, r); p_Write(q, r);
1589  assume((p != NULL) || (q != NULL)); 
1590  poly a = p; poly b = q; BOOLEAN aCorrespondsToP = TRUE;
1591  if (p_Deg(a, r) < p_Deg(b, r))
1592  { a = q; b = p; aCorrespondsToP = FALSE; }
1593  a = p_Copy(a, r); b = p_Copy(b, r);
1594  poly aFactor = NULL; poly bFactor = NULL;
1595  poly theGcd = p_ExtGcdHelper(a, aFactor, b, bFactor, r);
1596  if (aCorrespondsToP) { pFactor = aFactor; qFactor = bFactor; }
1597  else                 { pFactor = bFactor; qFactor = aFactor; }
1598  return theGcd;
1599}
1600
1601/*2
1602* returns the partial differentiate of a by the k-th variable
1603* does not destroy the input
1604*/
1605poly p_Diff(poly a, int k, const ring r)
1606{
1607  poly res, f, last;
1608  number t;
1609
1610  last = res = NULL;
1611  while (a!=NULL)
1612  {
1613    if (p_GetExp(a,k,r)!=0)
1614    {
1615      f = p_LmInit(a,r);
1616      t = n_Init(p_GetExp(a,k,r),r->cf);
1617      pSetCoeff0(f,n_Mult(t,pGetCoeff(a),r->cf));
1618      n_Delete(&t,r->cf);
1619      if (n_IsZero(pGetCoeff(f),r->cf))
1620        p_LmDelete(&f,r);
1621      else
1622      {
1623        p_DecrExp(f,k,r);
1624        p_Setm(f,r);
1625        if (res==NULL)
1626        {
1627          res=last=f;
1628        }
1629        else
1630        {
1631          pNext(last)=f;
1632          last=f;
1633        }
1634      }
1635    }
1636    pIter(a);
1637  }
1638  return res;
1639}
1640
1641static poly p_DiffOpM(poly a, poly b,BOOLEAN multiply, const ring r)
1642{
1643  int i,j,s;
1644  number n,h,hh;
1645  poly p=p_One(r);
1646  n=n_Mult(pGetCoeff(a),pGetCoeff(b),r->cf);
1647  for(i=rVar(r);i>0;i--)
1648  {
1649    s=p_GetExp(b,i,r);
1650    if (s<p_GetExp(a,i,r))
1651    {
1652      n_Delete(&n,r->cf);
1653      p_LmDelete(&p,r);
1654      return NULL;
1655    }
1656    if (multiply)
1657    {
1658      for(j=p_GetExp(a,i,r); j>0;j--)
1659      {
1660        h = n_Init(s,r->cf);
1661        hh=n_Mult(n,h,r->cf);
1662        n_Delete(&h,r->cf);
1663        n_Delete(&n,r->cf);
1664        n=hh;
1665        s--;
1666      }
1667      p_SetExp(p,i,s,r);
1668    }
1669    else
1670    {
1671      p_SetExp(p,i,s-p_GetExp(a,i,r),r);
1672    }
1673  }
1674  p_Setm(p,r);
1675  /*if (multiply)*/ p_SetCoeff(p,n,r);
1676  if (n_IsZero(n,r->cf))  p=p_LmDeleteAndNext(p,r); // return NULL as p is a monomial
1677  return p;
1678}
1679
1680poly p_DiffOp(poly a, poly b,BOOLEAN multiply, const ring r)
1681{
1682  poly result=NULL;
1683  poly h;
1684  for(;a!=NULL;pIter(a))
1685  {
1686    for(h=b;h!=NULL;pIter(h))
1687    {
1688      result=p_Add_q(result,p_DiffOpM(a,h,multiply,r),r);
1689    }
1690  }
1691  return result;
1692}
1693/*2
1694* subtract p2 from p1, p1 and p2 are destroyed
1695* do not put attention on speed: the procedure is only used in the interpreter
1696*/
1697poly p_Sub(poly p1, poly p2, const ring r)
1698{
1699  return p_Add_q(p1, p_Neg(p2,r),r);
1700}
1701
1702/*3
1703* compute for a monomial m
1704* the power m^exp, exp > 1
1705* destroys p
1706*/
1707static poly p_MonPower(poly p, int exp, const ring r)
1708{
1709  int i;
1710
1711  if(!n_IsOne(pGetCoeff(p),r->cf))
1712  {
1713    number x, y;
1714    y = pGetCoeff(p);
1715    n_Power(y,exp,&x,r->cf);
1716    n_Delete(&y,r->cf);
1717    pSetCoeff0(p,x);
1718  }
1719  for (i=rVar(r); i!=0; i--)
1720  {
1721    p_MultExp(p,i, exp,r);
1722  }
1723  p_Setm(p,r);
1724  return p;
1725}
1726
1727/*3
1728* compute for monomials p*q
1729* destroys p, keeps q
1730*/
1731static void p_MonMult(poly p, poly q, const ring r)
1732{
1733  number x, y;
1734
1735  y = pGetCoeff(p);
1736  x = n_Mult(y,pGetCoeff(q),r->cf);
1737  n_Delete(&y,r->cf);
1738  pSetCoeff0(p,x);
1739  //for (int i=pVariables; i!=0; i--)
1740  //{
1741  //  pAddExp(p,i, pGetExp(q,i));
1742  //}
1743  //p->Order += q->Order;
1744  p_ExpVectorAdd(p,q,r);
1745}
1746
1747/*3
1748* compute for monomials p*q
1749* keeps p, q
1750*/
1751static poly p_MonMultC(poly p, poly q, const ring rr)
1752{
1753  number x;
1754  poly r = p_Init(rr);
1755
1756  x = n_Mult(pGetCoeff(p),pGetCoeff(q),rr->cf);
1757  pSetCoeff0(r,x);
1758  p_ExpVectorSum(r,p, q, rr);
1759  return r;
1760}
1761
1762/*3
1763*  create binomial coef.
1764*/
1765static number* pnBin(int exp, const ring r)
1766{
1767  int e, i, h;
1768  number x, y, *bin=NULL;
1769
1770  x = n_Init(exp,r->cf);
1771  if (n_IsZero(x,r->cf))
1772  {
1773    n_Delete(&x,r->cf);
1774    return bin;
1775  }
1776  h = (exp >> 1) + 1;
1777  bin = (number *)omAlloc0(h*sizeof(number));
1778  bin[1] = x;
1779  if (exp < 4)
1780    return bin;
1781  i = exp - 1;
1782  for (e=2; e<h; e++)
1783  {
1784      x = n_Init(i,r->cf);
1785      i--;
1786      y = n_Mult(x,bin[e-1],r->cf);
1787      n_Delete(&x,r->cf);
1788      x = n_Init(e,r->cf);
1789      bin[e] = n_IntDiv(y,x,r->cf);
1790      n_Delete(&x,r->cf);
1791      n_Delete(&y,r->cf);
1792  }
1793  return bin;
1794}
1795
1796static void pnFreeBin(number *bin, int exp,const coeffs r)
1797{
1798  int e, h = (exp >> 1) + 1;
1799
1800  if (bin[1] != NULL)
1801  {
1802    for (e=1; e<h; e++)
1803      n_Delete(&(bin[e]),r);
1804  }
1805  omFreeSize((ADDRESS)bin, h*sizeof(number));
1806}
1807
1808/*
1809*  compute for a poly p = head+tail, tail is monomial
1810*          (head + tail)^exp, exp > 1
1811*          with binomial coef.
1812*/
1813static poly p_TwoMonPower(poly p, int exp, const ring r)
1814{
1815  int eh, e;
1816  long al;
1817  poly *a;
1818  poly tail, b, res, h;
1819  number x;
1820  number *bin = pnBin(exp,r);
1821
1822  tail = pNext(p);
1823  if (bin == NULL)
1824  {
1825    p_MonPower(p,exp,r);
1826    p_MonPower(tail,exp,r);
1827#ifdef PDEBUG
1828    p_Test(p,r);
1829#endif
1830    return p;
1831  }
1832  eh = exp >> 1;
1833  al = (exp + 1) * sizeof(poly);
1834  a = (poly *)omAlloc(al);
1835  a[1] = p;
1836  for (e=1; e<exp; e++)
1837  {
1838    a[e+1] = p_MonMultC(a[e],p,r);
1839  }
1840  res = a[exp];
1841  b = p_Head(tail,r);
1842  for (e=exp-1; e>eh; e--)
1843  {
1844    h = a[e];
1845    x = n_Mult(bin[exp-e],pGetCoeff(h),r->cf);
1846    p_SetCoeff(h,x,r);
1847    p_MonMult(h,b,r);
1848    res = pNext(res) = h;
1849    p_MonMult(b,tail,r);
1850  }
1851  for (e=eh; e!=0; e--)
1852  {
1853    h = a[e];
1854    x = n_Mult(bin[e],pGetCoeff(h),r->cf);
1855    p_SetCoeff(h,x,r);
1856    p_MonMult(h,b,r);
1857    res = pNext(res) = h;
1858    p_MonMult(b,tail,r);
1859  }
1860  p_LmDelete(&tail,r);
1861  pNext(res) = b;
1862  pNext(b) = NULL;
1863  res = a[exp];
1864  omFreeSize((ADDRESS)a, al);
1865  pnFreeBin(bin, exp, r->cf);
1866//  tail=res;
1867// while((tail!=NULL)&&(pNext(tail)!=NULL))
1868// {
1869//   if(nIsZero(pGetCoeff(pNext(tail))))
1870//   {
1871//     pLmDelete(&pNext(tail));
1872//   }
1873//   else
1874//     pIter(tail);
1875// }
1876#ifdef PDEBUG
1877  p_Test(res,r);
1878#endif
1879  return res;
1880}
1881
1882static poly p_Pow(poly p, int i, const ring r)
1883{
1884  poly rc = p_Copy(p,r);
1885  i -= 2;
1886  do
1887  {
1888    rc = p_Mult_q(rc,p_Copy(p,r),r);
1889    p_Normalize(rc,r);
1890    i--;
1891  }
1892  while (i != 0);
1893  return p_Mult_q(rc,p,r);
1894}
1895
1896/*2
1897* returns the i-th power of p
1898* p will be destroyed
1899*/
1900poly p_Power(poly p, int i, const ring r)
1901{
1902  poly rc=NULL;
1903
1904  if (i==0)
1905  {
1906    p_Delete(&p,r);
1907    return p_One(r);
1908  }
1909
1910  if(p!=NULL)
1911  {
1912    if ( (i > 0) && ((unsigned long ) i > (r->bitmask)))
1913    {
1914      Werror("exponent %d is too large, max. is %ld",i,r->bitmask);
1915      return NULL;
1916    }
1917    switch (i)
1918    {
1919// cannot happen, see above
1920//      case 0:
1921//      {
1922//        rc=pOne();
1923//        pDelete(&p);
1924//        break;
1925//      }
1926      case 1:
1927        rc=p;
1928        break;
1929      case 2:
1930        rc=p_Mult_q(p_Copy(p,r),p,r);
1931        break;
1932      default:
1933        if (i < 0)
1934        {
1935          p_Delete(&p,r);
1936          return NULL;
1937        }
1938        else
1939        {
1940#ifdef HAVE_PLURAL
1941          if (rIsPluralRing(r)) /* in the NC case nothing helps :-( */
1942          {
1943            int j=i;
1944            rc = p_Copy(p,r);
1945            while (j>1)
1946            {
1947              rc = p_Mult_q(p_Copy(p,r),rc,r);
1948              j--;
1949            }
1950            p_Delete(&p,r);
1951            return rc;
1952          }
1953#endif
1954          rc = pNext(p);
1955          if (rc == NULL)
1956            return p_MonPower(p,i,r);
1957          /* else: binom ?*/
1958          int char_p=rChar(r);
1959          if ((pNext(rc) != NULL)
1960#ifdef HAVE_RINGS
1961             || rField_is_Ring(r)
1962#endif
1963             )
1964            return p_Pow(p,i,r);
1965          if ((char_p==0) || (i<=char_p))
1966            return p_TwoMonPower(p,i,r);
1967          poly p_p=p_TwoMonPower(p_Copy(p,r),char_p,r);
1968          return p_Mult_q(p_Power(p,i-char_p,r),p_p,r);
1969        }
1970      /*end default:*/
1971    }
1972  }
1973  return rc;
1974}
1975
1976/* --------------------------------------------------------------------------------*/
1977/* content suff                                                                   */
1978
1979static number p_InitContent(poly ph, const ring r);
1980static number p_InitContent_a(poly ph, const ring r);
1981
1982void p_Content(poly ph, const ring r)
1983{
1984#ifdef HAVE_RINGS
1985  if (rField_is_Ring(r))
1986  {
1987    if ((ph!=NULL) && rField_has_Units(r))
1988    {
1989      number k = n_GetUnit(pGetCoeff(ph),r->cf);
1990      if (!n_IsOne(k,r->cf))
1991      {
1992        number tmpGMP = k;
1993        k = n_Invers(k,r->cf);
1994        n_Delete(&tmpGMP,r->cf);
1995        poly h = pNext(ph);
1996        p_SetCoeff(ph, n_Mult(pGetCoeff(ph), k,r->cf),r);
1997        while (h != NULL)
1998        {
1999          p_SetCoeff(h, n_Mult(pGetCoeff(h), k,r->cf),r);
2000          pIter(h);
2001        }
2002      }
2003      n_Delete(&k,r->cf);
2004    }
2005    return;
2006  }
2007#endif
2008  number h,d;
2009  poly p;
2010
2011  if(TEST_OPT_CONTENTSB) return;
2012  if(pNext(ph)==NULL)
2013  {
2014    p_SetCoeff(ph,n_Init(1,r->cf),r);
2015  }
2016  else
2017  {
2018    n_Normalize(pGetCoeff(ph),r->cf);
2019    if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2020    if (rField_is_Q(r))
2021    {
2022      h=p_InitContent(ph,r);
2023      p=ph;
2024    }
2025    else if (rField_is_Extension(r)
2026             &&
2027             (
2028              (rPar(r)>1) || rMinpolyIsNULL(r)
2029             )
2030            )
2031    {
2032      h=p_InitContent_a(ph,r);
2033      p=ph;
2034    }
2035    else
2036    {
2037      h=n_Copy(pGetCoeff(ph),r->cf);
2038      p = pNext(ph);
2039    }
2040    while (p!=NULL)
2041    {
2042      n_Normalize(pGetCoeff(p),r->cf);
2043      d=n_Gcd(h,pGetCoeff(p),r->cf);
2044      n_Delete(&h,r->cf);
2045      h = d;
2046      if(n_IsOne(h,r->cf))
2047      {
2048        break;
2049      }
2050      pIter(p);
2051    }
2052    p = ph;
2053    //number tmp;
2054    if(!n_IsOne(h,r->cf))
2055    {
2056      while (p!=NULL)
2057      {
2058        //d = nDiv(pGetCoeff(p),h);
2059        //tmp = nIntDiv(pGetCoeff(p),h);
2060        //if (!nEqual(d,tmp))
2061        //{
2062        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
2063        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
2064        //  nWrite(tmp);Print(StringAppendS("\n"));
2065        //}
2066        //nDelete(&tmp);
2067        d = n_IntDiv(pGetCoeff(p),h,r->cf);
2068        p_SetCoeff(p,d,r);
2069        pIter(p);
2070      }
2071    }
2072    n_Delete(&h,r->cf);
2073#ifdef HAVE_FACTORY
2074    if ( (n_GetChar(r) == 1) || (n_GetChar(r) < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
2075    {
2076      singclap_divide_content(ph, r);
2077      if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2078    }
2079#endif
2080    if (rField_is_Q_a(r))
2081    {
2082      //number hzz = nlInit(1, r->cf);
2083      h = nlInit(1, r->cf);
2084      p=ph;
2085      Werror("longalg missing");
2086      #if 0
2087      while (p!=NULL)
2088      { // each monom: coeff in Q_a
2089        lnumber c_n_n=(lnumber)pGetCoeff(p);
2090        poly c_n=c_n_n->z;
2091        while (c_n!=NULL)
2092        { // each monom: coeff in Q
2093          d=nlLcm(hzz,pGetCoeff(c_n),r->algring->cf);
2094          n_Delete(&hzz,r->algring->cf);
2095          hzz=d;
2096          pIter(c_n);
2097        }
2098        c_n=c_n_n->n;
2099        while (c_n!=NULL)
2100        { // each monom: coeff in Q
2101          d=nlLcm(h,pGetCoeff(c_n),r->algring->cf);
2102          n_Delete(&h,r->algring->cf);
2103          h=d;
2104          pIter(c_n);
2105        }
2106        pIter(p);
2107      }
2108      /* hzz contains the 1/lcm of all denominators in c_n_n->z*/
2109      /* h contains the 1/lcm of all denominators in c_n_n->n*/
2110      number htmp=nlInvers(h,r->algring->cf);
2111      number hzztmp=nlInvers(hzz,r->algring->cf);
2112      number hh=nlMult(hzz,h,r->algring->cf);
2113      nlDelete(&hzz,r->algring->cf);
2114      nlDelete(&h,r->algring->cf);
2115      number hg=nlGcd(hzztmp,htmp,r->algring->cf);
2116      nlDelete(&hzztmp,r->algring->cf);
2117      nlDelete(&htmp,r->algring->cf);
2118      h=nlMult(hh,hg,r->algring->cf);
2119      nlDelete(&hg,r->algring->cf);
2120      nlDelete(&hh,r->algring->cf);
2121      nlNormalize(h,r->algring->cf);
2122      if(!nlIsOne(h,r->algring->cf))
2123      {
2124        p=ph;
2125        while (p!=NULL)
2126        { // each monom: coeff in Q_a
2127          lnumber c_n_n=(lnumber)pGetCoeff(p);
2128          poly c_n=c_n_n->z;
2129          while (c_n!=NULL)
2130          { // each monom: coeff in Q
2131            d=nlMult(h,pGetCoeff(c_n),r->algring->cf);
2132            nlNormalize(d,r->algring->cf);
2133            nlDelete(&pGetCoeff(c_n),r->algring->cf);
2134            pGetCoeff(c_n)=d;
2135            pIter(c_n);
2136          }
2137          c_n=c_n_n->n;
2138          while (c_n!=NULL)
2139          { // each monom: coeff in Q
2140            d=nlMult(h,pGetCoeff(c_n),r->algring->cf);
2141            nlNormalize(d,r->algring->cf);
2142            nlDelete(&pGetCoeff(c_n),r->algring->cf);
2143            pGetCoeff(c_n)=d;
2144            pIter(c_n);
2145          }
2146          pIter(p);
2147        }
2148      }
2149      nlDelete(&h,r->algring->cf);
2150      #endif
2151    }
2152  }
2153}
2154#if 0 // currently not used
2155void p_SimpleContent(poly ph,int smax, const ring r)
2156{
2157  if(TEST_OPT_CONTENTSB) return;
2158  if (ph==NULL) return;
2159  if (pNext(ph)==NULL)
2160  {
2161    p_SetCoeff(ph,n_Init(1,r_cf),r);
2162    return;
2163  }
2164  if ((pNext(pNext(ph))==NULL)||(!rField_is_Q(r)))
2165  {
2166    return;
2167  }
2168  number d=p_InitContent(ph,r);
2169  if (nlSize(d,r->cf)<=smax)
2170  {
2171    //if (TEST_OPT_PROT) PrintS("G");
2172    return;
2173  }
2174  poly p=ph;
2175  number h=d;
2176  if (smax==1) smax=2;
2177  while (p!=NULL)
2178  {
2179#if 0
2180    d=nlGcd(h,pGetCoeff(p),r->cf);
2181    nlDelete(&h,r->cf);
2182    h = d;
2183#else
2184    nlInpGcd(h,pGetCoeff(p),r->cf);
2185#endif
2186    if(nlSize(h,r->cf)<smax)
2187    {
2188      //if (TEST_OPT_PROT) PrintS("g");
2189      return;
2190    }
2191    pIter(p);
2192  }
2193  p = ph;
2194  if (!nlGreaterZero(pGetCoeff(p),r->cf)) h=nlNeg(h,r->cf);
2195  if(nlIsOne(h,r->cf)) return;
2196  //if (TEST_OPT_PROT) PrintS("c");
2197  while (p!=NULL)
2198  {
2199#if 1
2200    d = nlIntDiv(pGetCoeff(p),h,r->cf);
2201    p_SetCoeff(p,d,r);
2202#else
2203    nlInpIntDiv(pGetCoeff(p),h,r->cf);
2204#endif
2205    pIter(p);
2206  }
2207  nlDelete(&h,r->cf);
2208}
2209#endif
2210
2211static number p_InitContent(poly ph, const ring r)
2212// only for coefficients in Q
2213#if 0
2214{
2215  assume(!TEST_OPT_CONTENTSB);
2216  assume(ph!=NULL);
2217  assume(pNext(ph)!=NULL);
2218  assume(rField_is_Q(r));
2219  if (pNext(pNext(ph))==NULL)
2220  {
2221    return nlGetNom(pGetCoeff(pNext(ph)),r->cf);
2222  }
2223  poly p=ph;
2224  number n1=nlGetNom(pGetCoeff(p),r->cf);
2225  pIter(p);
2226  number n2=nlGetNom(pGetCoeff(p),r->cf);
2227  pIter(p);
2228  number d;
2229  number t;
2230  loop
2231  {
2232    nlNormalize(pGetCoeff(p),r->cf);
2233    t=nlGetNom(pGetCoeff(p),r->cf);
2234    if (nlGreaterZero(t,r->cf))
2235      d=nlAdd(n1,t,r->cf);
2236    else
2237      d=nlSub(n1,t,r->cf);
2238    nlDelete(&t,r->cf);
2239    nlDelete(&n1,r->cf);
2240    n1=d;
2241    pIter(p);
2242    if (p==NULL) break;
2243    nlNormalize(pGetCoeff(p),r->cf);
2244    t=nlGetNom(pGetCoeff(p),r->cf);
2245    if (nlGreaterZero(t,r->cf))
2246      d=nlAdd(n2,t,r->cf);
2247    else
2248      d=nlSub(n2,t,r->cf);
2249    nlDelete(&t,r->cf);
2250    nlDelete(&n2,r->cf);
2251    n2=d;
2252    pIter(p);
2253    if (p==NULL) break;
2254  }
2255  d=nlGcd(n1,n2,r->cf);
2256  nlDelete(&n1,r->cf);
2257  nlDelete(&n2,r->cf);
2258  return d;
2259}
2260#else
2261{
2262  number d=pGetCoeff(ph);
2263  if(SR_HDL(d)&SR_INT) return d;
2264  int s=mpz_size1(d->z);
2265  int s2=-1;
2266  number d2;
2267  loop
2268  {
2269    pIter(ph);
2270    if(ph==NULL)
2271    {
2272      if (s2==-1) return nlCopy(d,r->cf);
2273      break;
2274    }
2275    if (SR_HDL(pGetCoeff(ph))&SR_INT)
2276    {
2277      s2=s;
2278      d2=d;
2279      s=0;
2280      d=pGetCoeff(ph);
2281      if (s2==0) break;
2282    }
2283    else
2284    if (mpz_size1((pGetCoeff(ph)->z))<=s)
2285    {
2286      s2=s;
2287      d2=d;
2288      d=pGetCoeff(ph);
2289      s=mpz_size1(d->z);
2290    }
2291  }
2292  return nlGcd(d,d2,r->cf);
2293}
2294#endif
2295
2296number p_InitContent_a(poly ph, const ring r)
2297// only for coefficients in K(a) anf K(a,...)
2298{
2299  number d=pGetCoeff(ph);
2300  int s=n_ParDeg(d,r->cf);
2301  if (s /* n_ParDeg(d)*/ <=1) return n_Copy(d,r->cf);
2302  int s2=-1;
2303  number d2;
2304  int ss;
2305  loop
2306  {
2307    pIter(ph);
2308    if(ph==NULL)
2309    {
2310      if (s2==-1) return n_Copy(d,r->cf);
2311      break;
2312    }
2313    if ((ss=n_ParDeg(pGetCoeff(ph),r->cf))<s)
2314    {
2315      s2=s;
2316      d2=d;
2317      s=ss;
2318      d=pGetCoeff(ph);
2319      if (s2<=1) break;
2320    }
2321  }
2322  return n_Gcd(d,d2,r->cf);
2323}
2324
2325
2326//void pContent(poly ph)
2327//{
2328//  number h,d;
2329//  poly p;
2330//
2331//  p = ph;
2332//  if(pNext(p)==NULL)
2333//  {
2334//    pSetCoeff(p,nInit(1));
2335//  }
2336//  else
2337//  {
2338//#ifdef PDEBUG
2339//    if (!pTest(p)) return;
2340//#endif
2341//    nNormalize(pGetCoeff(p));
2342//    if(!nGreaterZero(pGetCoeff(ph)))
2343//    {
2344//      ph = pNeg(ph);
2345//      nNormalize(pGetCoeff(p));
2346//    }
2347//    h=pGetCoeff(p);
2348//    pIter(p);
2349//    while (p!=NULL)
2350//    {
2351//      nNormalize(pGetCoeff(p));
2352//      if (nGreater(h,pGetCoeff(p))) h=pGetCoeff(p);
2353//      pIter(p);
2354//    }
2355//    h=nCopy(h);
2356//    p=ph;
2357//    while (p!=NULL)
2358//    {
2359//      d=n_Gcd(h,pGetCoeff(p));
2360//      nDelete(&h);
2361//      h = d;
2362//      if(nIsOne(h))
2363//      {
2364//        break;
2365//      }
2366//      pIter(p);
2367//    }
2368//    p = ph;
2369//    //number tmp;
2370//    if(!nIsOne(h))
2371//    {
2372//      while (p!=NULL)
2373//      {
2374//        d = nIntDiv(pGetCoeff(p),h);
2375//        pSetCoeff(p,d);
2376//        pIter(p);
2377//      }
2378//    }
2379//    nDelete(&h);
2380//#ifdef HAVE_FACTORY
2381//    if ( (nGetChar() == 1) || (nGetChar() < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
2382//    {
2383//      pTest(ph);
2384//      singclap_divide_content(ph);
2385//      pTest(ph);
2386//    }
2387//#endif
2388//  }
2389//}
2390#if 0
2391void p_Content(poly ph, const ring r)
2392{
2393  number h,d;
2394  poly p;
2395
2396  if(pNext(ph)==NULL)
2397  {
2398    p_SetCoeff(ph,n_Init(1,r->cf),r);
2399  }
2400  else
2401  {
2402    n_Normalize(pGetCoeff(ph),r->cf);
2403    if(!n_GreaterZero(pGetCoeff(ph),r->cf)) ph = p_Neg(ph,r);
2404    h=n_Copy(pGetCoeff(ph),r->cf);
2405    p = pNext(ph);
2406    while (p!=NULL)
2407    {
2408      n_Normalize(pGetCoeff(p),r->cf);
2409      d=n_Gcd(h,pGetCoeff(p),r->cf);
2410      n_Delete(&h,r->cf);
2411      h = d;
2412      if(n_IsOne(h,r->cf))
2413      {
2414        break;
2415      }
2416      pIter(p);
2417    }
2418    p = ph;
2419    //number tmp;
2420    if(!n_IsOne(h,r->cf))
2421    {
2422      while (p!=NULL)
2423      {
2424        //d = nDiv(pGetCoeff(p),h);
2425        //tmp = nIntDiv(pGetCoeff(p),h);
2426        //if (!nEqual(d,tmp))
2427        //{
2428        //  StringSetS("** div0:");nWrite(pGetCoeff(p));StringAppendS("/");
2429        //  nWrite(h);StringAppendS("=");nWrite(d);StringAppendS(" int:");
2430        //  nWrite(tmp);Print(StringAppendS("\n"));
2431        //}
2432        //nDelete(&tmp);
2433        d = n_IntDiv(pGetCoeff(p),h,r->cf);
2434        p_SetCoeff(p,d,r->cf);
2435        pIter(p);
2436      }
2437    }
2438    n_Delete(&h,r->cf);
2439#ifdef HAVE_FACTORY
2440    //if ( (n_GetChar(r) == 1) || (n_GetChar(r) < 0) ) /* Q[a],Q(a),Zp[a],Z/p(a) */
2441    //{
2442    //  singclap_divide_content(ph);
2443    //  if(!n_GreaterZero(pGetCoeff(ph),r)) ph = p_Neg(ph,r);
2444    //}
2445#endif
2446  }
2447}
2448#endif
2449/* ---------------------------------------------------------------------------*/
2450/* cleardenom suff                                                           */
2451poly p_Cleardenom(poly ph, const ring r)
2452{
2453  poly start=ph;
2454  number d, h;
2455  poly p;
2456
2457#ifdef HAVE_RINGS
2458  if (rField_is_Ring(r))
2459  {
2460    p_Content(ph,r);
2461    return start;
2462  }
2463#endif
2464  if (rField_is_Zp(r) && TEST_OPT_INTSTRATEGY) return start;
2465  p = ph;
2466  if(pNext(p)==NULL)
2467  {
2468    if (TEST_OPT_CONTENTSB)
2469    {
2470      number n=n_GetDenom(pGetCoeff(p),r->cf);
2471      if (!n_IsOne(n,r->cf))
2472      {
2473        number nn=n_Mult(pGetCoeff(p),n,r->cf);
2474        n_Normalize(nn,r->cf);
2475        p_SetCoeff(p,nn,r);
2476      }
2477      n_Delete(&n,r->cf);
2478    }
2479    else
2480      p_SetCoeff(p,n_Init(1,r->cf),r);
2481  }
2482  else
2483  {
2484    h = n_Init(1,r->cf);
2485    while (p!=NULL)
2486    {
2487      n_Normalize(pGetCoeff(p),r->cf);
2488      d=n_Lcm(h,pGetCoeff(p),r->cf);
2489      n_Delete(&h,r->cf);
2490      h=d;
2491      pIter(p);
2492    }
2493    /* contains the 1/lcm of all denominators */
2494    if(!n_IsOne(h,r->cf))
2495    {
2496      p = ph;
2497      while (p!=NULL)
2498      {
2499        /* should be:
2500        * number hh;
2501        * nGetDenom(p->coef,&hh);
2502        * nMult(&h,&hh,&d);
2503        * nNormalize(d);
2504        * nDelete(&hh);
2505        * nMult(d,p->coef,&hh);
2506        * nDelete(&d);
2507        * nDelete(&(p->coef));
2508        * p->coef =hh;
2509        */
2510        d=n_Mult(h,pGetCoeff(p),r->cf);
2511        n_Normalize(d,r->cf);
2512        p_SetCoeff(p,d,r);
2513        pIter(p);
2514      }
2515      n_Delete(&h,r->cf);
2516      if (n_GetChar(r->cf)==1)
2517      {
2518        loop
2519        {
2520          h = n_Init(1,r->cf);
2521          p=ph;
2522          while (p!=NULL)
2523          {
2524            d=n_Lcm(h,pGetCoeff(p),r->cf);
2525            n_Delete(&h,r->cf);
2526            h=d;
2527            pIter(p);
2528          }
2529          /* contains the 1/lcm of all denominators */
2530          if(!n_IsOne(h,r->cf))
2531          {
2532            p = ph;
2533            while (p!=NULL)
2534            {
2535              /* should be:
2536              * number hh;
2537              * nGetDenom(p->coef,&hh);
2538              * nMult(&h,&hh,&d);
2539              * nNormalize(d);
2540              * nDelete(&hh);
2541              * nMult(d,p->coef,&hh);
2542              * nDelete(&d);
2543              * nDelete(&(p->coef));
2544              * p->coef =hh;
2545              */
2546              d=n_Mult(h,pGetCoeff(p),r->cf);
2547              n_Normalize(d,r->cf);
2548              p_SetCoeff(p,d,r);
2549              pIter(p);
2550            }
2551            n_Delete(&h,r->cf);
2552          }
2553          else
2554          {
2555            n_Delete(&h,r->cf);
2556            break;
2557          }
2558        }
2559      }
2560    }
2561    if (h!=NULL) n_Delete(&h,r->cf);
2562
2563    p_Content(ph,r);
2564#ifdef HAVE_RATGRING
2565    if (rIsRatGRing(r))
2566    {
2567      /* quick unit detection in the rational case is done in gr_nc_bba */
2568      pContentRat(ph);
2569      start=ph;
2570    }
2571#endif
2572  }
2573  return start;
2574}
2575
2576void p_Cleardenom_n(poly ph,const ring r,number &c)
2577{
2578  number d, h;
2579  poly p;
2580
2581  p = ph;
2582  if(pNext(p)==NULL)
2583  {
2584    c=n_Invers(pGetCoeff(p),r->cf);
2585    p_SetCoeff(p,n_Init(1,r->cf),r);
2586  }
2587  else
2588  {
2589    h = n_Init(1,r->cf);
2590    while (p!=NULL)
2591    {
2592      n_Normalize(pGetCoeff(p),r->cf);
2593      d=n_Lcm(h,pGetCoeff(p),r->cf);
2594      n_Delete(&h,r->cf);
2595      h=d;
2596      pIter(p);
2597    }
2598    c=h;
2599    /* contains the 1/lcm of all denominators */
2600    if(!n_IsOne(h,r->cf))
2601    {
2602      p = ph;
2603      while (p!=NULL)
2604      {
2605        /* should be:
2606        * number hh;
2607        * nGetDenom(p->coef,&hh);
2608        * nMult(&h,&hh,&d);
2609        * nNormalize(d);
2610        * nDelete(&hh);
2611        * nMult(d,p->coef,&hh);
2612        * nDelete(&d);
2613        * nDelete(&(p->coef));
2614        * p->coef =hh;
2615        */
2616        d=n_Mult(h,pGetCoeff(p),r->cf);
2617        n_Normalize(d,r->cf);
2618        p_SetCoeff(p,d,r);
2619        pIter(p);
2620      }
2621      if (rField_is_Q_a(r))
2622      {
2623        loop
2624        {
2625          h = n_Init(1,r->cf);
2626          p=ph;
2627          while (p!=NULL)
2628          {
2629            d=n_Lcm(h,pGetCoeff(p),r->cf);
2630            n_Delete(&h,r->cf);
2631            h=d;
2632            pIter(p);
2633          }
2634          /* contains the 1/lcm of all denominators */
2635          if(!n_IsOne(h,r->cf))
2636          {
2637            p = ph;
2638            while (p!=NULL)
2639            {
2640              /* should be:
2641              * number hh;
2642              * nGetDenom(p->coef,&hh);
2643              * nMult(&h,&hh,&d);
2644              * nNormalize(d);
2645              * nDelete(&hh);
2646              * nMult(d,p->coef,&hh);
2647              * nDelete(&d);
2648              * nDelete(&(p->coef));
2649              * p->coef =hh;
2650              */
2651              d=n_Mult(h,pGetCoeff(p),r->cf);
2652              n_Normalize(d,r->cf);
2653              p_SetCoeff(p,d,r);
2654              pIter(p);
2655            }
2656            number t=n_Mult(c,h,r->cf);
2657            n_Delete(&c,r->cf);
2658            c=t;
2659          }
2660          else
2661          {
2662            break;
2663          }
2664          n_Delete(&h,r->cf);
2665        }
2666      }
2667    }
2668  }
2669}
2670
2671number p_GetAllDenom(poly ph, const ring r)
2672{
2673  number d=n_Init(1,r->cf);
2674  poly p = ph;
2675
2676  while (p!=NULL)
2677  {
2678    number h=n_GetDenom(pGetCoeff(p),r->cf);
2679    if (!n_IsOne(h,r->cf))
2680    {
2681      number dd=n_Mult(d,h,r->cf);
2682      n_Delete(&d,r->cf);
2683      d=dd;
2684    }
2685    n_Delete(&h,r->cf);
2686    pIter(p);
2687  }
2688  return d;
2689}
2690
2691int p_Size(poly p, const ring r)
2692{
2693  int count = 0;
2694  while ( p != NULL )
2695  {
2696    count+= n_Size( pGetCoeff( p ), r->cf );
2697    pIter( p );
2698  }
2699  return count;
2700}
2701
2702/*2
2703*make p homogeneous by multiplying the monomials by powers of x_varnum
2704*assume: deg(var(varnum))==1
2705*/
2706poly p_Homogen (poly p, int varnum, const ring r)
2707{
2708  pFDegProc deg;
2709  if (r->pLexOrder && (r->order[0]==ringorder_lp))
2710    deg=p_Totaldegree;
2711  else
2712    deg=r->pFDeg;
2713
2714  poly q=NULL, qn;
2715  int  o,ii;
2716  sBucket_pt bp;
2717
2718  if (p!=NULL)
2719  {
2720    if ((varnum < 1) || (varnum > rVar(r)))
2721    {
2722      return NULL;
2723    }
2724    o=deg(p,r);
2725    q=pNext(p);
2726    while (q != NULL)
2727    {
2728      ii=deg(q,r);
2729      if (ii>o) o=ii;
2730      pIter(q);
2731    }
2732    q = p_Copy(p,r);
2733    bp = sBucketCreate(r);
2734    while (q != NULL)
2735    {
2736      ii = o-deg(q,r);
2737      if (ii!=0)
2738      {
2739        p_AddExp(q,varnum, (long)ii,r);
2740        p_Setm(q,r);
2741      }
2742      qn = pNext(q);
2743      pNext(q) = NULL;
2744      sBucket_Add_p(bp, q, 1);
2745      q = qn;
2746    }
2747    sBucketDestroyAdd(bp, &q, &ii);
2748  }
2749  return q;
2750}
2751
2752/*2
2753*tests if p is homogeneous with respect to the actual weigths
2754*/
2755BOOLEAN p_IsHomogeneous (poly p, const ring r)
2756{
2757  poly qp=p;
2758  int o;
2759
2760  if ((p == NULL) || (pNext(p) == NULL)) return TRUE;
2761  pFDegProc d;
2762  if (r->pLexOrder && (r->order[0]==ringorder_lp))
2763    d=p_Totaldegree;
2764  else
2765    d=r->pFDeg;
2766  o = d(p,r);
2767  do
2768  {
2769    if (d(qp,r) != o) return FALSE;
2770    pIter(qp);
2771  }
2772  while (qp != NULL);
2773  return TRUE;
2774}
2775
2776/*----------utilities for syzygies--------------*/
2777BOOLEAN   p_VectorHasUnitB(poly p, int * k, const ring r)
2778{
2779  poly q=p,qq;
2780  int i;
2781
2782  while (q!=NULL)
2783  {
2784    if (p_LmIsConstantComp(q,r))
2785    {
2786      i = p_GetComp(q,r);
2787      qq = p;
2788      while ((qq != q) && (p_GetComp(qq,r) != i)) pIter(qq);
2789      if (qq == q)
2790      {
2791        *k = i;
2792        return TRUE;
2793      }
2794      else
2795        pIter(q);
2796    }
2797    else pIter(q);
2798  }
2799  return FALSE;
2800}
2801
2802void   p_VectorHasUnit(poly p, int * k, int * len, const ring r)
2803{
2804  poly q=p,qq;
2805  int i,j=0;
2806
2807  *len = 0;
2808  while (q!=NULL)
2809  {
2810    if (p_LmIsConstantComp(q,r))
2811    {
2812      i = p_GetComp(q,r);
2813      qq = p;
2814      while ((qq != q) && (p_GetComp(qq,r) != i)) pIter(qq);
2815      if (qq == q)
2816      {
2817       j = 0;
2818       while (qq!=NULL)
2819       {
2820         if (p_GetComp(qq,r)==i) j++;
2821        pIter(qq);
2822       }
2823       if ((*len == 0) || (j<*len))
2824       {
2825         *len = j;
2826         *k = i;
2827       }
2828      }
2829    }
2830    pIter(q);
2831  }
2832}
2833
2834poly p_TakeOutComp1(poly * p, int k, const ring r)
2835{
2836  poly q = *p;
2837
2838  if (q==NULL) return NULL;
2839
2840  poly qq=NULL,result = NULL;
2841
2842  if (p_GetComp(q,r)==k)
2843  {
2844    result = q; /* *p */
2845    while ((q!=NULL) && (p_GetComp(q,r)==k))
2846    {
2847      p_SetComp(q,0,r);
2848      p_SetmComp(q,r);
2849      qq = q;
2850      pIter(q);
2851    }
2852    *p = q;
2853    pNext(qq) = NULL;
2854  }
2855  if (q==NULL) return result;
2856//  if (pGetComp(q) > k) pGetComp(q)--;
2857  while (pNext(q)!=NULL)
2858  {
2859    if (p_GetComp(pNext(q),r)==k)
2860    {
2861      if (result==NULL)
2862      {
2863        result = pNext(q);
2864        qq = result;
2865      }
2866      else
2867      {
2868        pNext(qq) = pNext(q);
2869        pIter(qq);
2870      }
2871      pNext(q) = pNext(pNext(q));
2872      pNext(qq) =NULL;
2873      p_SetComp(qq,0,r);
2874      p_SetmComp(qq,r);
2875    }
2876    else
2877    {
2878      pIter(q);
2879//      if (pGetComp(q) > k) pGetComp(q)--;
2880    }
2881  }
2882  return result;
2883}
2884
2885poly p_TakeOutComp(poly * p, int k, const ring r)
2886{
2887  poly q = *p,qq=NULL,result = NULL;
2888
2889  if (q==NULL) return NULL;
2890  BOOLEAN use_setmcomp=rOrd_SetCompRequiresSetm(r);
2891  if (p_GetComp(q,r)==k)
2892  {
2893    result = q;
2894    do
2895    {
2896      p_SetComp(q,0,r);
2897      if (use_setmcomp) p_SetmComp(q,r);
2898      qq = q;
2899      pIter(q);
2900    }
2901    while ((q!=NULL) && (p_GetComp(q,r)==k));
2902    *p = q;
2903    pNext(qq) = NULL;
2904  }
2905  if (q==NULL) return result;
2906  if (p_GetComp(q,r) > k)
2907  {
2908    p_SubComp(q,1,r);
2909    if (use_setmcomp) p_SetmComp(q,r);
2910  }
2911  poly pNext_q;
2912  while ((pNext_q=pNext(q))!=NULL)
2913  {
2914    if (p_GetComp(pNext_q,r)==k)
2915    {
2916      if (result==NULL)
2917      {
2918        result = pNext_q;
2919        qq = result;
2920      }
2921      else
2922      {
2923        pNext(qq) = pNext_q;
2924        pIter(qq);
2925      }
2926      pNext(q) = pNext(pNext_q);
2927      pNext(qq) =NULL;
2928      p_SetComp(qq,0,r);
2929      if (use_setmcomp) p_SetmComp(qq,r);
2930    }
2931    else
2932    {
2933      /*pIter(q);*/ q=pNext_q;
2934      if (p_GetComp(q,r) > k)
2935      {
2936        p_SubComp(q,1,r);
2937        if (use_setmcomp) p_SetmComp(q,r);
2938      }
2939    }
2940  }
2941  return result;
2942}
2943
2944// Splits *p into two polys: *q which consists of all monoms with
2945// component == comp and *p of all other monoms *lq == pLength(*q)
2946void p_TakeOutComp(poly *r_p, long comp, poly *r_q, int *lq, const ring r)
2947{
2948  spolyrec pp, qq;
2949  poly p, q, p_prev;
2950  int l = 0;
2951
2952#ifdef HAVE_ASSUME
2953  int lp = pLength(*r_p);
2954#endif
2955
2956  pNext(&pp) = *r_p;
2957  p = *r_p;
2958  p_prev = &pp;
2959  q = &qq;
2960
2961  while(p != NULL)
2962  {
2963    while (p_GetComp(p,r) == comp)
2964    {
2965      pNext(q) = p;
2966      pIter(q);
2967      p_SetComp(p, 0,r);
2968      p_SetmComp(p,r);
2969      pIter(p);
2970      l++;
2971      if (p == NULL)
2972      {
2973        pNext(p_prev) = NULL;
2974        goto Finish;
2975      }
2976    }
2977    pNext(p_prev) = p;
2978    p_prev = p;
2979    pIter(p);
2980  }
2981
2982  Finish:
2983  pNext(q) = NULL;
2984  *r_p = pNext(&pp);
2985  *r_q = pNext(&qq);
2986  *lq = l;
2987#ifdef HAVE_ASSUME
2988  assume(pLength(*r_p) + pLength(*r_q) == lp);
2989#endif
2990  p_Test(*r_p,r);
2991  p_Test(*r_q,r);
2992}
2993
2994void p_DeleteComp(poly * p,int k, const ring r)
2995{
2996  poly q;
2997
2998  while ((*p!=NULL) && (p_GetComp(*p,r)==k)) p_LmDelete(p,r);
2999  if (*p==NULL) return;
3000  q = *p;
3001  if (p_GetComp(q,r)>k)
3002  {
3003    p_SubComp(q,1,r);
3004    p_SetmComp(q,r);
3005  }
3006  while (pNext(q)!=NULL)
3007  {
3008    if (p_GetComp(pNext(q),r)==k)
3009      p_LmDelete(&(pNext(q)),r);
3010    else
3011    {
3012      pIter(q);
3013      if (p_GetComp(q,r)>k)
3014      {
3015        p_SubComp(q,1,r);
3016        p_SetmComp(q,r);
3017      }
3018    }
3019  }
3020}
3021
3022/*2
3023* convert a vector to a set of polys,
3024* allocates the polyset, (entries 0..(*len)-1)
3025* the vector will not be changed
3026*/
3027void  p_Vec2Polys(poly v, poly* *p, int *len, const ring r)
3028{
3029  poly h;
3030  int k;
3031
3032  *len=p_MaxComp(v,r);
3033  if (*len==0) *len=1;
3034  *p=(poly*)omAlloc0((*len)*sizeof(poly));
3035  while (v!=NULL)
3036  {
3037    h=p_Head(v,r);
3038    k=p_GetComp(h,r);
3039    p_SetComp(h,0,r);
3040    (*p)[k-1]=p_Add_q((*p)[k-1],h,r);
3041    pIter(v);
3042  }
3043}
3044
3045/* -------------------------------------------------------- */
3046/*2
3047* change all global variables to fit the description of the new ring
3048*/
3049
3050void p_SetGlobals(const ring r, BOOLEAN complete)
3051{
3052  if (r->ppNoether!=NULL) p_Delete(&r->ppNoether,r);
3053
3054  if (complete)
3055  {
3056    test &= ~ TEST_RINGDEP_OPTS;
3057    test |= r->options;
3058  }
3059}
3060//
3061// resets the pFDeg and pLDeg: if pLDeg is not given, it is
3062// set to currRing->pLDegOrig, i.e. to the respective LDegProc which
3063// only uses pFDeg (and not p_Deg, or pTotalDegree, etc)
3064void pSetDegProcs(ring r, pFDegProc new_FDeg, pLDegProc new_lDeg)
3065{
3066  assume(new_FDeg != NULL);
3067  r->pFDeg = new_FDeg;
3068
3069  if (new_lDeg == NULL)
3070    new_lDeg = r->pLDegOrig;
3071
3072  r->pLDeg = new_lDeg;
3073}
3074
3075// restores pFDeg and pLDeg:
3076void pRestoreDegProcs(ring r, pFDegProc old_FDeg, pLDegProc old_lDeg)
3077{
3078  assume(old_FDeg != NULL && old_lDeg != NULL);
3079  r->pFDeg = old_FDeg;
3080  r->pLDeg = old_lDeg;
3081}
3082
3083/*-------- several access procedures to monomials -------------------- */
3084/*
3085* the module weights for std
3086*/
3087static pFDegProc pOldFDeg;
3088static pLDegProc pOldLDeg;
3089static intvec * pModW;
3090static BOOLEAN pOldLexOrder;
3091
3092static long pModDeg(poly p, ring r)
3093{
3094  long d=pOldFDeg(p, r);
3095  int c=p_GetComp(p, r);
3096  if ((c>0) && ((r->pModW)->range(c-1))) d+= (*(r->pModW))[c-1];
3097  return d;
3098  //return pOldFDeg(p, r)+(*pModW)[p_GetComp(p, r)-1];
3099}
3100
3101void p_SetModDeg(intvec *w, ring r)
3102{
3103  if (w!=NULL)
3104  {
3105    r->pModW = w;
3106    pOldFDeg = r->pFDeg;
3107    pOldLDeg = r->pLDeg;
3108    pOldLexOrder = r->pLexOrder;
3109    pSetDegProcs(r,pModDeg);
3110    r->pLexOrder = TRUE;
3111  }
3112  else
3113  {
3114    r->pModW = NULL;
3115    pRestoreDegProcs(r,pOldFDeg, pOldLDeg);
3116    r->pLexOrder = pOldLexOrder;
3117  }
3118}
3119
3120/*2
3121* handle memory request for sets of polynomials (ideals)
3122* l is the length of *p, increment is the difference (may be negative)
3123*/
3124void pEnlargeSet(poly* *p, int l, int increment)
3125{
3126  poly* h;
3127
3128  h=(poly*)omReallocSize((poly*)*p,l*sizeof(poly),(l+increment)*sizeof(poly));
3129  if (increment>0)
3130  {
3131    //for (i=l; i<l+increment; i++)
3132    //  h[i]=NULL;
3133    memset(&(h[l]),0,increment*sizeof(poly));
3134  }
3135  *p=h;
3136}
3137
3138/*2
3139*divides p1 by its leading coefficient
3140*/
3141void p_Norm(poly p1, const ring r)
3142{
3143#ifdef HAVE_RINGS
3144  if (rField_is_Ring(r))
3145  {
3146    if (!n_IsUnit(pGetCoeff(p1), r->cf)) return;
3147    // Werror("p_Norm not possible in the case of coefficient rings.");
3148  }
3149  else
3150#endif
3151  if (p1!=NULL)
3152  {
3153    if (pNext(p1)==NULL)
3154    {
3155      p_SetCoeff(p1,n_Init(1,r->cf),r);
3156      return;
3157    }
3158    poly h;
3159    if (!n_IsOne(pGetCoeff(p1),r->cf))
3160    {
3161      number k, c;
3162      n_Normalize(pGetCoeff(p1),r->cf);
3163      k = pGetCoeff(p1);
3164      c = n_Init(1,r->cf);
3165      pSetCoeff0(p1,c);
3166      h = pNext(p1);
3167      while (h!=NULL)
3168      {
3169        c=n_Div(pGetCoeff(h),k,r->cf);
3170        // no need to normalize: Z/p, R
3171        // normalize already in nDiv: Q_a, Z/p_a
3172        // remains: Q
3173        if (rField_is_Q(r) && (!n_IsOne(c,r->cf))) n_Normalize(c,r->cf);
3174        p_SetCoeff(h,c,r);
3175        pIter(h);
3176      }
3177      n_Delete(&k,r->cf);
3178    }
3179    else
3180    {
3181      //if (r->cf->cfNormalize != nDummy2) //TODO: OPTIMIZE
3182      {
3183        h = pNext(p1);
3184        while (h!=NULL)
3185        {
3186          n_Normalize(pGetCoeff(h),r->cf);
3187          pIter(h);
3188        }
3189      }
3190    }
3191  }
3192}
3193
3194/*2
3195*normalize all coefficients
3196*/
3197void p_Normalize(poly p,const ring r)
3198{
3199  if (rField_has_simple_inverse(r)) return; /* Z/p, GF(p,n), R, long R/C */
3200  while (p!=NULL)
3201  {
3202#ifdef LDEBUG
3203    n_Test(pGetCoeff(p), r->cf);
3204#endif
3205    n_Normalize(pGetCoeff(p),r->cf);
3206    pIter(p);
3207  }
3208}
3209
3210// splits p into polys with Exp(n) == 0 and Exp(n) != 0
3211// Poly with Exp(n) != 0 is reversed
3212static void p_SplitAndReversePoly(poly p, int n, poly *non_zero, poly *zero, const ring r)
3213{
3214  if (p == NULL)
3215  {
3216    *non_zero = NULL;
3217    *zero = NULL;
3218    return;
3219  }
3220  spolyrec sz;
3221  poly z, n_z, next;
3222  z = &sz;
3223  n_z = NULL;
3224
3225  while(p != NULL)
3226  {
3227    next = pNext(p);
3228    if (p_GetExp(p, n,r) == 0)
3229    {
3230      pNext(z) = p;
3231      pIter(z);
3232    }
3233    else
3234    {
3235      pNext(p) = n_z;
3236      n_z = p;
3237    }
3238    p = next;
3239  }
3240  pNext(z) = NULL;
3241  *zero = pNext(&sz);
3242  *non_zero = n_z;
3243}
3244/*3
3245* substitute the n-th variable by 1 in p
3246* destroy p
3247*/
3248static poly p_Subst1 (poly p,int n, const ring r)
3249{
3250  poly qq=NULL, result = NULL;
3251  poly zero=NULL, non_zero=NULL;
3252
3253  // reverse, so that add is likely to be linear
3254  p_SplitAndReversePoly(p, n, &non_zero, &zero,r);
3255
3256  while (non_zero != NULL)
3257  {
3258    assume(p_GetExp(non_zero, n,r) != 0);
3259    qq = non_zero;
3260    pIter(non_zero);
3261    qq->next = NULL;
3262    p_SetExp(qq,n,0,r);
3263    p_Setm(qq,r);
3264    result = p_Add_q(result,qq,r);
3265  }
3266  p = p_Add_q(result, zero,r);
3267  p_Test(p,r);
3268  return p;
3269}
3270
3271/*3
3272* substitute the n-th variable by number e in p
3273* destroy p
3274*/
3275static poly p_Subst2 (poly p,int n, number e, const ring r)
3276{
3277  assume( ! n_IsZero(e,r->cf) );
3278  poly qq,result = NULL;
3279  number nn, nm;
3280  poly zero, non_zero;
3281
3282  // reverse, so that add is likely to be linear
3283  p_SplitAndReversePoly(p, n, &non_zero, &zero,r);
3284
3285  while (non_zero != NULL)
3286  {
3287    assume(p_GetExp(non_zero, n, r) != 0);
3288    qq = non_zero;
3289    pIter(non_zero);
3290    qq->next = NULL;
3291    n_Power(e, p_GetExp(qq, n, r), &nn,r->cf);
3292    nm = n_Mult(nn, pGetCoeff(qq),r->cf);
3293#ifdef HAVE_RINGS
3294    if (n_IsZero(nm,r->cf))
3295    {
3296      p_LmFree(&qq,r);
3297      n_Delete(&nm,r->cf);
3298    }
3299    else
3300#endif
3301    {
3302      p_SetCoeff(qq, nm,r);
3303      p_SetExp(qq, n, 0,r);
3304      p_Setm(qq,r);
3305      result = p_Add_q(result,qq,r);
3306    }
3307    n_Delete(&nn,r->cf);
3308  }
3309  p = p_Add_q(result, zero,r);
3310  p_Test(p,r);
3311  return p;
3312}
3313
3314
3315/* delete monoms whose n-th exponent is different from zero */
3316static poly p_Subst0(poly p, int n, const ring r)
3317{
3318  spolyrec res;
3319  poly h = &res;
3320  pNext(h) = p;
3321
3322  while (pNext(h)!=NULL)
3323  {
3324    if (p_GetExp(pNext(h),n,r)!=0)
3325    {
3326      p_LmDelete(&pNext(h),r);
3327    }
3328    else
3329    {
3330      pIter(h);
3331    }
3332  }
3333  p_Test(pNext(&res),r);
3334  return pNext(&res);
3335}
3336
3337/*2
3338* substitute the n-th variable by e in p
3339* destroy p
3340*/
3341poly p_Subst(poly p, int n, poly e, const ring r)
3342{
3343  if (e == NULL) return p_Subst0(p, n,r);
3344
3345  if (p_IsConstant(e,r))
3346  {
3347    if (n_IsOne(pGetCoeff(e),r->cf)) return p_Subst1(p,n,r);
3348    else return p_Subst2(p, n, pGetCoeff(e),r);
3349  }
3350
3351#ifdef HAVE_PLURAL
3352  if (rIsPluralRing(r))
3353  {
3354    return nc_pSubst(p,n,e,r);
3355  }
3356#endif
3357
3358  int exponent,i;
3359  poly h, res, m;
3360  int *me,*ee;
3361  number nu,nu1;
3362
3363  me=(int *)omAlloc((rVar(r)+1)*sizeof(int));
3364  ee=(int *)omAlloc((rVar(r)+1)*sizeof(int));
3365  if (e!=NULL) p_GetExpV(e,ee,r);
3366  res=NULL;
3367  h=p;
3368  while (h!=NULL)
3369  {
3370    if ((e!=NULL) || (p_GetExp(h,n,r)==0))
3371    {
3372      m=p_Head(h,r);
3373      p_GetExpV(m,me,r);
3374      exponent=me[n];
3375      me[n]=0;
3376      for(i=rVar(r);i>0;i--)
3377        me[i]+=exponent*ee[i];
3378      p_SetExpV(m,me,r);
3379      if (e!=NULL)
3380      {
3381        n_Power(pGetCoeff(e),exponent,&nu,r->cf);
3382        nu1=n_Mult(pGetCoeff(m),nu,r->cf);
3383        n_Delete(&nu,r->cf);
3384        p_SetCoeff(m,nu1,r);
3385      }
3386      res=p_Add_q(res,m,r);
3387    }
3388    p_LmDelete(&h,r);
3389  }
3390  omFreeSize((ADDRESS)me,(rVar(r)+1)*sizeof(int));
3391  omFreeSize((ADDRESS)ee,(rVar(r)+1)*sizeof(int));
3392  return res;
3393}
3394/*2
3395*returns a re-ordered copy of a polynomial, with permutation of the variables
3396*/
3397poly p_PermPoly (poly p, int * perm, const ring oldRing, const ring dst,
3398       nMapFunc nMap, int *par_perm, int OldPar)
3399{
3400  int OldpVariables = oldRing->N;
3401  poly result = NULL;
3402  poly result_last = NULL;
3403  poly aq=NULL; /* the map coefficient */
3404  poly qq; /* the mapped monomial */
3405
3406  while (p != NULL)
3407  {
3408    if ((OldPar==0)||(rField_is_GF(oldRing)))
3409    {
3410      qq = p_Init(dst);
3411      number n=nMap(pGetCoeff(p),oldRing->cf,dst->cf);
3412      if ((!rMinpolyIsNULL(dst))
3413      && ((rField_is_Zp_a(dst)) || (rField_is_Q_a(dst))))
3414      {
3415        n_Normalize(n,dst->cf);
3416      }
3417      pGetCoeff(qq)=n;
3418    // coef may be zero:  pTest(qq);
3419    }
3420    else
3421    {
3422      qq=p_One(dst);
3423      WerrorS("longalg missing");
3424      #if 0
3425      aq=naPermNumber(pGetCoeff(p),par_perm,OldPar, oldRing);
3426      if ((!rMinpolyIsNULL(dst))
3427      && ((rField_is_Zp_a(dst)) || (rField_is_Q_a(dst))))
3428      {
3429        poly tmp=aq;
3430        while (tmp!=NULL)
3431        {
3432          number n=pGetCoeff(tmp);
3433          n_Normalize(n,dst->cf);
3434          pGetCoeff(tmp)=n;
3435          pIter(tmp);
3436        }
3437      }
3438      p_Test(aq,dst);
3439      #endif
3440    }
3441    if (rRing_has_Comp(dst)) p_SetComp(qq, p_GetComp(p,oldRing),dst);
3442    if (n_IsZero(pGetCoeff(qq),dst->cf))
3443    {
3444      p_LmDelete(&qq,dst);
3445    }
3446    else
3447    {
3448      int i;
3449      int mapped_to_par=0;
3450      for(i=1; i<=OldpVariables; i++)
3451      {
3452        int e=p_GetExp(p,i,oldRing);
3453        if (e!=0)
3454        {
3455          if (perm==NULL)
3456          {
3457            p_SetExp(qq,i, e, dst);
3458          }
3459          else if (perm[i]>0)
3460            p_AddExp(qq,perm[i], e/*p_GetExp( p,i,oldRing)*/, dst);
3461          else if (perm[i]<0)
3462          {
3463            if (rField_is_GF(dst))
3464            {
3465              number c=pGetCoeff(qq);
3466              number ee=n_Par(1,dst->cf);
3467              number eee;n_Power(ee,e,&eee,dst->cf); //nfDelete(ee,dst);
3468              ee=n_Mult(c,eee,dst->cf);
3469              //nfDelete(c,dst);nfDelete(eee,dst);
3470              pSetCoeff0(qq,ee);
3471            }
3472            else
3473            {
3474              WerrorS("longalg missing");
3475              #if 0
3476              lnumber c=(lnumber)pGetCoeff(qq);
3477              if (c->z->next==NULL)
3478                p_AddExp(c->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/,dst->algring);
3479              else /* more difficult: we have really to multiply: */
3480              {
3481                lnumber mmc=(lnumber)naInit(1,dst);
3482                p_SetExp(mmc->z,-perm[i],e/*p_GetExp( p,i,oldRing)*/,dst->algring);
3483                p_Setm(mmc->z,dst->algring->cf);
3484                pGetCoeff(qq)=n_Mult((number)c,(number)mmc,dst->cf);
3485                n_Delete((number *)&c,dst->cf);
3486                n_Delete((number *)&mmc,dst->cf);
3487              }
3488              mapped_to_par=1;
3489              #endif
3490            }
3491          }
3492          else
3493          {
3494            /* this variable maps to 0 !*/
3495            p_LmDelete(&qq,dst);
3496            break;
3497          }
3498        }
3499      }
3500      if (mapped_to_par
3501      && (!rMinpolyIsNULL(dst)))
3502      {
3503        number n=pGetCoeff(qq);
3504        n_Normalize(n,dst->cf);
3505        pGetCoeff(qq)=n;
3506      }
3507    }
3508    pIter(p);
3509#if 1
3510    if (qq!=NULL)
3511    {
3512      p_Setm(qq,dst);
3513      p_Test(aq,dst);
3514      p_Test(qq,dst);
3515      if (aq!=NULL) qq=p_Mult_q(aq,qq,dst);
3516      aq = qq;
3517      while (pNext(aq) != NULL) pIter(aq);
3518      if (result_last==NULL)
3519      {
3520        result=qq;
3521      }
3522      else
3523      {
3524        pNext(result_last)=qq;
3525      }
3526      result_last=aq;
3527      aq = NULL;
3528    }
3529    else if (aq!=NULL)
3530    {
3531      p_Delete(&aq,dst);
3532    }
3533  }
3534  result=p_SortAdd(result,dst);
3535#else
3536  //  if (qq!=NULL)
3537  //  {
3538  //    pSetm(qq);
3539  //    pTest(qq);
3540  //    pTest(aq);
3541  //    if (aq!=NULL) qq=pMult(aq,qq);
3542  //    aq = qq;
3543  //    while (pNext(aq) != NULL) pIter(aq);
3544  //    pNext(aq) = result;
3545  //    aq = NULL;
3546  //    result = qq;
3547  //  }
3548  //  else if (aq!=NULL)
3549  //  {
3550  //    pDelete(&aq);
3551  //  }
3552  //}
3553  //p = result;
3554  //result = NULL;
3555  //while (p != NULL)
3556  //{
3557  //  qq = p;
3558  //  pIter(p);
3559  //  qq->next = NULL;
3560  //  result = pAdd(result, qq);
3561  //}
3562#endif
3563  p_Test(result,dst);
3564  return result;
3565}
3566/**************************************************************
3567 *
3568 * Jet
3569 *
3570 **************************************************************/
3571
3572poly pp_Jet(poly p, int m, const ring R)
3573{
3574  poly r=NULL;
3575  poly t=NULL;
3576
3577  while (p!=NULL)
3578  {
3579    if (p_Totaldegree(p,R)<=m)
3580    {
3581      if (r==NULL)
3582        r=p_Head(p,R);
3583      else
3584      if (t==NULL)
3585      {
3586        pNext(r)=p_Head(p,R);
3587        t=pNext(r);
3588      }
3589      else
3590      {
3591        pNext(t)=p_Head(p,R);
3592        pIter(t);
3593      }
3594    }
3595    pIter(p);
3596  }
3597  return r;
3598}
3599
3600poly p_Jet(poly p, int m,const ring R)
3601{
3602  poly t=NULL;
3603
3604  while((p!=NULL) && (p_Totaldegree(p,R)>m)) p_LmDelete(&p,R);
3605  if (p==NULL) return NULL;
3606  poly r=p;
3607  while (pNext(p)!=NULL)
3608  {
3609    if (p_Totaldegree(pNext(p),R)>m)
3610    {
3611      p_LmDelete(&pNext(p),R);
3612    }
3613    else
3614      pIter(p);
3615  }
3616  return r;
3617}
3618
3619poly pp_JetW(poly p, int m, short *w, const ring R)
3620{
3621  poly r=NULL;
3622  poly t=NULL;
3623  while (p!=NULL)
3624  {
3625    if (totaldegreeWecart_IV(p,R,w)<=m)
3626    {
3627      if (r==NULL)
3628        r=p_Head(p,R);
3629      else
3630      if (t==NULL)
3631      {
3632        pNext(r)=p_Head(p,R);
3633        t=pNext(r);
3634      }
3635      else
3636      {
3637        pNext(t)=p_Head(p,R);
3638        pIter(t);
3639      }
3640    }
3641    pIter(p);
3642  }
3643  return r;
3644}
3645
3646poly p_JetW(poly p, int m, short *w, const ring R)
3647{
3648  while((p!=NULL) && (totaldegreeWecart_IV(p,R,w)>m)) p_LmDelete(&p,R);
3649  if (p==NULL) return NULL;
3650  poly r=p;
3651  while (pNext(p)!=NULL)
3652  {
3653    if (totaldegreeWecart_IV(pNext(p),R,w)>m)
3654    {
3655      p_LmDelete(&pNext(p),R);
3656    }
3657    else
3658      pIter(p);
3659  }
3660  return r;
3661}
3662
3663/*************************************************************/
3664int p_MinDeg(poly p,intvec *w, const ring R)
3665{
3666  if(p==NULL)
3667    return -1;
3668  int d=-1;
3669  while(p!=NULL)
3670  {
3671    int d0=0;
3672    for(int j=0;j<rVar(R);j++)
3673      if(w==NULL||j>=w->length())
3674        d0+=p_GetExp(p,j+1,R);
3675      else
3676        d0+=(*w)[j]*p_GetExp(p,j+1,R);
3677    if(d0<d||d==-1)
3678      d=d0;
3679    pIter(p);
3680  }
3681  return d;
3682}
3683
3684/***************************************************************/
3685
3686poly p_Series(int n,poly p,poly u, intvec *w, const ring R)
3687{
3688  short *ww=iv2array(w,R);
3689  if(p!=NULL)
3690  {
3691    if(u==NULL)
3692      p=p_JetW(p,n,ww,R);
3693    else
3694      p=p_JetW(p_Mult_q(p,p_Invers(n-p_MinDeg(p,w,R),u,w,R),R),n,ww,R);
3695  }
3696  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
3697  return p;
3698}
3699
3700poly p_Invers(int n,poly u,intvec *w, const ring R)
3701{
3702  if(n<0)
3703    return NULL;
3704  number u0=n_Invers(pGetCoeff(u),R->cf);
3705  poly v=p_NSet(u0,R);
3706  if(n==0)
3707    return v;
3708  short *ww=iv2array(w,R);
3709  poly u1=p_JetW(p_Sub(p_One(R),p_Mult_nn(u,u0,R),R),n,ww,R);
3710  if(u1==NULL)
3711  {
3712    omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
3713    return v;
3714  }
3715  poly v1=p_Mult_nn(p_Copy(u1,R),u0,R);
3716  v=p_Add_q(v,p_Copy(v1,R),R);
3717  for(int i=n/p_MinDeg(u1,w,R);i>1;i--)
3718  {
3719    v1=p_JetW(p_Mult_q(v1,p_Copy(u1,R),R),n,ww,R);
3720    v=p_Add_q(v,p_Copy(v1,R),R);
3721  }
3722  p_Delete(&u1,R);
3723  p_Delete(&v1,R);
3724  omFreeSize((ADDRESS)ww,(rVar(R)+1)*sizeof(short));
3725  return v;
3726}
3727
3728BOOLEAN p_EqualPolys(poly p1,poly p2, const ring r)
3729{
3730  while ((p1 != NULL) && (p2 != NULL))
3731  {
3732    if (! p_LmEqual(p1, p2,r))
3733      return FALSE;
3734    if (! n_Equal(p_GetCoeff(p1,r), p_GetCoeff(p2,r),r ))
3735      return FALSE;
3736    pIter(p1);
3737    pIter(p2);
3738  }
3739  return (p1==p2);
3740}
3741
3742/*2
3743*returns TRUE if p1 is a skalar multiple of p2
3744*assume p1 != NULL and p2 != NULL
3745*/
3746BOOLEAN p_ComparePolys(poly p1,poly p2, const ring r)
3747{
3748  number n,nn;
3749  pAssume(p1 != NULL && p2 != NULL);
3750
3751  if (!p_LmEqual(p1,p2,r)) //compare leading mons
3752      return FALSE;
3753  if ((pNext(p1)==NULL) && (pNext(p2)!=NULL))
3754     return FALSE;
3755  if ((pNext(p2)==NULL) && (pNext(p1)!=NULL))
3756     return FALSE;
3757  if (pLength(p1) != pLength(p2))
3758    return FALSE;
3759#ifdef HAVE_RINGS
3760  if (rField_is_Ring(r))
3761  {
3762    if (!n_DivBy(p_GetCoeff(p1, r), p_GetCoeff(p2, r), r)) return FALSE;
3763  }
3764#endif
3765  n=n_Div(p_GetCoeff(p1,r),p_GetCoeff(p2,r),r);
3766  while ((p1 != NULL) /*&& (p2 != NULL)*/)
3767  {
3768    if ( ! p_LmEqual(p1, p2,r))
3769    {
3770        n_Delete(&n, r);
3771        return FALSE;
3772    }
3773    if (!n_Equal(p_GetCoeff(p1, r), nn = n_Mult(p_GetCoeff(p2, r),n, r), r))
3774    {
3775      n_Delete(&n, r);
3776      n_Delete(&nn, r);
3777      return FALSE;
3778    }
3779    n_Delete(&nn, r);
3780    pIter(p1);
3781    pIter(p2);
3782  }
3783  n_Delete(&n, r);
3784  return TRUE;
3785}
3786
3787
3788/***************************************************************
3789 *
3790 * p_ShallowDelete
3791 *
3792 ***************************************************************/
3793#undef LINKAGE
3794#define LINKAGE
3795#undef p_Delete__T
3796#define p_Delete__T p_ShallowDelete
3797#undef n_Delete__T
3798#define n_Delete__T(n, r) ((void)0)
3799
3800#include <polys/templates/p_Delete__T.cc>
3801
3802#ifdef HAVE_RINGS
3803/* TRUE iff LT(f) | LT(g) */
3804BOOLEAN p_DivisibleByRingCase(poly f, poly g, const ring r)
3805{
3806  int exponent;
3807  for(int i = (int)r->N; i; i--)
3808  {
3809    exponent = p_GetExp(g, i, r) - p_GetExp(f, i, r);
3810    if (exponent < 0) return FALSE;
3811  }
3812  return n_DivBy(p_GetCoeff(g,r), p_GetCoeff(f,r),r->cf);
3813}
3814#endif
Note: See TracBrowser for help on using the repository browser.