source: git/libpolys/polys/ext_fields/longalg.cc @ 6fd69c

spielwiese
Last change on this file since 6fd69c was 6fd69c, checked in by Hans Schoenemann <hannes@…>, 13 years ago
napoly -> poly
  • Property mode set to 100644
File size: 54.2 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: longalg.cc 12469 2010-01-28 10:39:49Z hannes $ */
5/*
6* ABSTRACT:   algebraic numbers
7*/
8
9#include <stdio.h>
10#include <string.h>
11#include "polys/config.h"
12// #include <polys/structs.h>
13#include <omalloc/omalloc.h>
14// #include <???/febase.h>
15#include <coeffs/longrat.h>
16#include <polys/modulop.h>
17#include <coeffs/numbers.h>
18#include <polys/polys.h>
19#include <polys/ideals.h>
20#include <polys/monomials/ring.h>
21#ifdef HAVE_FACTORY
22#define SI_DONT_HAVE_GLOBAL_VARS
23#include <factory/factory.h>
24#include <polys/clapsing.h>
25#include <polys/clapconv.h>
26#endif
27#include <polys/ext_fields/longtrans.h>
28#include <polys/ext_fields/longalg.h>
29
30struct snaIdeal
31{
32  int anz;
33  poly *liste;
34};
35typedef struct snaIdeal * naIdeal;
36
37naIdeal naI=NULL;
38
39omBin snaIdeal_bin = omGetSpecBin(sizeof(snaIdeal));
40
41int naNumbOfPar;
42poly naMinimalPoly;
43#define naParNames (currRing->parameter)
44static int naIsChar0;
45static ring naMapRing;
46
47#ifdef LDEBUG
48#define naTest(a) naDBTest(a,__FILE__,__LINE__)
49BOOLEAN naDBTest(number a, const char *f,const int l);
50#else
51#define naTest(a)
52#endif
53
54naIdeal naI = NULL;
55poly  naMinimalPoly;
56omBin   snaIdeal_bin = omGetSpecBin(sizeof(snaIdeal));
57number  (*naMap)(number from);
58//omBin lnumber_bin = omGetSpecBin(sizeof(slnumber));
59//omBin rnumber_bin = omGetSpecBin(sizeof(snumber));
60
61void redefineFunctionPointers()
62{
63  n_Procs_s* n = currRing->cf;
64  /* re-defining function pointers */
65  n->cfDelete       = naDelete;
66  n->nNormalize     = naNormalize;
67  n->cfInit         = naInit;
68  n->nPar           = naPar;
69  n->nParDeg        = naParDeg;
70  n->n_Int          = naInt;
71  n->nAdd           = naAdd;
72  n->nSub           = naSub;
73  n->nMult          = naMult;
74  n->nDiv           = naDiv;
75  n->nExactDiv      = naDiv;
76  n->nIntDiv        = naIntDiv;
77  n->nNeg           = naNeg;
78  n->nInvers        = naInvers;
79  n->nCopy          = naCopy;
80  n->cfCopy         = na_Copy;
81  n->nGreater       = naGreater;
82  n->nEqual         = naEqual;
83  n->nIsZero        = naIsZero;
84  n->nIsOne         = naIsOne;
85  n->nIsMOne        = naIsMOne;
86  n->nGreaterZero   = naGreaterZero;
87  n->nGreater       = naGreater;
88  n->cfWrite        = naWrite;
89  n->nRead          = naRead;
90  n->nPower         = naPower;
91  n->nGcd           = naGcd;
92  n->nLcm           = naLcm;
93  n->cfSetMap       = naSetMap;
94  n->nName          = naName;
95  n->nSize          = naSize;
96  n->cfGetDenom     = napGetDenom;
97  n->cfGetNumerator = napGetNumerator;
98#ifdef LDEBUG
99  n->nDBTest        = naDBTest;
100#endif
101  /* re-defining global function pointers */
102  nNormalize=naNormalize;
103  nPar   = naPar;
104  nParDeg= nParDeg;
105  n_Int  = naInt;
106  nAdd   = naAdd;
107  nSub   = naSub;
108  nMult  = naMult;
109  nDiv   = naDiv;
110  nExactDiv= naDiv;
111  nIntDiv= naIntDiv;
112  nNeg   = naNeg;
113  nInvers= naInvers;
114  nCopy  = naCopy;
115  nGreater = naGreater;
116  nEqual = naEqual;
117  nIsZero = naIsZero;
118  nIsOne = naIsOne;
119  nIsMOne = naIsMOne;
120  nGreaterZero = naGreaterZero;
121  nGreater = naGreater;
122  nRead = naRead;
123  nPower = naPower;
124  nGcd  = naGcd;
125  nLcm  = naLcm;
126  nName= naName;
127  nSize  = naSize;
128}
129
130static number nadGcd( number a, number b, const ring r) { return nacInit(1,r); }
131/*2
132*  sets the appropriate operators
133*/
134void naSetChar(int i, ring r)
135{
136  if (naI!=NULL)
137  {
138    int j;
139    for (j=naI->anz-1; j>=0; j--)
140       p_Delete (&naI->liste[j],nacRing);
141    omFreeSize((void *)naI->liste,naI->anz*sizeof(poly));
142    omFreeBin((void *)naI, snaIdeal_bin);
143    naI=NULL;
144  }
145  naMap = naCopy;
146
147  if (r->minpoly!=NULL)
148  {
149    naMinimalPoly=((lnumber)r->minpoly)->z;
150    #ifdef LDEBUG
151    omCheckAddr(naMinimalPoly);
152    #endif
153  }
154  else
155    naMinimalPoly = NULL;
156  if (r->minideal!=NULL)
157  {
158    naI=(naIdeal)omAllocBin(snaIdeal_bin);
159    naI->anz=IDELEMS(r->minideal);
160    naI->liste=(poly*)omAlloc(naI->anz*sizeof(poly));
161    int j;
162    for (j=naI->anz-1; j>=0; j--)
163    {
164      lnumber a = (lnumber)pGetCoeff(r->minideal->m[j]);
165      naI->liste[j]=napCopy(a->z);
166    }
167  }
168
169  naNumbOfPar=rPar(r);
170  if (i == 1)
171  {
172    naIsChar0 = 1;
173  }
174  else if (i < 0)
175  {
176    naIsChar0 = 0;
177    npSetChar(-i, r->algring); // to be changed HS
178  }
179#ifdef TEST
180  else
181  {
182    Print("naSetChar:c=%d param=%d\n",i,rPar(r));
183  }
184#endif
185  nacRing        = r->algring;
186  nacInit        = nacRing->cf->cfInit;
187  nacInt         = nacRing->cf->n_Int;
188  nacCopy        = nacRing->cf->nCopy;
189  nacAdd         = nacRing->cf->nAdd;
190  nacSub         = nacRing->cf->nSub;
191  nacNormalize   = nacRing->cf->nNormalize;
192  nacNeg         = nacRing->cf->nNeg;
193  nacIsZero      = nacRing->cf->nIsZero;
194  nacRead        = nacRing->cf->nRead;
195  nacGreaterZero = nacRing->cf->nGreaterZero;
196  nacIsOne       = nacRing->cf->nIsOne;
197  nacIsMOne      = nacRing->cf->nIsMOne;
198  nacGcd         = nacRing->cf->nGcd;
199  nacLcm         = nacRing->cf->nLcm;
200  nacMult        = nacRing->cf->nMult;
201  nacDiv         = nacRing->cf->nDiv;
202  nacIntDiv      = nacRing->cf->nIntDiv;
203  nacInvers      = nacRing->cf->nInvers;
204  nacDelete      = nacRing->cf->cfDelete;
205}
206
207/*============= procedure for polynomials: napXXXX =======================*/
208
209
210
211#ifdef LDEBUG
212static void napTest(napoly p)
213{
214  while (p != NULL)
215  {
216    if (naIsChar0)
217      nlDBTest(pGetCoeff(p), "", 0);
218    pIter(p);
219  }
220}
221#else
222#define napTest(p) ((void) 0)
223#endif
224
225#define napSetCoeff(p,n) {n_Delete(&pGetCoeff(p),nacRing);pGetCoeff(p)=n;}
226#define napComp(p,q)     p_LmCmp((poly)p,(poly)q, nacRing)
227#define napMultT(A,E)    A=(napoly)p_Mult_mm((poly)A,(poly)E,nacRing)
228#define napDeg(p)        (int)p_Totaldegree(p, nacRing)
229
230/*3
231* creates  an napoly
232*/
233napoly napInitz(number z)
234{
235  napoly a = (napoly)p_Init(nacRing);
236  pGetCoeff(a) = z;
237  return a;
238}
239
240/*3
241* copy a napoly. poly
242*/
243static napoly napCopyNeg(napoly p)
244{
245  napoly r=napCopy(p);
246  r=(napoly)p_Neg((poly)r, nacRing);
247  return r;
248}
249
250/*3
251* returns ph * z
252*/
253static void napMultN(napoly p, number z)
254{
255  number t;
256
257  while (p!=NULL)
258  {
259    t = nacMult(pGetCoeff(p), z);
260    nacNormalize(t);
261    n_Delete(&pGetCoeff(p),nacRing);
262    pGetCoeff(p) = t;
263    pIter(p);
264  }
265}
266
267/*3
268*  division with rest; f = g*q + r, returns r and destroy f
269*/
270napoly napRemainder(napoly f, const napoly  g)
271{
272  napoly a, h, qq;
273
274  qq = (napoly)p_Init(nacRing);
275  pNext(qq) = NULL;
276  p_Normalize(g, nacRing);
277  p_Normalize(f, nacRing);
278  a = f;
279  do
280  {
281    napSetExp(qq,1, p_GetExp(a,1,nacRing) - p_GetExp(g,1,nacRing));
282    napSetm(qq);
283    pGetCoeff(qq) = nacDiv(pGetCoeff(a), pGetCoeff(g));
284    pGetCoeff(qq) = nacNeg(pGetCoeff(qq));
285    nacNormalize(pGetCoeff(qq));
286    h = napCopy(g);
287    napMultT(h, qq);
288    p_Normalize(h,nacRing);
289    n_Delete(&pGetCoeff(qq),nacRing);
290    a = napAdd(a, h);
291  }
292  while ((a!=NULL) && (p_GetExp(a,1,nacRing) >= p_GetExp(g,1,nacRing)));
293  omFreeBinAddr(qq);
294  return a;
295}
296
297/*3
298*  division with rest; f = g*q + r,  destroy f
299*/
300static void napDivMod(napoly f, napoly  g, napoly *q, napoly *r)
301{
302  napoly a, h, b, qq;
303
304  qq = (napoly)p_Init(nacRing);
305  pNext(qq) = b = NULL;
306  p_Normalize(g,nacRing);
307  p_Normalize(f,nacRing);
308  a = f;
309  do
310  {
311    napSetExp(qq,1, p_GetExp(a,1,nacRing) - p_GetExp(g,1,nacRing));
312    p_Setm(qq,nacRing);
313    pGetCoeff(qq) = nacDiv(pGetCoeff(a), pGetCoeff(g));
314    nacNormalize(pGetCoeff(qq));
315    b = napAdd(b, napCopy(qq));
316    pGetCoeff(qq) = nacNeg(pGetCoeff(qq));
317    h = napCopy(g);
318    napMultT(h, qq);
319    p_Normalize(h,nacRing);
320    n_Delete(&pGetCoeff(qq),nacRing);
321    a = napAdd(a, h);
322  }
323  while ((a!=NULL) && (p_GetExp(a,1,nacRing) >= p_GetExp(g,1,nacRing)));
324  omFreeBinAddr(qq);
325  *q = b;
326  *r = a;
327}
328
329/*3
330*  returns z with z*x mod c = 1
331*/
332static napoly napInvers(napoly x, const napoly c)
333{
334  napoly y, r, qa, qn, q;
335  number t, h;
336
337  if (p_GetExp(x,1,nacRing) >= p_GetExp(c,1,nacRing))
338    x = napRemainder(x, c);
339  if (x==NULL)
340  {
341    goto zero_divisor;
342  }
343  if (p_GetExp(x,1,nacRing)==0)
344  {
345    if (!nacIsOne(pGetCoeff(x)))
346    {
347      nacNormalize(pGetCoeff(x));
348      t = nacInvers(pGetCoeff(x));
349      nacNormalize(t);
350      n_Delete(&pGetCoeff(x),nacRing);
351      pGetCoeff(x) = t;
352    }
353    return x;
354  }
355  y = napCopy(c);
356  napDivMod(y, x, &qa, &r);
357  if (r==NULL)
358  {
359    goto zero_divisor;
360  }
361  if (p_GetExp(r,1,nacRing)==0)
362  {
363    nacNormalize(pGetCoeff(r));
364    t = nacInvers(pGetCoeff(r));
365    nacNormalize(t);
366    t = nacNeg(t);
367    napMultN(qa, t);
368    n_Delete(&t,nacRing);
369    p_Normalize(qa,nacRing);
370    p_Delete(&x,nacRing);
371    p_Delete(&r,nacRing);
372    return qa;
373  }
374  y = x;
375  x = r;
376  napDivMod(y, x, &q, &r);
377  if (r==NULL)
378  {
379    goto zero_divisor;
380  }
381  if (p_GetExp(r,1,nacRing)==0)
382  {
383    q = p_Mult_q(q, qa,nacRing);
384    q = napAdd(q, p_ISet(1,nacRing));
385    nacNormalize(pGetCoeff(r));
386    t = nacInvers(pGetCoeff(r));
387    napMultN(q, t);
388    p_Normalize(q,nacRing);
389    n_Delete(&t,nacRing);
390    p_Delete(&x,nacRing);
391    p_Delete(&r,nacRing);
392    if (p_GetExp(q,1,nacRing) >= p_GetExp(c,1,nacRing))
393      q = napRemainder(q, c);
394    return q;
395  }
396  q = p_Mult_q(q, napCopy(qa),nacRing);
397  q = napAdd(q, p_ISet(1,nacRing));
398  qa = napNeg(qa);
399  loop
400  {
401    y = x;
402    x = r;
403    napDivMod(y, x, &qn, &r);
404    if (r==NULL)
405    {
406      break;
407    }
408    if (p_GetExp(r,1,nacRing)==0)
409    {
410      q = p_Mult_q(q, qn,nacRing);
411      q = napNeg(q);
412      q = napAdd(q, qa);
413      nacNormalize(pGetCoeff(r));
414      t = nacInvers(pGetCoeff(r));
415      //nacNormalize(t);
416      napMultN(q, t);
417      p_Normalize(q,nacRing);
418      n_Delete(&t,nacRing);
419      p_Delete(&x,nacRing);
420      p_Delete(&r,nacRing);
421      if (p_GetExp(q,1,nacRing) >= p_GetExp(c,1,nacRing))
422        q = napRemainder(q, c);
423      return q;
424    }
425    y = q;
426    q = p_Mult_q(napCopy(q), qn, nacRing);
427    q = napNeg(q);
428    q = napAdd(q, qa);
429    qa = y;
430  }
431// zero divisor found:
432zero_divisor:
433  Werror("zero divisor found - your minpoly is not irreducible");
434  return x;
435}
436
437/*3
438* the max degree of an napoly poly (used for test of "simple" et al.)
439*/
440static int  napMaxDeg(napoly p)
441{
442  int  d = 0;
443  while(p!=NULL)
444  {
445    d=si_max(d,napDeg(p));
446    pIter(p);
447  }
448  return d;
449}
450
451/*3
452* the max degree of an napoly poly (used for test of "simple" et al.)
453*/
454static int  napMaxDegLen(napoly p, int &l)
455{
456  int  d = 0;
457  int ll=0;
458  while(p!=NULL)
459  {
460    d=si_max(d,napDeg(p));
461    pIter(p);
462    ll++;
463  }
464  l=ll;
465  return d;
466}
467
468
469/*3
470*writes a polynomial number
471*/
472void napWrite(napoly p,const BOOLEAN has_denom, const ring r)
473{
474  ring nacring=r->algring;
475  if (p==NULL)
476    StringAppendS("0");
477  else if (p_LmIsConstant(p,nacring))
478  {
479    BOOLEAN kl=FALSE;
480    if (has_denom)
481    {
482      number den=nacring->cf->cfGetDenom(pGetCoeff(p),nacring );
483      kl=!n_IsOne(den,nacring);
484      n_Delete(&den, nacring);
485    }
486    if (kl) StringAppendS("(");
487    //StringAppendS("-1");
488    n_Write(pGetCoeff(p),nacring);
489    if (kl) StringAppendS(")");
490  }
491  else
492  {
493    StringAppendS("(");
494    loop
495    {
496      BOOLEAN wroteCoeff=FALSE;
497      if ((p_LmIsConstant(p,nacring))
498      || ((!n_IsOne(pGetCoeff(p),nacring))
499        && (!n_IsMOne(pGetCoeff(p),nacring))))
500      {
501        n_Write(pGetCoeff(p),nacring);
502        wroteCoeff=(r->ShortOut==0);
503      }
504      else if (n_IsMOne(pGetCoeff(p),nacring))
505      {
506        StringAppendS("-");
507      }
508      int  i;
509      for (i = 0; i < r->P; i++)
510      {
511        int e=p_GetExp(p,i+1,nacring);
512        if (e > 0)
513        {
514          if (wroteCoeff)
515            StringAppendS("*");
516          else
517            wroteCoeff=(r->ShortOut==0);
518          StringAppendS(r->parameter[i]);
519          if (e > 1)
520          {
521            if (r->ShortOut == 0)
522              StringAppendS("^");
523            StringAppend("%d", e);
524          }
525        }
526      } /*for*/
527      pIter(p);
528      if (p==NULL)
529        break;
530      if (n_GreaterZero(pGetCoeff(p),nacring))
531        StringAppendS("+");
532    }
533    StringAppendS(")");
534  }
535}
536
537
538static const char *napHandleMons(const char *s, int i, napoly ex)
539{
540  int  j;
541  if (strncmp(s,naParNames[i],strlen(naParNames[i]))==0)
542  {
543    s+=strlen(naParNames[i]);
544    if ((*s >= '0') && (*s <= '9'))
545    {
546      s = eati(s, &j);
547      napAddExp(ex,i+1,j);
548    }
549    else
550      napAddExp(ex,i+1,1);
551  }
552  return s;
553}
554static const char *napHandlePars(const char *s, int i, napoly ex)
555{
556  int  j;
557  if (strcmp(s,naParNames[i])==0)
558  {
559    s+=strlen(naParNames[i]);
560    napSetExp(ex,i+1,1);
561  }
562  return s;
563}
564
565/*3  reads a monomial  */
566static const char  *napRead(const char *s, napoly *b)
567{
568  napoly a;
569  int  i;
570  a = (napoly)p_Init(nacRing);
571  if ((*s >= '0') && (*s <= '9'))
572  {
573    s = nacRead(s, &pGetCoeff(a));
574    if (nacIsZero(pGetCoeff(a)))
575    {
576      p_LmDelete(&a,nacRing);
577      *b = NULL;
578      return s;
579    }
580  }
581  else
582    pGetCoeff(a) = nacInit(1,nacRing);
583  i = 0;
584  const char  *olds=s;
585  loop
586  {
587    s = napHandlePars(s, i, a);
588    if (olds == s)
589      i++;
590    else if (*s == '\0')
591    {
592      *b = a;
593      return s;
594    }
595    if (i >= naNumbOfPar)
596      break;
597  }
598  i=0;
599  loop
600  {
601    olds = s;
602    s = napHandleMons(s, i, a);
603    if (olds == s)
604      i++;
605    else
606      i = 0;
607    if ((*s == '\0') || (i >= naNumbOfPar))
608      break;
609  }
610  *b = a;
611  return s;
612}
613
614static int napExp(napoly a, napoly b)
615{
616  while (pNext(a)!=NULL) pIter(a);
617  int m = p_GetExp(a,1,nacRing);
618  if (m==0) return 0;
619  while (pNext(b)!=NULL) pIter(b);
620  int mm=p_GetExp(b,1,nacRing);
621  if (m > mm) m = mm;
622  return m;
623}
624
625/*
626* finds the smallest i-th exponent in a and b
627* used to find it in a fraction
628*/
629static int napExpi(int i, napoly a, napoly b)
630{
631  if (a==NULL || b==NULL) return 0;
632  int m = p_GetExp(a,i+1,nacRing);
633  if (m==0) return 0;
634  while (pNext(a) != NULL)
635  {
636    pIter(a);
637    if (m > p_GetExp(a,i+1,nacRing))
638    {
639      m = p_GetExp(a,i+1,nacRing);
640      if (m==0) return 0;
641    }
642  }
643  do
644  {
645    if (m > p_GetExp(b,i+1,nacRing))
646    {
647      m = p_GetExp(b,i+1,nacRing);
648      if (m==0) return 0;
649    }
650    pIter(b);
651  }
652  while (b != NULL);
653  return m;
654}
655
656static void napContent(napoly ph)
657{
658  number h,d;
659  napoly p;
660
661  p = ph;
662  if (nacIsOne(pGetCoeff(p)))
663    return;
664  h = nacCopy(pGetCoeff(p));
665  pIter(p);
666  do
667  {
668    d=nacGcd(pGetCoeff(p), h, nacRing);
669    if(nacIsOne(d))
670    {
671      n_Delete(&h,nacRing);
672      n_Delete(&d,nacRing);
673      return;
674    }
675    n_Delete(&h,nacRing);
676    h = d;
677    pIter(p);
678  }
679  while (p!=NULL);
680  h = nacInvers(d);
681  n_Delete(&d,nacRing);
682  p = ph;
683  while (p!=NULL)
684  {
685    d = nacMult(pGetCoeff(p), h);
686    n_Delete(&pGetCoeff(p),nacRing);
687    pGetCoeff(p) = d;
688    pIter(p);
689  }
690  n_Delete(&h,nacRing);
691}
692
693static void napCleardenom(napoly ph)
694{
695  number d, h;
696  napoly p;
697
698  if (!naIsChar0)
699    return;
700  p = ph;
701  h = nacInit(1,nacRing);
702  while (p!=NULL)
703  {
704    d = nacLcm(h, pGetCoeff(p), nacRing);
705    n_Delete(&h,nacRing);
706    h = d;
707    pIter(p);
708  }
709  if(!nacIsOne(h))
710  {
711    p = ph;
712    while (p!=NULL)
713    {
714      d=nacMult(h, pGetCoeff(p));
715      n_Delete(&pGetCoeff(p),nacRing);
716      nacNormalize(d);
717      pGetCoeff(p) = d;
718      pIter(p);
719    }
720    n_Delete(&h,nacRing);
721  }
722  napContent(ph);
723}
724
725static napoly napGcd0(napoly a, napoly b)
726{
727  number x, y;
728  if (!naIsChar0)
729    return p_ISet(1,nacRing);
730  x = nacCopy(pGetCoeff(a));
731  if (nacIsOne(x))
732    return napInitz(x);
733  while (pNext(a)!=NULL)
734  {
735    pIter(a);
736    y = nacGcd(x, pGetCoeff(a), nacRing);
737    n_Delete(&x,nacRing);
738    x = y;
739    if (nacIsOne(x))
740      return napInitz(x);
741  }
742  do
743  {
744    y = nacGcd(x, pGetCoeff(b), nacRing);
745    n_Delete(&x,nacRing);
746    x = y;
747    if (nacIsOne(x))
748      return napInitz(x);
749    pIter(b);
750  }
751  while (b!=NULL);
752  return napInitz(x);
753}
754
755/*3
756* result =gcd(a,b)
757*/
758static napoly napGcd(napoly a, napoly b)
759{
760  int i;
761  napoly g, x, y, h;
762  if ((a==NULL)
763  || ((pNext(a)==NULL)&&(nacIsZero(pGetCoeff(a)))))
764  {
765    if ((b==NULL)
766    || ((pNext(b)==NULL)&&(nacIsZero(pGetCoeff(b)))))
767    {
768      return p_ISet(1,nacRing);
769    }
770    return napCopy(b);
771  }
772  else
773  if ((b==NULL)
774  || ((pNext(b)==NULL)&&(nacIsZero(pGetCoeff(b)))))
775  {
776    return napCopy(a);
777  }
778  if (naMinimalPoly != NULL)
779  {
780    if (p_GetExp(a,1,nacRing) >= p_GetExp(b,1,nacRing))
781    {
782      x = a;
783      y = b;
784    }
785    else
786    {
787      x = b;
788      y = a;
789    }
790    if (!naIsChar0) g = p_ISet(1,nacRing);
791    else            g = napGcd0(x, y);
792    if (pNext(y)==NULL)
793    {
794      napSetExp(g,1, napExp(x, y));
795      p_Setm(g,nacRing);
796      return g;
797    }
798    x = napCopy(x);
799    y = napCopy(y);
800    loop
801    {
802      h = napRemainder(x, y);
803      if (h==NULL)
804      {
805        napCleardenom(y);
806        if (!nacIsOne(pGetCoeff(g)))
807          napMultN(y, pGetCoeff(g));
808        p_LmDelete(&g,nacRing);
809        return y;
810      }
811      else if (pNext(h)==NULL)
812        break;
813      x = y;
814      y = h;
815    }
816    p_Delete(&y,nacRing);
817    p_LmDelete(&h,nacRing);
818    napSetExp(g,1, napExp(a, b));
819    p_Setm(g,nacRing);
820    return g;
821  }
822  // Hmm ... this is a memory leak
823  // x = (napoly)p_Init(nacRing);
824  g=a;
825  h=b;
826  if (!naIsChar0) x = p_ISet(1,nacRing);
827  else            x = napGcd0(g,h);
828  for (i=(naNumbOfPar-1); i>=0; i--)
829  {
830    napSetExp(x,i+1, napExpi(i,a,b));
831    p_Setm(x,nacRing);
832  }
833  return x;
834}
835
836
837number napLcm(napoly a)
838{
839  number h = nacInit(1,nacRing);
840
841  if (naIsChar0)
842  {
843    number d;
844    napoly b = a;
845
846    while (b!=NULL)
847    {
848      d = nacLcm(h, pGetCoeff(b), nacRing);
849      n_Delete(&h,nacRing);
850      h = d;
851      pIter(b);
852    }
853  }
854  return h;
855}
856
857
858/*2
859* meins  (for reduction in algebraic extension)
860* checks if head of p divides head of q
861* doesn't delete p and q
862*/
863static BOOLEAN napDivPoly (napoly p, napoly q)
864{
865  int j=1;   /* evtl. von naNumber.. -1 abwaerts zaehlen */
866
867  while (p_GetExp(p,j,nacRing) <= p_GetExp(q,j,nacRing))
868  {
869    j++;
870    if (j > naNumbOfPar)
871      return 1;
872  }
873  return 0;
874}
875
876
877/*2
878* meins  (for reduction in algebraic extension)
879* Normalform of poly with naI
880* changes q and returns it
881*/
882napoly napRedp (napoly q)
883{
884  napoly h = (napoly)p_Init(nacRing);
885  int i=0,j;
886
887  loop
888  {
889    if (napDivPoly (naI->liste[i], q))
890    {
891      /* h = lt(q)/lt(naI->liste[i])*/
892      pGetCoeff(h) = nacCopy(pGetCoeff(q));
893      for (j=naNumbOfPar; j>0; j--)
894        napSetExp(h,j, p_GetExp(q,j,nacRing) - p_GetExp(naI->liste[i],j,nacRing));
895      p_Setm(h,nacRing);
896      h = p_Mult_q(h, napCopy(naI->liste[i]),nacRing);
897      h = napNeg (h);
898      q = napAdd (q, napCopy(h));
899      p_Delete (&pNext(h),nacRing);
900      if (q == NULL)
901      {
902        p_Delete(&h,nacRing);
903        return q;
904      }
905      /* try to reduce further */
906      i = 0;
907    }
908    else
909    {
910      i++;
911      if (i >= naI->anz)
912      {
913        p_Delete(&h,nacRing);
914        return q;
915      }
916    }
917  }
918}
919
920
921/*2
922* meins  (for reduction in algebraic extension)
923* reduces the tail of Poly q
924* needs q != NULL
925* changes q and returns it
926*/
927napoly napTailred (napoly q)
928{
929  napoly h;
930
931  h = pNext(q);
932  while (h != NULL)
933  {
934     h = napRedp (h);
935     if (h == NULL)
936        return q;
937     pIter(h);
938  }
939  return q;
940}
941
942
943/*================ procedure for rational functions: naXXXX =================*/
944
945/*2
946*  z:= i
947*/
948number naInit(int i, const ring r)
949{
950  if (i!=0)
951  {
952    number c=n_Init(i,r->algring);
953    if (!n_IsZero(c,r->algring))
954    {
955      poly z=p_Init(r->algring);
956      pSetCoeff0(z,c);
957      lnumber l = (lnumber)omAllocBin(rnumber_bin);
958      l->z = z;
959      l->s = 2;
960      l->n = NULL;
961      return (number)l;
962    }
963  }
964  /*else*/
965  return NULL;
966}
967
968number  naPar(int i)
969{
970  lnumber l = (lnumber)omAllocBin(rnumber_bin);
971  l->s = 2;
972  l->z = p_ISet(1,nacRing);
973  napSetExp(l->z,i,1);
974  p_Setm(l->z,nacRing);
975  l->n = NULL;
976  return (number)l;
977}
978
979int     naParDeg(number n)     /* i := deg(n) */
980{
981  lnumber l = (lnumber)n;
982  if (l==NULL) return -1;
983  return napDeg(l->z);
984}
985
986//int     naParDeg(number n)     /* i := deg(n) */
987//{
988//  lnumber l = (lnumber)n;
989//  if (l==NULL) return -1;
990//  return napMaxDeg(l->z)+napMaxDeg(l->n);
991//}
992
993int     naSize(number n)     /* size desc. */
994{
995  lnumber l = (lnumber)n;
996  if (l==NULL) return -1;
997  int len_z;
998  int len_n;
999  int o=napMaxDegLen(l->z,len_z)+napMaxDegLen(l->n,len_n);
1000  return (len_z+len_n)+o;
1001}
1002
1003/*2
1004* convert a number to int (if possible)
1005*/
1006int naInt(number &n, const ring r)
1007{
1008  lnumber l=(lnumber)n;
1009  if ((l!=NULL)&&(l->n==NULL)&&(p_IsConstant(l->z,r->algring)))
1010  {
1011    return nacInt(pGetCoeff(l->z),r->algring);
1012  }
1013  return 0;
1014}
1015
1016/*2
1017*  deletes p
1018*/
1019void naDelete(number *p, const ring r)
1020{
1021  if ((*p)!=r->minpoly)
1022  {
1023    lnumber l = (lnumber) * p;
1024    if (l==NULL) return;
1025    p_Delete(&(l->z),r->algring);
1026    p_Delete(&(l->n),r->algring);
1027    omFreeBin((void *)l,  rnumber_bin);
1028  }
1029  *p = NULL;
1030}
1031
1032/*2
1033* copy p to erg
1034*/
1035number naCopy(number p)
1036{
1037  if (p==NULL) return NULL;
1038  naTest(p);
1039  lnumber erg;
1040  lnumber src = (lnumber)p;
1041  erg = (lnumber)omAlloc0Bin(rnumber_bin);
1042  erg->z = p_Copy(src->z, nacRing);
1043  erg->n = p_Copy(src->n, nacRing);
1044  erg->s = src->s;
1045  return (number)erg;
1046}
1047number na_Copy(number p, const ring r)
1048{
1049  if (p==NULL) return NULL;
1050  lnumber erg;
1051  lnumber src = (lnumber)p;
1052  erg = (lnumber)omAlloc0Bin(rnumber_bin);
1053  erg->z = p_Copy(src->z,r->algring);
1054  erg->n = p_Copy(src->n,r->algring);
1055  erg->s = src->s;
1056  return (number)erg;
1057}
1058
1059/*2
1060*  addition; lu:= la + lb
1061*/
1062number naAdd(number la, number lb)
1063{
1064  if (la==NULL) return naCopy(lb);
1065  if (lb==NULL) return naCopy(la);
1066
1067  poly x, y;
1068  lnumber lu;
1069  lnumber a = (lnumber)la;
1070  lnumber b = (lnumber)lb;
1071  #ifdef LDEBUG
1072  omCheckAddrSize(a,sizeof(snumber));
1073  omCheckAddrSize(b,sizeof(snumber));
1074  #endif
1075  if (b->n!=NULL) x = pp_Mult_qq(a->z, b->n,nacRing);
1076  else            x = napCopy(a->z);
1077  if (a->n!=NULL) y = pp_Mult_qq(b->z, a->n,nacRing);
1078  else            y = napCopy(b->z);
1079  poly res = napAdd(x, y);
1080  if (res==NULL)
1081  {
1082    return (number)NULL;
1083  }
1084  lu = (lnumber)omAllocBin(rnumber_bin);
1085  lu->z=res;
1086  if (a->n!=NULL)
1087  {
1088    if (b->n!=NULL) x = pp_Mult_qq(a->n, b->n,nacRing);
1089    else            x = napCopy(a->n);
1090  }
1091  else
1092  {
1093    if (b->n!=NULL) x = napCopy(b->n);
1094    else            x = NULL;
1095  }
1096  //if (x!=NULL)
1097  //{
1098  //  if (p_LmIsConstant(x,nacRing))
1099  //  {
1100  //    number inv=nacInvers(pGetCoeff(x));
1101  //    napMultN(lu->z,inv);
1102  //    n_Delete(&inv,nacRing);
1103  //    napDelete(&x);
1104  //  }
1105  //}
1106  lu->n = x;
1107  lu->s = FALSE;
1108  if (/*lu->n*/ x!=NULL)
1109  {
1110     number luu=(number)lu;
1111     //if (p_IsConstant(lu->n,nacRing)) naCoefNormalize(luu);
1112     //else
1113                naNormalize(luu);
1114     lu=(lnumber)luu;
1115  }
1116  //else lu->s=2;
1117  naTest((number)lu);
1118  return (number)lu;
1119}
1120
1121/*2
1122*  subtraction; r:= la - lb
1123*/
1124number naSub(number la, number lb)
1125{
1126  lnumber lu;
1127
1128  if (lb==NULL) return naCopy(la);
1129  if (la==NULL)
1130  {
1131    lu = (lnumber)naCopy(lb);
1132    lu->z = napNeg(lu->z);
1133    return (number)lu;
1134  }
1135
1136  lnumber a = (lnumber)la;
1137  lnumber b = (lnumber)lb;
1138
1139  #ifdef LDEBUG
1140  omCheckAddrSize(a,sizeof(snumber));
1141  omCheckAddrSize(b,sizeof(snumber));
1142  #endif
1143
1144  poly x, y;
1145  if (b->n!=NULL) x = pp_Mult_qq(a->z, b->n,nacRing);
1146  else            x = napCopy(a->z);
1147  if (a->n!=NULL) y = p_Mult_q(napCopy(b->z), napCopyNeg(a->n),nacRing);
1148  else            y = napCopyNeg(b->z);
1149  poly res = napAdd(x, y);
1150  if (res==NULL)
1151  {
1152    return (number)NULL;
1153  }
1154  lu = (lnumber)omAllocBin(rnumber_bin);
1155  lu->z=res;
1156  if (a->n!=NULL)
1157  {
1158    if (b->n!=NULL) x = pp_Mult_qq(a->n, b->n,nacRing);
1159    else            x = napCopy(a->n);
1160  }
1161  else
1162  {
1163    if (b->n!=NULL) x = napCopy(b->n);
1164    else            x = NULL;
1165  }
1166  lu->n = x;
1167  lu->s = FALSE;
1168  if (/*lu->n*/ x!=NULL)
1169  {
1170     number luu=(number)lu;
1171     //if (p_IsConstant(lu->n,nacRing)) naCoefNormalize(luu);
1172     //else
1173                         naNormalize(luu);
1174     lu=(lnumber)luu;
1175  }
1176  //else lu->s=2;
1177  naTest((number)lu);
1178  return (number)lu;
1179}
1180
1181/*2
1182*  multiplication; r:= la * lb
1183*/
1184number naMult(number la, number lb)
1185{
1186  if ((la==NULL) || (lb==NULL))
1187    return NULL;
1188
1189  lnumber a = (lnumber)la;
1190  lnumber b = (lnumber)lb;
1191  lnumber lo;
1192  poly x;
1193
1194  #ifdef LDEBUG
1195  omCheckAddrSize(a,sizeof(snumber));
1196  omCheckAddrSize(b,sizeof(snumber));
1197  #endif
1198  naTest(la);
1199  naTest(lb);
1200
1201  lo = (lnumber)omAllocBin(rnumber_bin);
1202  lo->z = pp_Mult_qq(a->z, b->z,nacRing);
1203
1204  if (a->n==NULL)
1205  {
1206    if (b->n==NULL)
1207      x = NULL;
1208    else
1209      x = napCopy(b->n);
1210  }
1211  else
1212  {
1213    if (b->n==NULL)
1214    {
1215      x = napCopy(a->n);
1216    }
1217    else
1218    {
1219      x = pp_Mult_qq(b->n, a->n, nacRing);
1220    }
1221  }
1222  if (naMinimalPoly!=NULL)
1223  {
1224    if (p_GetExp(lo->z,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing))
1225      lo->z = napRemainder(lo->z, naMinimalPoly);
1226    if ((x!=NULL) && (p_GetExp(x,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing)))
1227      x = napRemainder(x, naMinimalPoly);
1228  }
1229  if (naI!=NULL)
1230  {
1231    lo->z = napRedp (lo->z);
1232    if (lo->z != NULL)
1233       lo->z = napTailred (lo->z);
1234    if (x!=NULL)
1235    {
1236      x = napRedp (x);
1237      if (x!=NULL)
1238        x = napTailred (x);
1239    }
1240  }
1241  if ((x!=NULL) && (p_LmIsConstant(x,nacRing)) && nacIsOne(pGetCoeff(x)))
1242    p_Delete(&x,nacRing);
1243  lo->n = x;
1244  lo->s = 0;
1245  if(lo->z==NULL)
1246  {
1247    omFreeBin((void *)lo, rnumber_bin);
1248    lo=NULL;
1249  }
1250  else if (lo->n!=NULL)
1251  {
1252    number luu=(number)lo;
1253    // if (p_IsConstant(lo->n,nacRing)) naCoefNormalize(luu);
1254    // else
1255                      naNormalize(luu);
1256    lo=(lnumber)luu;
1257  }
1258  //if (naMinimalPoly==NULL) lo->s=2;
1259  naTest((number)lo);
1260  return (number)lo;
1261}
1262
1263number naIntDiv(number la, number lb)
1264{
1265  lnumber res;
1266  lnumber a = (lnumber)la;
1267  lnumber b = (lnumber)lb;
1268  if (a==NULL)
1269  {
1270    return NULL;
1271  }
1272  if (b==NULL)
1273  {
1274    WerrorS(nDivBy0);
1275    return NULL;
1276  }
1277  assume(a->z!=NULL && b->z!=NULL);
1278  assume(a->n==NULL && b->n==NULL);
1279  res = (lnumber)omAllocBin(rnumber_bin);
1280  res->z = napCopy(a->z);
1281  res->n = napCopy(b->z);
1282  res->s = 0;
1283  number nres=(number)res;
1284  naNormalize(nres);
1285
1286  //napDelete(&res->n);
1287  naTest(nres);
1288  return nres;
1289}
1290
1291/*2
1292*  division; lo:= la / lb
1293*/
1294number naDiv(number la, number lb)
1295{
1296  lnumber lo;
1297  lnumber a = (lnumber)la;
1298  lnumber b = (lnumber)lb;
1299  poly x;
1300
1301  if (a==NULL)
1302    return NULL;
1303
1304  if (b==NULL)
1305  {
1306    WerrorS(nDivBy0);
1307    return NULL;
1308  }
1309  #ifdef LDEBUG
1310  omCheckAddrSize(a,sizeof(snumber));
1311  omCheckAddrSize(b,sizeof(snumber));
1312  #endif
1313  lo = (lnumber)omAllocBin(rnumber_bin);
1314  if (b->n!=NULL)
1315    lo->z = pp_Mult_qq(a->z, b->n,nacRing);
1316  else
1317    lo->z = napCopy(a->z);
1318  if (a->n!=NULL)
1319    x = pp_Mult_qq(b->z, a->n, nacRing);
1320  else
1321    x = napCopy(b->z);
1322  if (naMinimalPoly!=NULL)
1323  {
1324    if (p_GetExp(lo->z,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing))
1325      lo->z = napRemainder(lo->z, naMinimalPoly);
1326    if (p_GetExp(x,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing))
1327      x = napRemainder(x, naMinimalPoly);
1328  }
1329  if (naI!=NULL)
1330  {
1331    lo->z = napRedp (lo->z);
1332    if (lo->z != NULL)
1333       lo->z = napTailred (lo->z);
1334    if (x!=NULL)
1335    {
1336      x = napRedp (x);
1337      if (x!=NULL)
1338        x = napTailred (x);
1339    }
1340  }
1341  if ((p_LmIsConstant(x,nacRing)) && nacIsOne(pGetCoeff(x)))
1342    p_Delete(&x,nacRing);
1343  lo->n = x;
1344  lo->s = 0;
1345  if (lo->n!=NULL)
1346  {
1347    number luu=(number)lo;
1348     //if (p_IsConstant(lo->n,nacRing)) naCoefNormalize(luu);
1349     //else
1350                         naNormalize(luu);
1351    lo=(lnumber)luu;
1352  }
1353  //else lo->s=2;
1354  naTest((number)lo);
1355  return (number)lo;
1356}
1357
1358/*2
1359*  za:= - za, inplace
1360*/
1361number naNeg(number za)
1362{
1363  if (za!=NULL)
1364  {
1365    lnumber e = (lnumber)za;
1366    naTest(za);
1367    e->z = napNeg(e->z);
1368  }
1369  return za;
1370}
1371
1372/*2
1373* 1/a
1374*/
1375number naInvers(number a)
1376{
1377  lnumber lo;
1378  lnumber b = (lnumber)a;
1379  poly x;
1380
1381  if (b==NULL)
1382  {
1383    WerrorS(nDivBy0);
1384    return NULL;
1385  }
1386  #ifdef LDEBUG
1387  omCheckAddrSize(b,sizeof(snumber));
1388  #endif
1389  lo = (lnumber)omAlloc0Bin(rnumber_bin);
1390  lo->s = b->s;
1391  if (b->n!=NULL)
1392    lo->z = napCopy(b->n);
1393  else
1394    lo->z = p_ISet(1,nacRing);
1395  x = b->z;
1396  if ((!p_LmIsConstant(x,nacRing)) || !nacIsOne(pGetCoeff(x)))
1397    x = napCopy(x);
1398  else
1399  {
1400    lo->n = NULL;
1401    naTest((number)lo);
1402    return (number)lo;
1403  }
1404  if (naMinimalPoly!=NULL)
1405  {
1406    x = napInvers(x, naMinimalPoly);
1407    x = p_Mult_q(x, lo->z,nacRing);
1408    if (p_GetExp(x,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing))
1409      x = napRemainder(x, naMinimalPoly);
1410    lo->z = x;
1411    lo->n = NULL;
1412    while (x!=NULL)
1413    {
1414      nacNormalize(pGetCoeff(x));
1415      pIter(x);
1416    }
1417  }
1418  else
1419    lo->n = x;
1420  if (lo->n!=NULL)
1421  {
1422     number luu=(number)lo;
1423     //if (p_IsConstant(lo->n,nacRing)) naCoefNormalize(luu);
1424     //else
1425                           naNormalize(luu);
1426     lo=(lnumber)luu;
1427  }
1428  naTest((number)lo);
1429  return (number)lo;
1430}
1431
1432
1433BOOLEAN naIsZero(number za)
1434{
1435  lnumber zb = (lnumber)za;
1436  naTest(za);
1437#ifdef LDEBUG
1438  if ((zb!=NULL) && (zb->z==NULL)) WerrorS("internal zero error(2)");
1439#endif
1440  return (zb==NULL);
1441}
1442
1443
1444BOOLEAN naGreaterZero(number za)
1445{
1446  lnumber zb = (lnumber)za;
1447#ifdef LDEBUG
1448  if ((zb!=NULL) && (zb->z==NULL)) WerrorS("internal zero error(3)");
1449#endif
1450  naTest(za);
1451  if (zb!=NULL)
1452  {
1453    return (nacGreaterZero(pGetCoeff(zb->z))||(!p_LmIsConstant(zb->z,nacRing)));
1454  }
1455  /* else */ return FALSE;
1456}
1457
1458
1459/*2
1460* a = b ?
1461*/
1462BOOLEAN naEqual (number a, number b)
1463{
1464  if(a==b) return TRUE;
1465  if((a==NULL)&&(b!=NULL)) return FALSE;
1466  if((b==NULL)&&(a!=NULL)) return FALSE;
1467
1468  lnumber aa=(lnumber)a;
1469  lnumber bb=(lnumber)b;
1470
1471  int an_deg=0;
1472  if(aa->n!=NULL)
1473    an_deg=napDeg(aa->n);
1474  int bn_deg=0;
1475  if(bb->n!=NULL)
1476    bn_deg=napDeg(bb->n);
1477  if(an_deg+napDeg(bb->z)!=bn_deg+napDeg(aa->z))
1478    return FALSE;
1479#if 0
1480  naNormalize(a);
1481  aa=(lnumber)a;
1482  naNormalize(b);
1483  bb=(lnumber)b;
1484  if((aa->n==NULL)&&(bb->n!=NULL)) return FALSE;
1485  if((bb->n==NULL)&&(aa->n!=NULL)) return FALSE;
1486  if(napComp(aa->z,bb->z)!=0) return FALSE;
1487  if((aa->n!=NULL) && (napComp(aa->n,bb->n))) return FALSE;
1488#endif
1489  number h = naSub(a, b);
1490  BOOLEAN bo = naIsZero(h);
1491  naDelete(&h,currRing);
1492  return bo;
1493}
1494
1495
1496BOOLEAN naGreater (number a, number b)
1497{
1498  if (naIsZero(a))
1499    return FALSE;
1500  if (naIsZero(b))
1501    return TRUE; /* a!= 0)*/
1502  return napDeg(((lnumber)a)->z)>napDeg(((lnumber)b)->z);
1503}
1504
1505/*2
1506* reads a number
1507*/
1508const char  *naRead(const char *s, number *p)
1509{
1510  poly x;
1511  lnumber a;
1512  s = napRead(s, &x);
1513  if (x==NULL)
1514  {
1515    *p = NULL;
1516    return s;
1517  }
1518  *p = (number)omAlloc0Bin(rnumber_bin);
1519  a = (lnumber)*p;
1520  if ((naMinimalPoly!=NULL)
1521  && (p_GetExp(x,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing)))
1522    a->z = napRemainder(x, naMinimalPoly);
1523  else if (naI!=NULL)
1524  {
1525    a->z = napRedp(x);
1526    if (a->z != NULL)
1527      a->z = napTailred (a->z);
1528  }
1529  else
1530    a->z = x;
1531  if(a->z==NULL)
1532  {
1533    omFreeBin((void *)*p, rnumber_bin);
1534    *p=NULL;
1535  }
1536  else
1537  {
1538    a->n = NULL;
1539    a->s = 0;
1540    naTest(*p);
1541  }
1542  return s;
1543}
1544
1545/*2
1546* tries to convert a number to a name
1547*/
1548char * naName(number n)
1549{
1550  lnumber ph = (lnumber)n;
1551  if (ph==NULL)
1552    return NULL;
1553  int i;
1554  char *s=(char *)omAlloc(4* naNumbOfPar);
1555  char *t=(char *)omAlloc(8);
1556  s[0]='\0';
1557  for (i = 0; i <= naNumbOfPar - 1; i++)
1558  {
1559    int e=p_GetExp(ph->z,i+1,nacRing);
1560    if (e > 0)
1561    {
1562      if (e >1)
1563      {
1564        sprintf(t,"%s%d",naParNames[i],e);
1565        strcat(s,t);
1566      }
1567      else
1568      {
1569        strcat(s,naParNames[i]);
1570      }
1571    }
1572  }
1573  omFreeSize((void *)t,8);
1574  if (s[0]=='\0')
1575  {
1576    omFree((void *)s);
1577    return NULL;
1578  }
1579  return s;
1580}
1581
1582/*2
1583*  writes a number
1584*/
1585void naWrite(number &phn, const ring r)
1586{
1587  lnumber ph = (lnumber)phn;
1588  if (ph==NULL)
1589    StringAppendS("0");
1590  else
1591  {
1592    phn->s = 0;
1593    BOOLEAN has_denom=(ph->n!=NULL);
1594    napWrite(ph->z,has_denom/*(ph->n!=NULL)*/,r);
1595    if (has_denom/*(ph->n!=NULL)*/)
1596    {
1597      StringAppendS("/");
1598      napWrite(ph->n,TRUE,r);
1599    }
1600  }
1601}
1602
1603/*2
1604* za == 1 ?
1605*/
1606BOOLEAN naIsOne(number za)
1607{
1608  lnumber a = (lnumber)za;
1609  poly x, y;
1610  number t;
1611  if (a==NULL) return FALSE;
1612#ifdef LDEBUG
1613  omCheckAddrSize(a,sizeof(snumber));
1614  if (a->z==NULL)
1615  {
1616    WerrorS("internal zero error(4)");
1617    return FALSE;
1618  }
1619#endif
1620  if (a->n==NULL)
1621  {
1622    if (p_LmIsConstant(a->z,nacRing))
1623    {
1624      return nacIsOne(pGetCoeff(a->z));
1625    }
1626    else                 return FALSE;
1627  }
1628#if 0
1629  x = a->z;
1630  y = a->n;
1631  do
1632  {
1633    if (napComp(x, y))
1634      return FALSE;
1635    else
1636    {
1637      t = nacSub(pGetCoeff(x), pGetCoeff(y));
1638      if (!nacIsZero(t))
1639      {
1640        n_Delete(&t,nacRing);
1641        return FALSE;
1642      }
1643      else
1644        n_Delete(&t,nacRing);
1645    }
1646    pIter(x);
1647    pIter(y);
1648  }
1649  while ((x!=NULL) && (y!=NULL));
1650  if ((x!=NULL) || (y!=NULL)) return FALSE;
1651  p_Delete(&a->z,nacRing);
1652  p_Delete(&a->n,nacRing);
1653  a->z = p_ISet(1,nacRing);
1654  a->n = NULL;
1655  return TRUE;
1656#else
1657  return FALSE;
1658#endif
1659}
1660
1661/*2
1662* za == -1 ?
1663*/
1664BOOLEAN naIsMOne(number za)
1665{
1666  lnumber a = (lnumber)za;
1667  poly x, y;
1668  number t;
1669  if (a==NULL) return FALSE;
1670#ifdef LDEBUG
1671  omCheckAddrSize(a,sizeof(snumber));
1672  if (a->z==NULL)
1673  {
1674    WerrorS("internal zero error(5)");
1675    return FALSE;
1676  }
1677#endif
1678  if (a->n==NULL)
1679  {
1680    if (p_LmIsConstant(a->z,nacRing)) return nacIsMOne(pGetCoeff(a->z));
1681    /*else                   return FALSE;*/
1682  }
1683  return FALSE;
1684}
1685
1686/*2
1687* returns the i-th power of p (i>=0)
1688*/
1689void naPower(number p, int i, number *rc)
1690{
1691  number x;
1692  *rc = naInit(1,currRing);
1693  for (; i > 0; i--)
1694  {
1695    x = naMult(*rc, p);
1696    naDelete(rc,currRing);
1697    *rc = x;
1698  }
1699}
1700
1701/*2
1702* result =gcd(a,b)
1703*/
1704number naGcd(number a, number b, const ring r)
1705{
1706  if (a==NULL)  return naCopy(b);
1707  if (b==NULL)  return naCopy(a);
1708
1709  lnumber x, y;
1710  lnumber result = (lnumber)omAlloc0Bin(rnumber_bin);
1711
1712  x = (lnumber)a;
1713  y = (lnumber)b;
1714  if ((naNumbOfPar == 1) && (naMinimalPoly!=NULL))
1715  {
1716    if (pNext(x->z)!=NULL)
1717      result->z = p_Copy(x->z, r->algring);
1718    else
1719      result->z = napGcd0(x->z, y->z);
1720  }
1721  else
1722#ifndef HAVE_FACTORY
1723    result->z = napGcd(x->z, y->z); // change from napGcd0
1724#else
1725  {
1726    int c=ABS(nGetChar());
1727    if (c==1) c=0;
1728    setCharacteristic( c );
1729
1730    poly rz=napGcd(x->z, y->z);
1731    CanonicalForm F, G, R;
1732    R=convSingPFactoryP(rz,r->algring);
1733    p_Normalize(x->z,nacRing);
1734    F=convSingPFactoryP(x->z,r->algring)/R;
1735    p_Normalize(y->z,nacRing);
1736    G=convSingPFactoryP(y->z,r->algring)/R;
1737    F = gcd( F, G );
1738    if (F.isOne())
1739      result->z= rz;
1740    else
1741    {
1742      p_Delete(&rz,r->algring);
1743      result->z=convFactoryPSingP( F*R,r->algring );
1744      p_Normalize(result->z,nacRing);
1745    }
1746  }
1747#endif
1748  naTest((number)result);
1749  return (number)result;
1750}
1751
1752
1753/*2
1754* naNumbOfPar = 1:
1755* clears denominator         algebraic case;
1756* tries to simplify ratio    transcendental case;
1757*
1758* cancels monomials
1759* occuring in denominator
1760* and enumerator  ?          naNumbOfPar != 1;
1761*
1762* #defines for Factory:
1763* FACTORY_GCD_TEST: do not apply built in gcd for
1764*   univariate polynomials, always use Factory
1765*/
1766//#define FACTORY_GCD_TEST
1767void naCoefNormalize(number pp)
1768{
1769  if (pp==NULL) return;
1770  lnumber p = (lnumber)pp;
1771  number nz; // all denom. of the numerator
1772  nz=p_GetAllDenom(p->z,nacRing);
1773  BOOLEAN norm=FALSE;
1774  if (!n_IsOne(nz,nacRing))
1775  {
1776    norm=TRUE;
1777    p->z=p_Mult_nn(p->z,nz,nacRing);
1778    if (p->n==NULL)
1779    {
1780      p->n=p_NSet(nz,nacRing);
1781    }
1782    else
1783    {
1784      p->n=p_Mult_nn(p->n,nz,nacRing);
1785      n_Delete(&nz, nacRing);
1786    }
1787  }
1788  else
1789  {
1790    n_Delete(&nz, nacRing);
1791  }
1792  if (norm)
1793  {
1794    norm=FALSE;
1795    p_Normalize(p->z,nacRing);
1796    p_Normalize(p->n,nacRing);
1797  }
1798  number nn;
1799  nn=p_GetAllDenom(p->n,nacRing);
1800  if (!n_IsOne(nn,nacRing))
1801  {
1802    norm=TRUE;
1803    p->n=p_Mult_nn(p->n,nn,nacRing);
1804    p->z=p_Mult_nn(p->z,nn,nacRing);
1805    n_Delete(&nn, nacRing);
1806  }
1807  else
1808  {
1809    n_Delete(&nn, nacRing);
1810  }
1811  if (norm)
1812  {
1813    p_Normalize(p->z,nacRing);
1814    p_Normalize(p->n,nacRing);
1815  }
1816  // remove common factors in n, z:
1817  if (p->n!=NULL)
1818  {
1819    poly pp=p->z;
1820    nz=n_Copy(pGetCoeff(pp),nacRing);
1821    pIter(pp);
1822    while(pp!=NULL)
1823    {
1824      if (n_IsOne(nz,nacRing)) break;
1825      number d=n_Gcd(nz,pGetCoeff(pp),nacRing);
1826      n_Delete(&nz,nacRing); nz=d;
1827      pIter(pp);
1828    }
1829    if (!n_IsOne(nz,nacRing))
1830    {
1831      pp=p->n;
1832      nn=n_Copy(pGetCoeff(pp),nacRing);
1833      pIter(pp);
1834      while(pp!=NULL)
1835      {
1836        if (n_IsOne(nn,nacRing)) break;
1837        number d=n_Gcd(nn,pGetCoeff(pp),nacRing);
1838        n_Delete(&nn,nacRing); nn=d;
1839        pIter(pp);
1840      }
1841      number ng=n_Gcd(nz,nn,nacRing);
1842      n_Delete(&nn,nacRing);
1843      if (!n_IsOne(ng,nacRing))
1844      {
1845        number ni=n_Invers(ng,nacRing);
1846        p->z=p_Mult_nn(p->z,ni,nacRing);
1847        p->n=p_Mult_nn(p->n,ni,nacRing);
1848        p_Normalize(p->z,nacRing);
1849        p_Normalize(p->n,nacRing);
1850        n_Delete(&ni,nacRing);
1851      }
1852      n_Delete(&ng,nacRing);
1853    }
1854    n_Delete(&nz,nacRing);
1855  }
1856  if (p->n!=NULL)
1857  {
1858    if(!nacGreaterZero(pGetCoeff(p->n)))
1859    {
1860      p->z=napNeg(p->z);
1861      p->n=napNeg(p->n);
1862    }
1863
1864    if (/*(p->n!=NULL) && */
1865    (p_IsConstant(p->n,nacRing))
1866    && (n_IsOne(pGetCoeff(p->n),nacRing)))
1867    {
1868      p_Delete(&(p->n), nacRing);
1869      p->n = NULL;
1870    }
1871  }
1872}
1873
1874void naNormalize(number &pp)
1875{
1876
1877  //naTest(pp); // input may not be "normal"
1878  lnumber p = (lnumber)pp;
1879
1880  if (p==NULL)
1881    return;
1882  naCoefNormalize(pp);
1883  p->s = 2;
1884  poly x = p->z;
1885  poly y = p->n;
1886
1887  BOOLEAN norm=FALSE;
1888
1889  if ((y!=NULL) && (naMinimalPoly!=NULL))
1890  {
1891    y = napInvers(y, naMinimalPoly);
1892    x = p_Mult_q(x, y,nacRing);
1893    if (p_GetExp(x,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing))
1894      x = napRemainder(x, naMinimalPoly);
1895    p->z = x;
1896    p->n = y = NULL;
1897    norm=naIsChar0;
1898  }
1899
1900  /* check for degree of x too high: */
1901  if ((x!=NULL) && (naMinimalPoly!=NULL) && (x!=naMinimalPoly)
1902  && (p_GetExp(x,1,nacRing)>p_GetExp(naMinimalPoly,1,nacRing)))
1903  // DO NOT REDUCE naMinimalPoly with itself
1904  {
1905    x = napRemainder(x, naMinimalPoly);
1906    p->z = x;
1907    norm=naIsChar0;
1908  }
1909  /* normalize all coefficients in n and z (if in Q) */
1910  if (norm) 
1911  {
1912    naCoefNormalize(pp);
1913    x = p->z;
1914    y = p->n;
1915  }
1916  if (y==NULL) return;
1917
1918  if ((naMinimalPoly == NULL) && (x!=NULL) && (y!=NULL))
1919  {
1920    int i;
1921    for (i=naNumbOfPar-1; i>=0; i--)
1922    {
1923      poly xx=x;
1924      poly yy=y;
1925      int m = napExpi(i, yy, xx);
1926      if (m != 0)          // in this case xx!=NULL!=yy
1927      {
1928        while (xx != NULL)
1929        {
1930          napAddExp(xx,i+1, -m);
1931          pIter(xx);
1932        }
1933        while (yy != NULL)
1934        {
1935          napAddExp(yy,i+1, -m);
1936          pIter(yy);
1937        }
1938      }
1939    }
1940  }
1941  if (p_LmIsConstant(y,nacRing)) /* i.e. => simplify to (1/c)*z / monom */
1942  {
1943    if (nacIsOne(pGetCoeff(y)))
1944    {
1945      p_LmDelete(&y,nacRing);
1946      p->n = NULL;
1947      naTest(pp);
1948      return;
1949    }
1950    number h1 = nacInvers(pGetCoeff(y));
1951    nacNormalize(h1);
1952    napMultN(x, h1);
1953    n_Delete(&h1,nacRing);
1954    p_LmDelete(&y,nacRing);
1955    p->n = NULL;
1956    naTest(pp);
1957    return;
1958  }
1959#ifndef FACTORY_GCD_TEST
1960  if (naNumbOfPar == 1) /* apply built-in gcd */
1961  {
1962    poly x1,y1;
1963    if (p_GetExp(x,1,nacRing) >= p_GetExp(y,1,nacRing))
1964    {
1965      x1 = napCopy(x);
1966      y1 = napCopy(y);
1967    }
1968    else
1969    {
1970      x1 = napCopy(y);
1971      y1 = napCopy(x);
1972    }
1973    poly r;
1974    loop
1975    {
1976      r = napRemainder(x1, y1);
1977      if ((r==NULL) || (pNext(r)==NULL)) break;
1978      x1 = y1;
1979      y1 = r;
1980    }
1981    if (r!=NULL)
1982    {
1983      p_Delete(&r,nacRing);
1984      p_Delete(&y1,nacRing);
1985    }
1986    else
1987    {
1988      napDivMod(x, y1, &(p->z), &r);
1989      napDivMod(y, y1, &(p->n), &r);
1990      p_Delete(&y1,nacRing);
1991    }
1992    x = p->z;
1993    y = p->n;
1994    /* collect all denoms from y and multiply x and y by it */
1995    if (naIsChar0)
1996    {
1997      number n=napLcm(y);
1998      napMultN(x,n);
1999      napMultN(y,n);
2000      n_Delete(&n,nacRing);
2001      while(x!=NULL)
2002      {
2003        nacNormalize(pGetCoeff(x));
2004        pIter(x);
2005      }
2006      x = p->z;
2007      while(y!=NULL)
2008      {
2009        nacNormalize(pGetCoeff(y));
2010        pIter(y);
2011      }
2012      y = p->n;
2013    }
2014    if (pNext(y)==NULL)
2015    {
2016      if (nacIsOne(pGetCoeff(y)))
2017      {
2018        if (p_GetExp(y,1,nacRing)==0)
2019        {
2020          p_LmDelete(&y,nacRing);
2021          p->n = NULL;
2022        }
2023        naTest(pp);
2024        return;
2025      }
2026    }
2027  }
2028#endif /* FACTORY_GCD_TEST */
2029#ifdef HAVE_FACTORY
2030#ifndef FACTORY_GCD_TEST
2031  else
2032#endif
2033  {
2034    poly xx,yy;
2035    singclap_algdividecontent(x,y,xx,yy);
2036    if (xx!=NULL)
2037    {
2038      p->z=xx;
2039      p->n=yy;
2040      p_Delete(&x,nacRing);
2041      p_Delete(&y,nacRing);
2042    }
2043  }
2044#endif
2045  /* remove common factors from z and n */
2046  x=p->z;
2047  y=p->n;
2048  if(!nacGreaterZero(pGetCoeff(y)))
2049  {
2050    x=napNeg(x);
2051    y=napNeg(y);
2052  }
2053  number g=nacCopy(pGetCoeff(x));
2054  pIter(x);
2055  while (x!=NULL)
2056  {
2057    number d=nacGcd(g,pGetCoeff(x), nacRing);
2058    if(nacIsOne(d))
2059    {
2060      n_Delete(&g,nacRing);
2061      n_Delete(&d,nacRing);
2062      naTest(pp);
2063      return;
2064    }
2065    n_Delete(&g,nacRing);
2066    g = d;
2067    pIter(x);
2068  }
2069  while (y!=NULL)
2070  {
2071    number d=nacGcd(g,pGetCoeff(y), nacRing);
2072    if(nacIsOne(d))
2073    {
2074      n_Delete(&g,nacRing);
2075      n_Delete(&d,nacRing);
2076      naTest(pp);
2077      return;
2078    }
2079    n_Delete(&g,nacRing);
2080    g = d;
2081    pIter(y);
2082  }
2083  x=p->z;
2084  y=p->n;
2085  while (x!=NULL)
2086  {
2087    number d = nacIntDiv(pGetCoeff(x),g);
2088    napSetCoeff(x,d);
2089    pIter(x);
2090  }
2091  while (y!=NULL)
2092  {
2093    number d = nacIntDiv(pGetCoeff(y),g);
2094    napSetCoeff(y,d);
2095    pIter(y);
2096  }
2097  n_Delete(&g,nacRing);
2098  naTest(pp);
2099}
2100
2101/*2
2102* returns in result->n 1
2103* and in     result->z the lcm(a->z,b->n)
2104*/
2105number naLcm(number la, number lb, const ring r)
2106{
2107  lnumber result;
2108  lnumber a = (lnumber)la;
2109  lnumber b = (lnumber)lb;
2110  result = (lnumber)omAlloc0Bin(rnumber_bin);
2111  //if (((naMinimalPoly==NULL) && (naI==NULL)) || !naIsChar0)
2112  //{
2113  //  result->z = p_ISet(1,nacRing);
2114  //  return (number)result;
2115  //}
2116  //naNormalize(lb);
2117  naTest(la);
2118  naTest(lb);
2119  poly x = p_Copy(a->z, r->algring);
2120  number t = napLcm(b->z); // get all denom of b->z
2121  if (!nacIsOne(t))
2122  {
2123    number bt, rr;
2124    poly xx=x;
2125    while (xx!=NULL)
2126    {
2127      bt = nacGcd(t, pGetCoeff(xx), r->algring);
2128      rr = nacMult(t, pGetCoeff(xx));
2129      n_Delete(&pGetCoeff(xx),r->algring);
2130      pGetCoeff(xx) = nacDiv(rr, bt);
2131      nacNormalize(pGetCoeff(xx));
2132      n_Delete(&bt,r->algring);
2133      n_Delete(&rr,r->algring);
2134      pIter(xx);
2135    }
2136  }
2137  n_Delete(&t,r->algring);
2138  result->z = x;
2139#ifdef HAVE_FACTORY
2140  if (b->n!=NULL)
2141  {
2142    result->z=singclap_alglcm(result->z,b->n);
2143    p_Delete(&x,r->algring);
2144  }
2145#endif
2146  naTest(la);
2147  naTest(lb);
2148  naTest((number)result);
2149  return ((number)result);
2150}
2151
2152/*2
2153* input: a set of constant polynomials
2154* sets the global variable naI
2155*/
2156void naSetIdeal(ideal I)
2157{
2158  int i;
2159
2160  if (idIs0(I))
2161  {
2162    for (i=naI->anz-1; i>=0; i--)
2163      p_Delete(&naI->liste[i],nacRing);
2164    omFreeBin((void *)naI, snaIdeal_bin);
2165    naI=NULL;
2166  }
2167  else
2168  {
2169    lnumber h;
2170    number a;
2171    poly x;
2172
2173    naI=(naIdeal)omAllocBin(snaIdeal_bin);
2174    naI->anz=IDELEMS(I);
2175    naI->liste=(poly*)omAlloc(naI->anz*sizeof(poly));
2176    for (i=IDELEMS(I)-1; i>=0; i--)
2177    {
2178      h=(lnumber)pGetCoeff(I->m[i]);
2179      /* We only need the enumerator of h, as we expect it to be a polynomial */
2180      naI->liste[i]=napCopy(h->z);
2181      /* If it isn't normalized (lc = 1) do this */
2182      if (!nacIsOne(pGetCoeff(naI->liste[i])))
2183      {
2184        x=naI->liste[i];
2185        nacNormalize(pGetCoeff(x));
2186        a=nacCopy(pGetCoeff(x));
2187        number aa=nacInvers(a);
2188        n_Delete(&a,nacRing);
2189        napMultN(x,aa);
2190        n_Delete(&aa,nacRing);
2191      }
2192    }
2193  }
2194}
2195
2196/*2
2197* map Z/p -> Q(a)
2198*/
2199number naMapP0(number c)
2200{
2201  if (npIsZero(c)) return NULL;
2202  lnumber l=(lnumber)omAllocBin(rnumber_bin);
2203  l->s=2;
2204  l->z=(poly)p_Init(nacRing);
2205  int i=(int)((long)c);
2206  if (i>((long)naMapRing->ch>>2)) i-=(long)naMapRing->ch;
2207  pGetCoeff(l->z)=nlInit(i, nacRing);
2208  l->n=NULL;
2209  return (number)l;
2210}
2211
2212/*2
2213* map Q -> Q(a)
2214*/
2215number naMap00(number c)
2216{
2217  if (nlIsZero(c)) return NULL;
2218  lnumber l=(lnumber)omAllocBin(rnumber_bin);
2219  l->s=0;
2220  l->z=(poly)p_Init(nacRing);
2221  pGetCoeff(l->z)=nlCopy(c);
2222  l->n=NULL;
2223  return (number)l;
2224}
2225
2226/*2
2227* map Z/p -> Z/p(a)
2228*/
2229number naMapPP(number c)
2230{
2231  if (npIsZero(c)) return NULL;
2232  lnumber l=(lnumber)omAllocBin(rnumber_bin);
2233  l->s=2;
2234  l->z=(poly)p_Init(nacRing);
2235  pGetCoeff(l->z)=c; /* omit npCopy, because npCopy is a no-op */
2236  l->n=NULL;
2237  return (number)l;
2238}
2239
2240/*2
2241* map Z/p' -> Z/p(a)
2242*/
2243number naMapPP1(number c)
2244{
2245  if (npIsZero(c)) return NULL;
2246  int i=(int)((long)c);
2247  if (i>(long)naMapRing->ch) i-=(long)naMapRing->ch;
2248  number n=npInit(i,naMapRing);
2249  if (npIsZero(n)) return NULL;
2250  lnumber l=(lnumber)omAllocBin(rnumber_bin);
2251  l->s=2;
2252  l->z=(poly)p_Init(nacRing);
2253  pGetCoeff(l->z)=n;
2254  l->n=NULL;
2255  return (number)l;
2256}
2257
2258/*2
2259* map Q -> Z/p(a)
2260*/
2261number naMap0P(number c)
2262{
2263  if (nlIsZero(c)) return NULL;
2264  number n=npInit(nlModP(c,npPrimeM),nacRing);
2265  if (npIsZero(n)) return NULL;
2266  npTest(n);
2267  lnumber l=(lnumber)omAllocBin(rnumber_bin);
2268  l->s=2;
2269  l->z=(poly)p_Init(nacRing);
2270  pGetCoeff(l->z)=n;
2271  l->n=NULL;
2272  return (number)l;
2273}
2274
2275static number (*nacMap)(number);
2276static int naParsToCopy;
2277static napoly napMap(napoly p)
2278{
2279  napoly w, a;
2280
2281  if (p==NULL) return NULL;
2282  a = w = (napoly)p_Init(nacRing);
2283  int i;
2284  for(i=1;i<=naParsToCopy;i++)
2285    napSetExp(a,i,napGetExpFrom(p,i,naMapRing));
2286  p_Setm(a,nacRing);
2287  pGetCoeff(w) = nacMap(pGetCoeff(p));
2288  loop
2289  {
2290    pIter(p);
2291    if (p==NULL) break;
2292    pNext(a) = (napoly)p_Init(nacRing);
2293    pIter(a);
2294    for(i=1;i<=naParsToCopy;i++)
2295      napSetExp(a,i,napGetExpFrom(p,i,naMapRing));
2296    p_Setm(a,nacRing);
2297    pGetCoeff(a) = nacMap(pGetCoeff(p));
2298  }
2299  pNext(a) = NULL;
2300  return w;
2301}
2302
2303static napoly napPerm(napoly p,const int *par_perm,const ring src_ring,const nMapFunc nMap)
2304{
2305  napoly w, a;
2306
2307  if (p==NULL) return NULL;
2308  w = (napoly)p_Init(nacRing);
2309  int i;
2310  BOOLEAN not_null=TRUE;
2311  loop
2312  {
2313    for(i=1;i<=rPar(src_ring);i++)
2314    {
2315      int e;
2316      if (par_perm!=NULL) e=par_perm[i-1];
2317      else                e=-i;
2318      int ee=napGetExpFrom(p,i,src_ring);
2319      if (e<0)
2320        napSetExp(w,-e,ee);
2321      else if (ee>0)
2322        not_null=FALSE;
2323    }
2324    pGetCoeff(w) = nMap(pGetCoeff(p));
2325    p_Setm(w,nacRing);
2326    pIter(p);
2327    if (!not_null)
2328    {
2329      if (p==NULL)
2330      {
2331        p_Delete(&w,nacRing);
2332        return NULL;
2333      }
2334      /* else continue*/
2335      n_Delete(&(pGetCoeff(w)),nacRing);
2336    }
2337    else
2338    {
2339      if (p==NULL) return w;
2340      else
2341      {
2342        pNext(w)=napPerm(p,par_perm,src_ring,nMap);
2343        return w;
2344      }
2345    }
2346  }
2347}
2348
2349/*2
2350* map _(a) -> _(b)
2351*/
2352number naMapQaQb(number c)
2353{
2354  if (c==NULL) return NULL;
2355  lnumber erg= (lnumber)omAlloc0Bin(rnumber_bin);
2356  lnumber src =(lnumber)c;
2357  erg->s=src->s;
2358  erg->z=napMap(src->z);
2359  erg->n=napMap(src->n);
2360  if (naMinimalPoly!=NULL)
2361  {
2362    if (p_GetExp(erg->z,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing))
2363    {
2364      erg->z = napRemainder(erg->z, naMinimalPoly);
2365      if (erg->z==NULL)
2366      {
2367        number t_erg=(number)erg;
2368        naDelete(&t_erg,currRing);
2369        return (number)NULL;
2370      }
2371    }
2372    if (erg->n!=NULL)
2373    {
2374      if (p_GetExp(erg->n,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing))
2375        erg->n = napRemainder(erg->n, naMinimalPoly);
2376      if ((p_IsConstant(erg->n,nacRing)) && nacIsOne(pGetCoeff(erg->n)))
2377        p_Delete(&(erg->n),nacRing);
2378    }
2379  }
2380  return (number)erg;
2381}
2382
2383nMapFunc naSetMap(const ring src, const ring dst)
2384{
2385  naMapRing=src;
2386  if (rField_is_Q_a(dst)) /* -> Q(a) */
2387  {
2388    if (rField_is_Q(src))
2389    {
2390      return naMap00;   /*Q -> Q(a)*/
2391    }
2392    if (rField_is_Zp(src))
2393    {
2394      return naMapP0;  /* Z/p -> Q(a)*/
2395    }
2396    if (rField_is_Q_a(src))
2397    {
2398      int i;
2399      naParsToCopy=0;
2400      for(i=0;i<rPar(src);i++)
2401      {
2402        if ((i>=rPar(dst))
2403        ||(strcmp(src->parameter[i],dst->parameter[i])!=0))
2404           return NULL;
2405        naParsToCopy++;
2406      }
2407      nacMap=nacCopy;
2408      if ((naParsToCopy==rPar(dst))&&(naParsToCopy==rPar(src)))
2409        return naCopy;    /* Q(a) -> Q(a) */
2410      return naMapQaQb;   /* Q(a..) -> Q(a..) */
2411    }
2412  }
2413  /*-----------------------------------------------------*/
2414  if (rField_is_Zp_a(dst)) /* -> Z/p(a) */
2415  {
2416    if (rField_is_Q(src))
2417    {
2418      return naMap0P;   /*Q -> Z/p(a)*/
2419    }
2420    if (rField_is_Zp(src))
2421    {
2422      if (src->ch==dst->ch)
2423      {
2424        return naMapPP;  /* Z/p -> Z/p(a)*/
2425      }
2426      else
2427      {
2428        return naMapPP1;  /* Z/p' -> Z/p(a)*/
2429      }
2430    }
2431    if (rField_is_Zp_a(src))
2432    {
2433      if (rChar(src)==rChar(dst))
2434      {
2435        nacMap=nacCopy;
2436      }
2437      else
2438      {
2439        nacMap = npMapP;
2440      }
2441      int i;
2442      naParsToCopy=0;
2443      for(i=0;i<rPar(src);i++)
2444      {
2445        if ((i>=rPar(dst))
2446        ||(strcmp(src->parameter[i],dst->parameter[i])!=0))
2447           return NULL;
2448        naParsToCopy++;
2449      }
2450      if ((naParsToCopy==rPar(dst))&&(naParsToCopy==rPar(src))
2451      && (nacMap==nacCopy))
2452        return naCopy;    /* Z/p(a) -> Z/p(a) */
2453      return naMapQaQb;   /* Z/p(a),Z/p'(a) -> Z/p(b)*/
2454    }
2455  }
2456  return NULL;      /* default */
2457}
2458
2459/*2
2460* convert a napoly number into a poly
2461*/
2462poly naPermNumber(number z, int * par_perm, int P, ring oldRing)
2463{
2464  if (z==NULL) return NULL;
2465  poly res=NULL;
2466  poly p;
2467  napoly za=((lnumber)z)->z;
2468  napoly zb=((lnumber)z)->n;
2469  nMapFunc nMap=naSetMap(oldRing,currRing);
2470  if (currRing->parameter!=NULL)
2471    nMap=currRing->algring->cf->cfSetMap(oldRing->algring, nacRing);
2472  else
2473    nMap=currRing->cf->cfSetMap(oldRing->algring, currRing);
2474  if (nMap==NULL) return NULL; /* emergency exit only */
2475  do
2476  {
2477    p = pInit();
2478    pNext(p)=NULL;
2479    nNew(&pGetCoeff(p));
2480    int i;
2481    for(i=pVariables;i;i--)
2482       pSetExp(p,i, 0);
2483    if (rRing_has_Comp(currRing)) pSetComp(p, 0);
2484    napoly pa=NULL;
2485    lnumber pan;
2486    if (currRing->parameter!=NULL)
2487    {
2488      assume(oldRing->algring!=NULL);
2489      pGetCoeff(p)=(number)omAlloc0Bin(rnumber_bin);
2490      pan=(lnumber)pGetCoeff(p);
2491      pan->s=2;
2492      pan->z=napInitz(nMap(pGetCoeff(za)));
2493      pa=pan->z;
2494    }
2495    else
2496    {
2497      pGetCoeff(p)=nMap(pGetCoeff(za));
2498    }
2499    for(i=0;i<P;i++)
2500    {
2501      if(napGetExpFrom(za,i+1,oldRing)!=0)
2502      {
2503        if(par_perm==NULL)
2504        {
2505          if ((rPar(currRing)>=i) && (pa!=NULL))
2506          {
2507            napSetExp(pa,i+1,napGetExpFrom(za,i+1,oldRing));
2508            p_Setm(pa,nacRing);
2509          }
2510          else
2511          {
2512            pDelete(&p);
2513            break;
2514          }
2515        }
2516        else if(par_perm[i]>0)
2517          pSetExp(p,par_perm[i],napGetExpFrom(za,i+1,oldRing));
2518        else if((par_perm[i]<0)&&(pa!=NULL))
2519        {
2520          napSetExp(pa,-par_perm[i], napGetExpFrom(za,i+1,oldRing));
2521          p_Setm(pa,nacRing);
2522        }
2523        else
2524        {
2525          pDelete(&p);
2526          break;
2527        }
2528      }
2529    }
2530    if (p!=NULL)
2531    {
2532      pSetm(p);
2533      if (zb!=NULL)
2534      {
2535        if  (currRing->P>0)
2536        {
2537          pan->n=napPerm(zb,par_perm,oldRing,nMap);
2538          if(pan->n==NULL) /* error in mapping or mapping to variable */
2539            pDelete(&p);
2540        }
2541        else
2542          pDelete(&p);
2543      }
2544      pTest(p);
2545      res=pAdd(res,p);
2546    }
2547    pIter(za);
2548  }
2549  while (za!=NULL);
2550  pTest(res);
2551  return res;
2552}
2553
2554number   naGetDenom(number &n, const ring r)
2555{
2556  lnumber x=(lnumber)n;
2557  if (x->n!=NULL)
2558  {
2559    lnumber rr=(lnumber)omAlloc0Bin(rnumber_bin);
2560    rr->z=p_Copy(x->n,r->algring);
2561    rr->s = 2;
2562    return (number)rr;
2563  }
2564  return n_Init(1,r);
2565}
2566
2567number   naGetNumerator(number &n, const ring r)
2568{
2569  lnumber x=(lnumber)n;
2570  lnumber rr=(lnumber)omAlloc0Bin(rnumber_bin);
2571  rr->z=p_Copy(x->z,r->algring);
2572  rr->s = 2;
2573  return (number)rr;
2574}
2575
2576#ifdef LDEBUG
2577BOOLEAN naDBTest(number a, const char *f,const int l)
2578{
2579  lnumber x=(lnumber)a;
2580  if (x == NULL)
2581    return TRUE;
2582  #ifdef LDEBUG
2583  omCheckAddrSize(a, sizeof(snumber));
2584  #endif
2585  poly p = x->z;
2586  if (p==NULL)
2587  {
2588    Print("0/* in %s:%d\n",f,l);
2589    return FALSE;
2590  }
2591  while(p!=NULL)
2592  {
2593    if ((naIsChar0 && nlIsZero(pGetCoeff(p)))
2594    || ((!naIsChar0) && npIsZero(pGetCoeff(p))))
2595    {
2596      Print("coeff 0 in %s:%d\n",f,l);
2597      return FALSE;
2598    }
2599    if((naMinimalPoly!=NULL)
2600    &&(p_GetExp(p,1,nacRing)>p_GetExp(naMinimalPoly,1,nacRing))
2601    &&(p!=naMinimalPoly))
2602    {
2603      Print("deg>minpoly in %s:%d\n",f,l);
2604      return FALSE;
2605    }
2606    //if (naIsChar0 && (((int)p->ko &3) == 0) && (p->ko->s==0) && (x->s==2))
2607    //{
2608    //  Print("normalized with non-normal coeffs in %s:%d\n",f,l);
2609    //  return FALSE;
2610    //}
2611    if (naIsChar0 && !(nlDBTest(pGetCoeff(p),f,l)))
2612      return FALSE;
2613    pIter(p);
2614  }
2615  p = x->n;
2616  while(p!=NULL)
2617  {
2618    if (naIsChar0 && !(nlDBTest(pGetCoeff(p),f,l)))
2619      return FALSE;
2620    pIter(p);
2621  }
2622  return TRUE;
2623}
2624#endif
2625
2626/*2
2627* convert a napoly number into a poly
2628*/
2629poly napPermNumber(number z, int * par_perm, int P, ring oldRing)
2630{
2631  if (z==NULL) return NULL;
2632  poly res=NULL;
2633  poly p;
2634  napoly za=((lnumber)z)->z;
2635  napoly zb=((lnumber)z)->n;
2636  nMapFunc nMap=naSetMap(oldRing,currRing); /* todo: check naSetMap
2637                                                     vs. ntSetMap */
2638  if (currRing->parameter!=NULL)
2639    nMap=currRing->algring->cf->cfSetMap(oldRing->algring, nacRing);
2640  else
2641    nMap=currRing->cf->cfSetMap(oldRing->algring, currRing);
2642  if (nMap==NULL) return NULL; /* emergency exit only */
2643  while(za!=NULL)
2644  {
2645    p = pInit();
2646    pNext(p)=NULL;
2647    //nNew(&pGetCoeff(p));
2648    int i;
2649    //for(i=pVariables;i;i--) pSetExp(p,i, 0); // done by pInit
2650    //if (rRing_has_Comp(currRing)) pSetComp(p, 0); // done by pInit
2651    napoly pa=NULL;
2652    lnumber pan;
2653    if (currRing->parameter!=NULL)
2654    {
2655      assume(oldRing->algring!=NULL);
2656      pGetCoeff(p)=(number)ALLOC0_LNUMBER();
2657      pan=(lnumber)pGetCoeff(p);
2658      pan->s=2;
2659      pan->z=napInitz(nMap(pGetCoeff(za)));
2660      pa=pan->z;
2661    }
2662    else
2663    {
2664      pGetCoeff(p)=nMap(pGetCoeff(za));
2665    }
2666    for(i=0;i<P;i++)
2667    {
2668      if(napGetExpFrom(za,i+1,oldRing)!=0)
2669      {
2670        if(par_perm==NULL)
2671        {
2672          if ((rPar(currRing)>=i) && (pa!=NULL))
2673          {
2674            napSetExp(pa,i+1,napGetExpFrom(za,i+1,oldRing));
2675            p_Setm(pa,nacRing);
2676          }
2677          else
2678          {
2679            pDelete(&p);
2680            break;
2681          }
2682        }
2683        else if(par_perm[i]>0)
2684          pSetExp(p,par_perm[i],napGetExpFrom(za,i+1,oldRing));
2685        else if((par_perm[i]<0)&&(pa!=NULL))
2686        {
2687          napSetExp(pa,-par_perm[i], napGetExpFrom(za,i+1,oldRing));
2688          p_Setm(pa,nacRing);
2689        }
2690        else
2691        {
2692          pDelete(&p);
2693          break;
2694        }
2695      }
2696    }
2697    if (p!=NULL)
2698    {
2699      pSetm(p);
2700      if (zb!=NULL)
2701      {
2702        if  (currRing->P>0)
2703        {
2704          pan->n=napPerm(zb,par_perm,oldRing,nMap);
2705          if(pan->n==NULL) /* error in mapping or mapping to variable */
2706            pDelete(&p);
2707        }
2708        else
2709          pDelete(&p);
2710      }
2711      nNormalize(pGetCoeff(p));
2712      if (nIsZero(pGetCoeff(p)))
2713        pDelete(&p);
2714      else
2715      {
2716        pTest(p);
2717        res=pAdd(res,p);
2718      }
2719    }
2720    pIter(za);
2721  }
2722  pTest(res);
2723  return res;
2724}
2725number   napGetDenom(number &n, const ring r)
2726{
2727  lnumber x=(lnumber)n;
2728  if (x->n!=NULL)
2729  {
2730    lnumber rr=ALLOC0_LNUMBER();
2731    rr->z=p_Copy(x->n,r->algring);
2732    rr->s = 2;
2733    return (number)rr;
2734  }
2735  return n_Init(1,r);
2736}
2737
2738number   napGetNumerator(number &n, const ring r)
2739{
2740  lnumber x=(lnumber)n;
2741  lnumber rr=ALLOC0_LNUMBER();
2742  rr->z=p_Copy(x->z,r->algring);
2743  rr->s = 2;
2744  return (number)rr;
2745}
Note: See TracBrowser for help on using the repository browser.