source: git/kernel/longalg.cc @ 0c2088

fieker-DuValspielwiese
Last change on this file since 0c2088 was 0c2088, checked in by Hans Schoenemann <hannes@…>, 13 years ago
nacIsMOne removed git-svn-id: file:///usr/local/Singular/svn/trunk@13963 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 33.3 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 <kernel/mod2.h>
12#include <kernel/structs.h>
13#include <omalloc/omalloc.h>
14#include <kernel/febase.h>
15#include <kernel/longrat.h>
16#include <kernel/modulop.h>
17#include <kernel/numbers.h>
18#include <kernel/polys.h>
19#include <kernel/ideals.h>
20#include <kernel/ring.h>
21#ifdef HAVE_FACTORY
22#define SI_DONT_HAVE_GLOBAL_VARS
23#include <factory/factory.h>
24#include <kernel/clapsing.h>
25#include <kernel/clapconv.h>
26#endif
27#include <kernel/longalg.h>
28#include <kernel/longtrans.h>
29
30#ifdef LDEBUG
31#define naTest(a) naDBTest(a,__FILE__,__LINE__)
32BOOLEAN naDBTest(number a, const char *f,const int l);
33#else
34#define naTest(a)
35#endif
36
37naIdeal naI = NULL;
38napoly  naMinimalPoly;
39omBin   snaIdeal_bin = omGetSpecBin(sizeof(snaIdeal));
40number  (*naMap)(number from);
41
42void redefineFunctionPointers()
43{
44  n_Procs_s* n = currRing->cf;
45  /* re-defining function pointers */
46  n->cfDelete       = naDelete;
47  n->nNormalize     = naNormalize;
48  n->cfInit         = naInit;
49  n->nPar           = naPar;
50  n->nParDeg        = naParDeg;
51  n->n_Int          = naInt;
52  n->nAdd           = naAdd;
53  n->nSub           = naSub;
54  n->nMult          = naMult;
55  n->nDiv           = naDiv;
56  n->nExactDiv      = naDiv;
57  n->nIntDiv        = naIntDiv;
58  n->nNeg           = naNeg;
59  n->nInvers        = naInvers;
60  n->nCopy          = naCopy;
61  n->cfCopy         = na_Copy;
62  n->nGreater       = naGreater;
63  n->nEqual         = naEqual;
64  n->nIsZero        = naIsZero;
65  n->nIsOne         = naIsOne;
66  n->nIsMOne        = naIsMOne;
67  n->nGreaterZero   = naGreaterZero;
68  n->cfWrite        = naWrite;
69  n->nRead          = naRead;
70  n->nPower         = naPower;
71  n->nGcd           = naGcd;
72  n->nLcm           = naLcm;
73  n->cfSetMap       = naSetMap;
74  n->nName          = naName;
75  n->nSize          = naSize;
76  n->cfGetDenom     = napGetDenom;
77  n->cfGetNumerator = napGetNumerator;
78#ifdef LDEBUG
79  n->nDBTest        = naDBTest;
80#endif
81  /* re-defining global function pointers */
82  nNormalize=naNormalize;
83  nPar   = naPar;
84  nParDeg= nParDeg;
85  n_Int  = naInt;
86  nAdd   = naAdd;
87  nSub   = naSub;
88  nMult  = naMult;
89  nDiv   = naDiv;
90  nExactDiv= naDiv;
91  nIntDiv= naIntDiv;
92  nNeg   = naNeg;
93  nInvers= naInvers;
94  nCopy  = naCopy;
95  nGreater = naGreater;
96  nEqual = naEqual;
97  nIsZero = naIsZero;
98  nIsOne = naIsOne;
99  nIsMOne = naIsMOne;
100  nGreaterZero = naGreaterZero;
101  nRead = naRead;
102  nPower = naPower;
103  nGcd  = naGcd;
104  nLcm  = naLcm;
105  nName= naName;
106  nSize  = naSize;
107}
108
109static number nadGcd( number a, number b, const ring r) { return nacInit(1,r); }
110/*2
111*  sets the appropriate operators
112*/
113void naSetChar(int i, ring r)
114{
115  assume((r->minpoly  != NULL) ||
116         (r->minideal != NULL)    );
117 
118  if (naI!=NULL)
119  {
120    int j;
121    for (j=naI->anz-1; j>=0; j--)
122       p_Delete (&naI->liste[j],nacRing);
123    omFreeSize((ADDRESS)naI->liste,naI->anz*sizeof(napoly));
124    omFreeBin((ADDRESS)naI, snaIdeal_bin);
125    naI=NULL;
126  }
127  naMap = naCopy;
128
129  if (r->minpoly!=NULL)
130  {
131    naMinimalPoly=((lnumber)r->minpoly)->z;
132    #ifdef LDEBUG
133    omCheckAddr(naMinimalPoly);
134    #endif
135  }
136  else
137    naMinimalPoly = NULL;
138   
139  if (r->minideal!=NULL)
140  {
141    naI=(naIdeal)omAllocBin(snaIdeal_bin);
142    naI->anz=IDELEMS(r->minideal);
143    naI->liste=(napoly*)omAlloc(naI->anz*sizeof(napoly));
144    int j;
145    for (j=naI->anz-1; j>=0; j--)
146    {
147      lnumber a = (lnumber)pGetCoeff(r->minideal->m[j]);
148      naI->liste[j]=napCopy(a->z);
149    }
150  }
151
152  ntNumbOfPar=rPar(r);
153  if (i == 1)
154    ntIsChar0 = 1;
155  else if (i < 0)
156  {
157    ntIsChar0 = 0;
158    npSetChar(-i, r->algring); // to be changed HS
159  }
160#ifdef TEST
161  else
162  {
163    Print("naSetChar:c=%d param=%d\n",i,rPar(r));
164  }
165#endif
166  nacRing        = r->algring;
167  nacInit        = nacRing->cf->cfInit;
168  nacInt         = nacRing->cf->n_Int;
169  nacCopy        = nacRing->cf->nCopy;
170  nacAdd         = nacRing->cf->nAdd;
171  nacSub         = nacRing->cf->nSub;
172  nacNormalize   = nacRing->cf->nNormalize;
173  nacNeg         = nacRing->cf->nNeg;
174  nacIsZero      = nacRing->cf->nIsZero;
175  nacGreaterZero = nacRing->cf->nGreaterZero;
176  nacIsOne       = nacRing->cf->nIsOne;
177  nacGcd         = nacRing->cf->nGcd;
178  nacLcm         = nacRing->cf->nLcm;
179  nacMult        = nacRing->cf->nMult;
180  nacDiv         = nacRing->cf->nDiv;
181  nacIntDiv      = nacRing->cf->nIntDiv;
182  nacInvers      = nacRing->cf->nInvers;
183}
184
185/*================ procedure for rational functions: naXXXX =================*/
186
187/*2
188*  z:= i
189*/
190number naInit(int i, const ring r)
191{
192  if (i!=0)
193  {
194    number c=n_Init(i,r->algring);
195    if (!n_IsZero(c,r->algring))
196    {
197      poly z=p_Init(r->algring);
198      pSetCoeff0(z,c);
199      lnumber l = (lnumber)omAllocBin(rnumber_bin);
200      l->z = z;
201      l->s = 2;
202      l->n = NULL;
203      return (number)l;
204    }
205  }
206  /*else*/
207  return NULL;
208}
209
210number  naPar(int i)
211{
212  lnumber l = (lnumber)omAllocBin(rnumber_bin);
213  l->s = 2;
214  l->z = p_ISet(1,nacRing);
215  napSetExp(l->z,i,1);
216  p_Setm(l->z,nacRing);
217  l->n = NULL;
218  return (number)l;
219}
220
221int     naParDeg(number n)     /* i := deg(n) */
222{
223  lnumber l = (lnumber)n;
224  if (l==NULL) return -1;
225  return napDeg(l->z);
226}
227
228//int     naParDeg(number n)     /* i := deg(n) */
229//{
230//  lnumber l = (lnumber)n;
231//  if (l==NULL) return -1;
232//  return napMaxDeg(l->z)+napMaxDeg(l->n);
233//}
234
235int     naSize(number n)     /* size desc. */
236{
237  lnumber l = (lnumber)n;
238  if (l==NULL) return -1;
239  int len_z;
240  int len_n;
241  int o=napMaxDegLen(l->z,len_z)+napMaxDegLen(l->n,len_n);
242  return (len_z+len_n)+o;
243}
244
245/*2
246* convert a number to int (if possible)
247*/
248int naInt(number &n, const ring r)
249{
250  lnumber l=(lnumber)n;
251  if ((l!=NULL)&&(l->n==NULL)&&(p_IsConstant(l->z,r->algring)))
252  {
253    return nacInt(pGetCoeff(l->z),r->algring);
254  }
255  return 0;
256}
257
258/*2
259*  deletes p
260*/
261void naDelete(number *p, const ring r)
262{
263  if ((*p)!=r->minpoly)
264  {
265    lnumber l = (lnumber) * p;
266    if (l==NULL) return;
267    p_Delete(&(l->z),r->algring);
268    p_Delete(&(l->n),r->algring);
269    omFreeBin((ADDRESS)l,  rnumber_bin);
270  }
271  *p = NULL;
272}
273
274/*2
275* copy p to erg
276*/
277number naCopy(number p)
278{
279  if (p==NULL) return NULL;
280  naTest(p);
281  lnumber erg;
282  lnumber src = (lnumber)p;
283  erg = (lnumber)omAlloc0Bin(rnumber_bin);
284  erg->z = p_Copy(src->z, nacRing);
285  erg->n = p_Copy(src->n, nacRing);
286  erg->s = src->s;
287  return (number)erg;
288}
289number na_Copy(number p, const ring r)
290{
291  if (p==NULL) return NULL;
292  lnumber erg;
293  lnumber src = (lnumber)p;
294  erg = (lnumber)omAlloc0Bin(rnumber_bin);
295  erg->z = p_Copy(src->z,r->algring);
296  erg->n = p_Copy(src->n,r->algring);
297  erg->s = src->s;
298  return (number)erg;
299}
300
301/*2
302*  addition; lu:= la + lb
303*/
304number naAdd(number la, number lb)
305{
306  if (la==NULL) return naCopy(lb);
307  if (lb==NULL) return naCopy(la);
308
309  napoly x, y;
310  lnumber lu;
311  lnumber a = (lnumber)la;
312  lnumber b = (lnumber)lb;
313  #ifdef LDEBUG
314  omCheckAddrSize(a,sizeof(snumber));
315  omCheckAddrSize(b,sizeof(snumber));
316  #endif
317  if (b->n!=NULL) x = pp_Mult_qq(a->z, b->n,nacRing);
318  else            x = napCopy(a->z);
319  if (a->n!=NULL) y = pp_Mult_qq(b->z, a->n,nacRing);
320  else            y = napCopy(b->z);
321  napoly res = napAdd(x, y);
322  if (res==NULL)
323  {
324    return (number)NULL;
325  }
326  lu = (lnumber)omAllocBin(rnumber_bin);
327  lu->z=res;
328  if (a->n!=NULL)
329  {
330    if (b->n!=NULL) x = pp_Mult_qq(a->n, b->n,nacRing);
331    else            x = napCopy(a->n);
332  }
333  else
334  {
335    if (b->n!=NULL) x = napCopy(b->n);
336    else            x = NULL;
337  }
338  //if (x!=NULL)
339  //{
340  //  if (p_LmIsConstant(x,nacRing))
341  //  {
342  //    number inv=nacInvers(pGetCoeff(x));
343  //    napMultN(lu->z,inv);
344  //    n_Delete(&inv,nacRing);
345  //    napDelete(&x);
346  //  }
347  //}
348  lu->n = x;
349  lu->s = FALSE;
350  if (/*lu->n*/ x!=NULL)
351  {
352     number luu=(number)lu;
353     //if (p_IsConstant(lu->n,nacRing)) naCoefNormalize(luu);
354     //else
355                naNormalize(luu);
356     lu=(lnumber)luu;
357  }
358  //else lu->s=2;
359  naTest((number)lu);
360  return (number)lu;
361}
362
363/*2
364*  subtraction; r:= la - lb
365*/
366number naSub(number la, number lb)
367{
368  lnumber lu;
369
370  if (lb==NULL) return naCopy(la);
371  if (la==NULL)
372  {
373    lu = (lnumber)naCopy(lb);
374    lu->z = napNeg(lu->z);
375    return (number)lu;
376  }
377
378  lnumber a = (lnumber)la;
379  lnumber b = (lnumber)lb;
380
381  #ifdef LDEBUG
382  omCheckAddrSize(a,sizeof(snumber));
383  omCheckAddrSize(b,sizeof(snumber));
384  #endif
385
386  napoly x, y;
387  if (b->n!=NULL) x = pp_Mult_qq(a->z, b->n,nacRing);
388  else            x = napCopy(a->z);
389  if (a->n!=NULL) y = p_Mult_q(napCopy(b->z), napCopyNeg(a->n),nacRing);
390  else            y = napCopyNeg(b->z);
391  napoly res = napAdd(x, y);
392  if (res==NULL)
393  {
394    return (number)NULL;
395  }
396  lu = (lnumber)omAllocBin(rnumber_bin);
397  lu->z=res;
398  if (a->n!=NULL)
399  {
400    if (b->n!=NULL) x = pp_Mult_qq(a->n, b->n,nacRing);
401    else            x = napCopy(a->n);
402  }
403  else
404  {
405    if (b->n!=NULL) x = napCopy(b->n);
406    else            x = NULL;
407  }
408  lu->n = x;
409  lu->s = FALSE;
410  if (/*lu->n*/ x!=NULL)
411  {
412     number luu=(number)lu;
413     //if (p_IsConstant(lu->n,nacRing)) naCoefNormalize(luu);
414     //else
415                         naNormalize(luu);
416     lu=(lnumber)luu;
417  }
418  //else lu->s=2;
419  naTest((number)lu);
420  return (number)lu;
421}
422
423/*2
424*  multiplication; r:= la * lb
425*/
426number naMult(number la, number lb)
427{
428  if ((la==NULL) || (lb==NULL))
429    return NULL;
430
431  lnumber a = (lnumber)la;
432  lnumber b = (lnumber)lb;
433  lnumber lo;
434  napoly x;
435
436  #ifdef LDEBUG
437  omCheckAddrSize(a,sizeof(snumber));
438  omCheckAddrSize(b,sizeof(snumber));
439  #endif
440  naTest(la);
441  naTest(lb);
442
443  lo = (lnumber)omAllocBin(rnumber_bin);
444  lo->z = pp_Mult_qq(a->z, b->z,nacRing);
445
446  if (a->n==NULL)
447  {
448    if (b->n==NULL)
449      x = NULL;
450    else
451      x = napCopy(b->n);
452  }
453  else
454  {
455    if (b->n==NULL)
456    {
457      x = napCopy(a->n);
458    }
459    else
460    {
461      x = pp_Mult_qq(b->n, a->n, nacRing);
462    }
463  }
464  if (naMinimalPoly!=NULL)
465  {
466    if (p_GetExp(lo->z,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing))
467      lo->z = napRemainder(lo->z, naMinimalPoly);
468    if ((x!=NULL) &&
469        (p_GetExp(x,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing)))
470      x = napRemainder(x, naMinimalPoly);
471  }
472  if (naI!=NULL)
473  {
474    lo->z = napRedp (lo->z);
475    if (lo->z != NULL)
476       lo->z = napTailred (lo->z);
477    if (x!=NULL)
478    {
479      x = napRedp (x);
480      if (x!=NULL)
481        x = napTailred (x);
482    }
483  }
484  if ((x!=NULL) && (p_LmIsConstant(x,nacRing)) && nacIsOne(pGetCoeff(x)))
485    p_Delete(&x,nacRing);
486  lo->n = x;
487  lo->s = 0;
488  if(lo->z==NULL)
489  {
490    omFreeBin((ADDRESS)lo, rnumber_bin);
491    lo=NULL;
492  }
493  else if (lo->n!=NULL)
494  {
495    number luu=(number)lo;
496    // if (p_IsConstant(lo->n,nacRing)) naCoefNormalize(luu);
497    // else
498                      naNormalize(luu);
499    lo=(lnumber)luu;
500  }
501  //if (naMinimalPoly==NULL) lo->s=2;
502  naTest((number)lo);
503  return (number)lo;
504}
505
506number naIntDiv(number la, number lb)
507{
508  lnumber res;
509  lnumber a = (lnumber)la;
510  lnumber b = (lnumber)lb;
511  if (a==NULL)
512  {
513    return NULL;
514  }
515  if (b==NULL)
516  {
517    WerrorS(nDivBy0);
518    return NULL;
519  }
520  assume(a->z!=NULL && b->z!=NULL);
521  assume(a->n==NULL && b->n==NULL);
522  res = (lnumber)omAllocBin(rnumber_bin);
523  res->z = napCopy(a->z);
524  res->n = napCopy(b->z);
525  res->s = 0;
526  number nres=(number)res;
527  naNormalize(nres);
528
529  //napDelete(&res->n);
530  naTest(nres);
531  return nres;
532}
533
534/*2
535*  division; lo:= la / lb
536*/
537number naDiv(number la, number lb)
538{
539  lnumber lo;
540  lnumber a = (lnumber)la;
541  lnumber b = (lnumber)lb;
542  napoly x;
543
544  if (a==NULL)
545    return NULL;
546
547  if (b==NULL)
548  {
549    WerrorS(nDivBy0);
550    return NULL;
551  }
552  #ifdef LDEBUG
553  omCheckAddrSize(a,sizeof(snumber));
554  omCheckAddrSize(b,sizeof(snumber));
555  #endif
556  lo = (lnumber)omAllocBin(rnumber_bin);
557  if (b->n!=NULL)
558    lo->z = pp_Mult_qq(a->z, b->n,nacRing);
559  else
560    lo->z = napCopy(a->z);
561  if (a->n!=NULL)
562    x = pp_Mult_qq(b->z, a->n, nacRing);
563  else
564    x = napCopy(b->z);
565  if (naMinimalPoly!=NULL)
566  {
567    if (p_GetExp(lo->z,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing))
568      lo->z = napRemainder(lo->z, naMinimalPoly);
569    if (p_GetExp(x,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing))
570      x = napRemainder(x, naMinimalPoly);
571  }
572  if (naI!=NULL)
573  {
574    lo->z = napRedp (lo->z);
575    if (lo->z != NULL)
576       lo->z = napTailred (lo->z);
577    if (x!=NULL)
578    {
579      x = napRedp (x);
580      if (x!=NULL)
581        x = napTailred (x);
582    }
583  }
584  if ((p_LmIsConstant(x,nacRing)) && nacIsOne(pGetCoeff(x)))
585    p_Delete(&x,nacRing);
586  lo->n = x;
587  lo->s = 0;
588  if (lo->n!=NULL)
589  {
590    number luu=(number)lo;
591     //if (p_IsConstant(lo->n,nacRing)) naCoefNormalize(luu);
592     //else
593                         naNormalize(luu);
594    lo=(lnumber)luu;
595  }
596  //else lo->s=2;
597  naTest((number)lo);
598  return (number)lo;
599}
600
601/*2
602*  za:= - za, inplace
603*/
604number naNeg(number za)
605{
606  if (za!=NULL)
607  {
608    lnumber e = (lnumber)za;
609    naTest(za);
610    e->z = napNeg(e->z);
611  }
612  return za;
613}
614
615/*2
616* 1/a
617*/
618number naInvers(number a)
619{
620  lnumber lo;
621  lnumber b = (lnumber)a;
622  napoly x;
623
624  if (b==NULL)
625  {
626    WerrorS(nDivBy0);
627    return NULL;
628  }
629  #ifdef LDEBUG
630  omCheckAddrSize(b,sizeof(snumber));
631  #endif
632  lo = (lnumber)omAlloc0Bin(rnumber_bin);
633  lo->s = b->s;
634  if (b->n!=NULL)
635    lo->z = napCopy(b->n);
636  else
637    lo->z = p_ISet(1,nacRing);
638  x = b->z;
639  if ((!p_LmIsConstant(x,nacRing)) || !nacIsOne(pGetCoeff(x)))
640    x = napCopy(x);
641  else
642  {
643    lo->n = NULL;
644    naTest((number)lo);
645    return (number)lo;
646  }
647  if (naMinimalPoly!=NULL)
648  {
649    x = napInvers(x, naMinimalPoly);
650    x = p_Mult_q(x, lo->z,nacRing);
651    if (p_GetExp(x,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing))
652      x = napRemainder(x, naMinimalPoly);
653    lo->z = x;
654    lo->n = NULL;
655    while (x!=NULL)
656    {
657      nacNormalize(pGetCoeff(x));
658      pIter(x);
659    }
660  }
661  else
662    lo->n = x;
663  if (lo->n!=NULL)
664  {
665     number luu=(number)lo;
666     //if (p_IsConstant(lo->n,nacRing)) naCoefNormalize(luu);
667     //else
668                           naNormalize(luu);
669     lo=(lnumber)luu;
670  }
671  naTest((number)lo);
672  return (number)lo;
673}
674
675
676BOOLEAN naIsZero(number za)
677{
678  lnumber zb = (lnumber)za;
679  naTest(za);
680#ifdef LDEBUG
681  if ((zb!=NULL) && (zb->z==NULL)) WerrorS("internal zero error(2)");
682#endif
683  return (zb==NULL);
684}
685
686
687BOOLEAN naGreaterZero(number za)
688{
689  lnumber zb = (lnumber)za;
690#ifdef LDEBUG
691  if ((zb!=NULL) && (zb->z==NULL)) WerrorS("internal zero error(3)");
692#endif
693  naTest(za);
694  if (zb!=NULL)
695  {
696    return (nacGreaterZero(pGetCoeff(zb->z))||(!p_LmIsConstant(zb->z,nacRing)));
697  }
698  /* else */ return FALSE;
699}
700
701
702/*2
703* a = b ?
704*/
705BOOLEAN naEqual (number a, number b)
706{
707  if(a==b) return TRUE;
708  if((a==NULL)&&(b!=NULL)) return FALSE;
709  if((b==NULL)&&(a!=NULL)) return FALSE;
710
711  lnumber aa=(lnumber)a;
712  lnumber bb=(lnumber)b;
713
714  int an_deg=0;
715  if(aa->n!=NULL)
716    an_deg=napDeg(aa->n);
717  int bn_deg=0;
718  if(bb->n!=NULL)
719    bn_deg=napDeg(bb->n);
720  if(an_deg+napDeg(bb->z)!=bn_deg+napDeg(aa->z))
721    return FALSE;
722#if 0
723  naNormalize(a);
724  aa=(lnumber)a;
725  naNormalize(b);
726  bb=(lnumber)b;
727  if((aa->n==NULL)&&(bb->n!=NULL)) return FALSE;
728  if((bb->n==NULL)&&(aa->n!=NULL)) return FALSE;
729  if(napComp(aa->z,bb->z)!=0) return FALSE;
730  if((aa->n!=NULL) && (napComp(aa->n,bb->n))) return FALSE;
731#endif
732  number h = naSub(a, b);
733  BOOLEAN bo = naIsZero(h);
734  naDelete(&h,currRing);
735  return bo;
736}
737
738
739BOOLEAN naGreater (number a, number b)
740{
741  if (naIsZero(a))
742    return FALSE;
743  if (naIsZero(b))
744    return TRUE; /* a!= 0)*/
745  return napDeg(((lnumber)a)->z)>napDeg(((lnumber)b)->z);
746}
747
748/*2
749* reads a number
750*/
751const char  *naRead(const char *s, number *p)
752{
753  napoly x;
754  lnumber a;
755  s = napRead(s, &x);
756  if (x==NULL)
757  {
758    *p = NULL;
759    return s;
760  }
761  *p = (number)omAlloc0Bin(rnumber_bin);
762  a = (lnumber)*p;
763  if ((naMinimalPoly!=NULL)
764  && (p_GetExp(x,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing)))
765    a->z = napRemainder(x, naMinimalPoly);
766  else if (naI!=NULL)
767  {
768    a->z = napRedp(x);
769    if (a->z != NULL)
770      a->z = napTailred (a->z);
771  }
772  else
773    a->z = x;
774  if(a->z==NULL)
775  {
776    omFreeBin((ADDRESS)*p, rnumber_bin);
777    *p=NULL;
778  }
779  else
780  {
781    a->n = NULL;
782    a->s = 0;
783    naTest(*p);
784  }
785  return s;
786}
787
788/*2
789* tries to convert a number to a name
790*/
791char * naName(number n)
792{
793  lnumber ph = (lnumber)n;
794  if (ph==NULL)
795    return NULL;
796  int i;
797  char *s=(char *)omAlloc(4* ntNumbOfPar);
798  char *t=(char *)omAlloc(8);
799  s[0]='\0';
800  for (i = 0; i <= ntNumbOfPar - 1; i++)
801  {
802    int e=p_GetExp(ph->z,i+1,nacRing);
803    if (e > 0)
804    {
805      if (e >1)
806      {
807        sprintf(t,"%s%d",ntParNames[i],e);
808        strcat(s,t);
809      }
810      else
811      {
812        strcat(s,ntParNames[i]);
813      }
814    }
815  }
816  omFreeSize((ADDRESS)t,8);
817  if (s[0]=='\0')
818  {
819    omFree((ADDRESS)s);
820    return NULL;
821  }
822  return s;
823}
824
825/*2
826*  writes a number
827*/
828void naWrite(number &phn, const ring r)
829{
830  lnumber ph = (lnumber)phn;
831  if (ph==NULL)
832    StringAppendS("0");
833  else
834  {
835    phn->s = 0;
836    BOOLEAN has_denom=(ph->n!=NULL);
837    napWrite(ph->z,has_denom/*(ph->n!=NULL)*/,r);
838    if (has_denom/*(ph->n!=NULL)*/)
839    {
840      StringAppendS("/");
841      napWrite(ph->n,TRUE,r);
842    }
843  }
844}
845
846/*2
847* za == 1 ?
848*/
849BOOLEAN naIsOne(number za)
850{
851  lnumber a = (lnumber)za;
852  napoly x, y;
853  number t;
854  if (a==NULL) return FALSE;
855#ifdef LDEBUG
856  omCheckAddrSize(a,sizeof(snumber));
857  if (a->z==NULL)
858  {
859    WerrorS("internal zero error(4)");
860    return FALSE;
861  }
862#endif
863  if (a->n==NULL)
864  {
865    if (p_LmIsConstant(a->z,nacRing))
866    {
867      return nacIsOne(pGetCoeff(a->z));
868    }
869    else                 return FALSE;
870  }
871#if 0
872  x = a->z;
873  y = a->n;
874  do
875  {
876    if (napComp(x, y))
877      return FALSE;
878    else
879    {
880      t = nacSub(pGetCoeff(x), pGetCoeff(y));
881      if (!nacIsZero(t))
882      {
883        n_Delete(&t,nacRing);
884        return FALSE;
885      }
886      else
887        n_Delete(&t,nacRing);
888    }
889    pIter(x);
890    pIter(y);
891  }
892  while ((x!=NULL) && (y!=NULL));
893  if ((x!=NULL) || (y!=NULL)) return FALSE;
894  p_Delete(&a->z,nacRing);
895  p_Delete(&a->n,nacRing);
896  a->z = p_ISet(1,nacRing);
897  a->n = NULL;
898  return TRUE;
899#else
900  return FALSE;
901#endif
902}
903
904/*2
905* za == -1 ?
906*/
907BOOLEAN naIsMOne(number za)
908{
909  lnumber a = (lnumber)za;
910  napoly x, y;
911  number t;
912  if (a==NULL) return FALSE;
913#ifdef LDEBUG
914  omCheckAddrSize(a,sizeof(snumber));
915  if (a->z==NULL)
916  {
917    WerrorS("internal zero error(5)");
918    return FALSE;
919  }
920#endif
921  if (a->n==NULL)
922  {
923    if (p_LmIsConstant(a->z,nacRing)) return n_IsMOne(pGetCoeff(a->z),nacRing);
924    /*else                   return FALSE;*/
925  }
926  return FALSE;
927}
928
929/*2
930* returns the i-th power of p (i>=0)
931*/
932void naPower(number p, int i, number *rc)
933{
934  number x;
935  *rc = naInit(1,currRing);
936  for (; i > 0; i--)
937  {
938    x = naMult(*rc, p);
939    naDelete(rc,currRing);
940    *rc = x;
941  }
942}
943
944/*2
945* result =gcd(a,b)
946*/
947number naGcd(number a, number b, const ring r)
948{
949  if (a==NULL)  return naCopy(b);
950  if (b==NULL)  return naCopy(a);
951
952  lnumber x, y;
953  lnumber result = (lnumber)omAlloc0Bin(rnumber_bin);
954
955  x = (lnumber)a;
956  y = (lnumber)b;
957  if ((ntNumbOfPar == 1) && (naMinimalPoly!=NULL))
958  {
959    if (pNext(x->z)!=NULL)
960      result->z = p_Copy(x->z, r->algring);
961    else
962      result->z = napGcd0(x->z, y->z);
963  }
964  else
965#ifndef HAVE_FACTORY
966    result->z = napGcd(x->z, y->z); // change from napGcd0
967#else
968  {
969    int c=ABS(nGetChar());
970    if (c==1) c=0;
971    setCharacteristic( c );
972
973    napoly rz=napGcd(x->z, y->z);
974    CanonicalForm F, G, R;
975    R=convSingPFactoryP(rz,r->algring);
976    p_Normalize(x->z,nacRing);
977    F=convSingPFactoryP(x->z,r->algring)/R;
978    p_Normalize(y->z,nacRing);
979    G=convSingPFactoryP(y->z,r->algring)/R;
980    F = gcd( F, G );
981    if (F.isOne())
982      result->z= rz;
983    else
984    {
985      p_Delete(&rz,r->algring);
986      result->z=convFactoryPSingP( F*R,r->algring );
987      p_Normalize(result->z,nacRing);
988    }
989  }
990#endif
991  naTest((number)result);
992  return (number)result;
993}
994
995
996/*2
997* ntNumbOfPar = 1:
998* clears denominator         algebraic case;
999* tries to simplify ratio    transcendental case;
1000*
1001* cancels monomials
1002* occuring in denominator
1003* and enumerator  ?          ntNumbOfPar != 1;
1004*
1005* #defines for Factory:
1006* FACTORY_GCD_TEST: do not apply built in gcd for
1007*   univariate polynomials, always use Factory
1008*/
1009//#define FACTORY_GCD_TEST
1010void naCoefNormalize(number pp)
1011{
1012  if (pp==NULL) return;
1013  lnumber p = (lnumber)pp;
1014  number nz; // all denom. of the numerator
1015  nz=p_GetAllDenom(p->z,nacRing);
1016  BOOLEAN norm=FALSE;
1017  if (!n_IsOne(nz,nacRing))
1018  {
1019    norm=TRUE;
1020    p->z=p_Mult_nn(p->z,nz,nacRing);
1021    if (p->n==NULL)
1022    {
1023      p->n=p_NSet(nz,nacRing);
1024    }
1025    else
1026    {
1027      p->n=p_Mult_nn(p->n,nz,nacRing);
1028      n_Delete(&nz, nacRing);
1029    }
1030  }
1031  else
1032  {
1033    n_Delete(&nz, nacRing);
1034  }
1035  if (norm)
1036  {
1037    norm=FALSE;
1038    p_Normalize(p->z,nacRing);
1039    p_Normalize(p->n,nacRing);
1040  }
1041  number nn;
1042  nn=p_GetAllDenom(p->n,nacRing);
1043  if (!n_IsOne(nn,nacRing))
1044  {
1045    norm=TRUE;
1046    p->n=p_Mult_nn(p->n,nn,nacRing);
1047    p->z=p_Mult_nn(p->z,nn,nacRing);
1048    n_Delete(&nn, nacRing);
1049  }
1050  else
1051  {
1052    n_Delete(&nn, nacRing);
1053  }
1054  if (norm)
1055  {
1056    p_Normalize(p->z,nacRing);
1057    p_Normalize(p->n,nacRing);
1058  }
1059  // remove common factors in n, z:
1060  if (p->n!=NULL)
1061  {
1062    poly pp=p->z;
1063    nz=n_Copy(pGetCoeff(pp),nacRing);
1064    pIter(pp);
1065    while(pp!=NULL)
1066    {
1067      if (n_IsOne(nz,nacRing)) break;
1068      number d=n_Gcd(nz,pGetCoeff(pp),nacRing);
1069      n_Delete(&nz,nacRing); nz=d;
1070      pIter(pp);
1071    }
1072    if (!n_IsOne(nz,nacRing))
1073    {
1074      pp=p->n;
1075      nn=n_Copy(pGetCoeff(pp),nacRing);
1076      pIter(pp);
1077      while(pp!=NULL)
1078      {
1079        if (n_IsOne(nn,nacRing)) break;
1080        number d=n_Gcd(nn,pGetCoeff(pp),nacRing);
1081        n_Delete(&nn,nacRing); nn=d;
1082        pIter(pp);
1083      }
1084      number ng=n_Gcd(nz,nn,nacRing);
1085      n_Delete(&nn,nacRing);
1086      if (!n_IsOne(ng,nacRing))
1087      {
1088        number ni=n_Invers(ng,nacRing);
1089        p->z=p_Mult_nn(p->z,ni,nacRing);
1090        p->n=p_Mult_nn(p->n,ni,nacRing);
1091        p_Normalize(p->z,nacRing);
1092        p_Normalize(p->n,nacRing);
1093        n_Delete(&ni,nacRing);
1094      }
1095      n_Delete(&ng,nacRing);
1096    }
1097    n_Delete(&nz,nacRing);
1098  }
1099  if (p->n!=NULL)
1100  {
1101    if(!nacGreaterZero(pGetCoeff(p->n)))
1102    {
1103      p->z=napNeg(p->z);
1104      p->n=napNeg(p->n);
1105    }
1106
1107    if (/*(p->n!=NULL) && */
1108    (p_IsConstant(p->n,nacRing))
1109    && (n_IsOne(pGetCoeff(p->n),nacRing)))
1110    {
1111      p_Delete(&(p->n), nacRing);
1112      p->n = NULL;
1113    }
1114  }
1115}
1116
1117void naNormalize(number &pp)
1118{
1119
1120  //naTest(pp); // input may not be "normal"
1121  lnumber p = (lnumber)pp;
1122
1123  if (p==NULL)
1124    return;
1125  naCoefNormalize(pp);
1126  p->s = 2;
1127  napoly x = p->z;
1128  napoly y = p->n;
1129
1130  BOOLEAN norm=FALSE;
1131
1132  if ((y!=NULL) && (naMinimalPoly!=NULL))
1133  {
1134    y = napInvers(y, naMinimalPoly);
1135    x = p_Mult_q(x, y,nacRing);
1136    if (p_GetExp(x,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing))
1137      x = napRemainder(x, naMinimalPoly);
1138    p->z = x;
1139    p->n = y = NULL;
1140    norm=ntIsChar0;
1141  }
1142
1143  /* check for degree of x too high: */
1144  if ((x!=NULL) && (naMinimalPoly!=NULL) && (x!=naMinimalPoly)
1145  && (p_GetExp(x,1,nacRing)>p_GetExp(naMinimalPoly,1,nacRing)))
1146  // DO NOT REDUCE naMinimalPoly with itself
1147  {
1148    x = napRemainder(x, naMinimalPoly);
1149    p->z = x;
1150    norm=ntIsChar0;
1151  }
1152  /* normalize all coefficients in n and z (if in Q) */
1153  if (norm) 
1154  {
1155    naCoefNormalize(pp);
1156    x = p->z;
1157    y = p->n;
1158  }
1159  if (y==NULL) return;
1160
1161  if ((naMinimalPoly == NULL) && (x!=NULL) && (y!=NULL))
1162  {
1163    int i;
1164    for (i=ntNumbOfPar-1; i>=0; i--)
1165    {
1166      napoly xx=x;
1167      napoly yy=y;
1168      int m = napExpi(i, yy, xx);
1169      if (m != 0)          // in this case xx!=NULL!=yy
1170      {
1171        while (xx != NULL)
1172        {
1173          napAddExp(xx,i+1, -m);
1174          pIter(xx);
1175        }
1176        while (yy != NULL)
1177        {
1178          napAddExp(yy,i+1, -m);
1179          pIter(yy);
1180        }
1181      }
1182    }
1183  }
1184  if (p_LmIsConstant(y,nacRing)) /* i.e. => simplify to (1/c)*z / monom */
1185  {
1186    if (nacIsOne(pGetCoeff(y)))
1187    {
1188      p_LmDelete(&y,nacRing);
1189      p->n = NULL;
1190      naTest(pp);
1191      return;
1192    }
1193    number h1 = nacInvers(pGetCoeff(y));
1194    nacNormalize(h1);
1195    napMultN(x, h1);
1196    n_Delete(&h1,nacRing);
1197    p_LmDelete(&y,nacRing);
1198    p->n = NULL;
1199    naTest(pp);
1200    return;
1201  }
1202#ifndef FACTORY_GCD_TEST
1203  if (ntNumbOfPar == 1) /* apply built-in gcd */
1204  {
1205    napoly x1,y1;
1206    if (p_GetExp(x,1,nacRing) >= p_GetExp(y,1,nacRing))
1207    {
1208      x1 = napCopy(x);
1209      y1 = napCopy(y);
1210    }
1211    else
1212    {
1213      x1 = napCopy(y);
1214      y1 = napCopy(x);
1215    }
1216    napoly r;
1217    loop
1218    {
1219      r = napRemainder(x1, y1);
1220      if ((r==NULL) || (pNext(r)==NULL)) break;
1221      x1 = y1;
1222      y1 = r;
1223    }
1224    if (r!=NULL)
1225    {
1226      p_Delete(&r,nacRing);
1227      p_Delete(&y1,nacRing);
1228    }
1229    else
1230    {
1231      napDivMod(x, y1, &(p->z), &r);
1232      napDivMod(y, y1, &(p->n), &r);
1233      p_Delete(&y1,nacRing);
1234    }
1235    x = p->z;
1236    y = p->n;
1237    /* collect all denoms from y and multiply x and y by it */
1238    if (ntIsChar0)
1239    {
1240      number n=napLcm(y);
1241      napMultN(x,n);
1242      napMultN(y,n);
1243      n_Delete(&n,nacRing);
1244      while(x!=NULL)
1245      {
1246        nacNormalize(pGetCoeff(x));
1247        pIter(x);
1248      }
1249      x = p->z;
1250      while(y!=NULL)
1251      {
1252        nacNormalize(pGetCoeff(y));
1253        pIter(y);
1254      }
1255      y = p->n;
1256    }
1257    if (pNext(y)==NULL)
1258    {
1259      if (nacIsOne(pGetCoeff(y)))
1260      {
1261        if (p_GetExp(y,1,nacRing)==0)
1262        {
1263          p_LmDelete(&y,nacRing);
1264          p->n = NULL;
1265        }
1266        naTest(pp);
1267        return;
1268      }
1269    }
1270  }
1271#endif /* FACTORY_GCD_TEST */
1272#ifdef HAVE_FACTORY
1273#ifndef FACTORY_GCD_TEST
1274  else
1275#endif
1276  {
1277    napoly xx,yy;
1278    singclap_algdividecontent(x,y,xx,yy);
1279    if (xx!=NULL)
1280    {
1281      p->z=xx;
1282      p->n=yy;
1283      p_Delete(&x,nacRing);
1284      p_Delete(&y,nacRing);
1285    }
1286  }
1287#endif
1288  /* remove common factors from z and n */
1289  x=p->z;
1290  y=p->n;
1291  if(!nacGreaterZero(pGetCoeff(y)))
1292  {
1293    x=napNeg(x);
1294    y=napNeg(y);
1295  }
1296  number g=nacCopy(pGetCoeff(x));
1297  pIter(x);
1298  while (x!=NULL)
1299  {
1300    number d=nacGcd(g,pGetCoeff(x), nacRing);
1301    if(nacIsOne(d))
1302    {
1303      n_Delete(&g,nacRing);
1304      n_Delete(&d,nacRing);
1305      naTest(pp);
1306      return;
1307    }
1308    n_Delete(&g,nacRing);
1309    g = d;
1310    pIter(x);
1311  }
1312  while (y!=NULL)
1313  {
1314    number d=nacGcd(g,pGetCoeff(y), nacRing);
1315    if(nacIsOne(d))
1316    {
1317      n_Delete(&g,nacRing);
1318      n_Delete(&d,nacRing);
1319      naTest(pp);
1320      return;
1321    }
1322    n_Delete(&g,nacRing);
1323    g = d;
1324    pIter(y);
1325  }
1326  x=p->z;
1327  y=p->n;
1328  while (x!=NULL)
1329  {
1330    number d = nacIntDiv(pGetCoeff(x),g);
1331    napSetCoeff(x,d);
1332    pIter(x);
1333  }
1334  while (y!=NULL)
1335  {
1336    number d = nacIntDiv(pGetCoeff(y),g);
1337    napSetCoeff(y,d);
1338    pIter(y);
1339  }
1340  n_Delete(&g,nacRing);
1341  naTest(pp);
1342}
1343
1344/*2
1345* returns in result->n 1
1346* and in     result->z the lcm(a->z,b->n)
1347*/
1348number naLcm(number la, number lb, const ring r)
1349{
1350  lnumber result;
1351  lnumber a = (lnumber)la;
1352  lnumber b = (lnumber)lb;
1353  result = (lnumber)omAlloc0Bin(rnumber_bin);
1354  naTest(la);
1355  naTest(lb);
1356  napoly x = p_Copy(a->z, r->algring);
1357  number t = napLcm(b->z); // get all denom of b->z
1358  if (!nacIsOne(t))
1359  {
1360    number bt, rr;
1361    napoly xx=x;
1362    while (xx!=NULL)
1363    {
1364      bt = nacGcd(t, pGetCoeff(xx), r->algring);
1365      rr = nacMult(t, pGetCoeff(xx));
1366      n_Delete(&pGetCoeff(xx),r->algring);
1367      pGetCoeff(xx) = nacDiv(rr, bt);
1368      nacNormalize(pGetCoeff(xx));
1369      n_Delete(&bt,r->algring);
1370      n_Delete(&rr,r->algring);
1371      pIter(xx);
1372    }
1373  }
1374  n_Delete(&t,r->algring);
1375  result->z = x;
1376#ifdef HAVE_FACTORY
1377  if (b->n!=NULL)
1378  {
1379    result->z=singclap_alglcm(result->z,b->n);
1380    p_Delete(&x,r->algring);
1381  }
1382#endif
1383  naTest(la);
1384  naTest(lb);
1385  naTest((number)result);
1386  return ((number)result);
1387}
1388
1389/*2
1390* input: a set of constant polynomials
1391* sets the global variable naI
1392*/
1393void naSetIdeal(ideal I)
1394{
1395  int i;
1396
1397  if (idIs0(I))
1398  {
1399    for (i=naI->anz-1; i>=0; i--)
1400      p_Delete(&naI->liste[i],nacRing);
1401    omFreeBin((ADDRESS)naI, snaIdeal_bin);
1402    naI=NULL;
1403  }
1404  else
1405  {
1406    lnumber h;
1407    number a;
1408    napoly x;
1409
1410    naI=(naIdeal)omAllocBin(snaIdeal_bin);
1411    naI->anz=IDELEMS(I);
1412    naI->liste=(napoly*)omAlloc(naI->anz*sizeof(napoly));
1413    for (i=IDELEMS(I)-1; i>=0; i--)
1414    {
1415      h=(lnumber)pGetCoeff(I->m[i]);
1416      /* We only need the enumerator of h, as we expect it to be a polynomial */
1417      naI->liste[i]=napCopy(h->z);
1418      /* If it isn't normalized (lc = 1) do this */
1419      if (!nacIsOne(pGetCoeff(naI->liste[i])))
1420      {
1421        x=naI->liste[i];
1422        nacNormalize(pGetCoeff(x));
1423        a=nacCopy(pGetCoeff(x));
1424        number aa=nacInvers(a);
1425        n_Delete(&a,nacRing);
1426        napMultN(x,aa);
1427        n_Delete(&aa,nacRing);
1428      }
1429    }
1430  }
1431}
1432
1433/*2
1434* map Z/p -> Q(a)
1435*/
1436number naMapP0(number c)
1437{
1438  if (npIsZero(c)) return NULL;
1439  lnumber l=(lnumber)omAllocBin(rnumber_bin);
1440  l->s=2;
1441  l->z=(napoly)p_Init(nacRing);
1442  int i=(int)((long)c);
1443  if (i>((long)ntMapRing->ch>>2)) i-=(long)ntMapRing->ch;
1444  pGetCoeff(l->z)=nlInit(i, nacRing);
1445  l->n=NULL;
1446  return (number)l;
1447}
1448
1449/*2
1450* map Q -> Q(a)
1451*/
1452number naMap00(number c)
1453{
1454  if (nlIsZero(c)) return NULL;
1455  lnumber l=(lnumber)omAllocBin(rnumber_bin);
1456  l->s=0;
1457  l->z=(napoly)p_Init(nacRing);
1458  pGetCoeff(l->z)=nlCopy(c);
1459  l->n=NULL;
1460  return (number)l;
1461}
1462
1463/*2
1464* map Z/p -> Z/p(a)
1465*/
1466number naMapPP(number c)
1467{
1468  if (npIsZero(c)) return NULL;
1469  lnumber l=(lnumber)omAllocBin(rnumber_bin);
1470  l->s=2;
1471  l->z=(napoly)p_Init(nacRing);
1472  pGetCoeff(l->z)=c; /* omit npCopy, because npCopy is a no-op */
1473  l->n=NULL;
1474  return (number)l;
1475}
1476
1477/*2
1478* map Z/p' -> Z/p(a)
1479*/
1480number naMapPP1(number c)
1481{
1482  if (npIsZero(c)) return NULL;
1483  int i=(int)((long)c);
1484  if (i>(long)ntMapRing->ch) i-=(long)ntMapRing->ch;
1485  number n=npInit(i,ntMapRing);
1486  if (npIsZero(n)) return NULL;
1487  lnumber l=(lnumber)omAllocBin(rnumber_bin);
1488  l->s=2;
1489  l->z=(napoly)p_Init(nacRing);
1490  pGetCoeff(l->z)=n;
1491  l->n=NULL;
1492  return (number)l;
1493}
1494
1495/*2
1496* map Q -> Z/p(a)
1497*/
1498number naMap0P(number c)
1499{
1500  if (nlIsZero(c)) return NULL;
1501  number n=npInit(nlModP(c,npPrimeM),nacRing);
1502  if (npIsZero(n)) return NULL;
1503  npTest(n);
1504  lnumber l=(lnumber)omAllocBin(rnumber_bin);
1505  l->s=2;
1506  l->z=(napoly)p_Init(nacRing);
1507  pGetCoeff(l->z)=n;
1508  l->n=NULL;
1509  return (number)l;
1510}
1511
1512/*2
1513* map _(a) -> _(b)
1514*/
1515number naMapQaQb(number c)
1516{
1517  if (c==NULL) return NULL;
1518  lnumber erg= (lnumber)omAlloc0Bin(rnumber_bin);
1519  lnumber src =(lnumber)c;
1520  erg->s=src->s;
1521  erg->z=napMap(src->z);
1522  erg->n=napMap(src->n);
1523  if (naMinimalPoly!=NULL)
1524  {
1525    if (p_GetExp(erg->z,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing))
1526    {
1527      erg->z = napRemainder(erg->z, naMinimalPoly);
1528      if (erg->z==NULL)
1529      {
1530        number t_erg=(number)erg;
1531        naDelete(&t_erg,currRing);
1532        return (number)NULL;
1533      }
1534    }
1535    if (erg->n!=NULL)
1536    {
1537      if (p_GetExp(erg->n,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing))
1538        erg->n = napRemainder(erg->n, naMinimalPoly);
1539      if ((p_IsConstant(erg->n,nacRing)) && nacIsOne(pGetCoeff(erg->n)))
1540        p_Delete(&(erg->n),nacRing);
1541    }
1542  }
1543  return (number)erg;
1544}
1545
1546nMapFunc naSetMap(const ring src, const ring dst)
1547{
1548  ntMapRing=src;
1549  if (rField_is_Q_a(dst)) /* -> Q(a) */
1550  {
1551    if (rField_is_Q(src))
1552    {
1553      return naMap00;   /*Q -> Q(a)*/
1554    }
1555    if (rField_is_Zp(src))
1556    {
1557      return naMapP0;  /* Z/p -> Q(a)*/
1558    }
1559    if (rField_is_Q_a(src))
1560    {
1561      int i;
1562      ntParsToCopy=0;
1563      for(i=0;i<rPar(src);i++)
1564      {
1565        if ((i>=rPar(dst))
1566        ||(strcmp(src->parameter[i],dst->parameter[i])!=0))
1567           return NULL;
1568        ntParsToCopy++;
1569      }
1570      nacMap=nacCopy;
1571      if ((ntParsToCopy==rPar(dst))&&(ntParsToCopy==rPar(src)))
1572        return naCopy;    /* Q(a) -> Q(a) */
1573      return naMapQaQb;   /* Q(a..) -> Q(a..) */
1574    }
1575  }
1576  /*-----------------------------------------------------*/
1577  if (rField_is_Zp_a(dst)) /* -> Z/p(a) */
1578  {
1579    if (rField_is_Q(src))
1580    {
1581      return naMap0P;   /*Q -> Z/p(a)*/
1582    }
1583    if (rField_is_Zp(src))
1584    {
1585      if (src->ch==dst->ch)
1586      {
1587        return naMapPP;  /* Z/p -> Z/p(a)*/
1588      }
1589      else
1590      {
1591        return naMapPP1;  /* Z/p' -> Z/p(a)*/
1592      }
1593    }
1594    if (rField_is_Zp_a(src))
1595    {
1596      if (rChar(src)==rChar(dst))
1597      {
1598        nacMap=nacCopy;
1599      }
1600      else
1601      {
1602        nacMap = npMapP;
1603      }
1604      int i;
1605      ntParsToCopy=0;
1606      for(i=0;i<rPar(src);i++)
1607      {
1608        if ((i>=rPar(dst))
1609        ||(strcmp(src->parameter[i],dst->parameter[i])!=0))
1610           return NULL;
1611        ntParsToCopy++;
1612      }
1613      if ((ntParsToCopy==rPar(dst))&&(ntParsToCopy==rPar(src))
1614      && (nacMap==nacCopy))
1615        return naCopy;    /* Z/p(a) -> Z/p(a) */
1616      return naMapQaQb;   /* Z/p(a),Z/p'(a) -> Z/p(b)*/
1617    }
1618  }
1619  return NULL;      /* default */
1620}
1621
1622#ifdef LDEBUG
1623BOOLEAN naDBTest(number a, const char *f,const int l)
1624{
1625  lnumber x=(lnumber)a;
1626  if (x == NULL)
1627    return TRUE;
1628  #ifdef LDEBUG
1629  omCheckAddrSize(a, sizeof(snumber));
1630  #endif
1631  napoly p = x->z;
1632  if (p==NULL)
1633  {
1634    Print("0/* in %s:%d\n",f,l);
1635    return FALSE;
1636  }
1637  while(p!=NULL)
1638  {
1639    if (( ntIsChar0  && nlIsZero(pGetCoeff(p)))
1640    || ((!ntIsChar0) && npIsZero(pGetCoeff(p))))
1641    {
1642      Print("coeff 0 in %s:%d\n",f,l);
1643      return FALSE;
1644    }
1645    if((naMinimalPoly!=NULL)
1646    &&(p_GetExp(p,1,nacRing)>p_GetExp(naMinimalPoly,1,nacRing))
1647    &&(p!=naMinimalPoly))
1648    {
1649      Print("deg>minpoly in %s:%d\n",f,l);
1650      return FALSE;
1651    }
1652    //if (ntIsChar0 && (((int)p->ko &3) == 0) && (p->ko->s==0) && (x->s==2))
1653    //{
1654    //  Print("normalized with non-normal coeffs in %s:%d\n",f,l);
1655    //  return FALSE;
1656    //}
1657    if (ntIsChar0 && !(nlDBTest(pGetCoeff(p),f,l)))
1658      return FALSE;
1659    pIter(p);
1660  }
1661  p = x->n;
1662  while(p!=NULL)
1663  {
1664    if (ntIsChar0 && !(nlDBTest(pGetCoeff(p),f,l)))
1665      return FALSE;
1666    pIter(p);
1667  }
1668  return TRUE;
1669}
1670#endif
Note: See TracBrowser for help on using the repository browser.