source: git/Singular/longalg.cc @ 48c165a

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