source: git/kernel/longalg.cc @ 528f5b7

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