source: git/libpolys/polys/ext_fields/algext.cc @ b69433

spielwiese
Last change on this file since b69433 was b69433, checked in by Hans Schoenemann <hannes@…>, 4 years ago
opt: n_SetMap(A,B): for A==B always return ndCopyMap
  • Property mode set to 100644
File size: 47.8 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/**
5  * ABSTRACT: numbers in an algebraic extension field K[a] / < f(a) >
6  *           Assuming that we have a coeffs object cf, then these numbers
7  *           are polynomials in the polynomial ring K[a] represented by
8  *           cf->extRing.
9  *           IMPORTANT ASSUMPTIONS:
10  *           1.) So far we assume that cf->extRing is a valid polynomial
11  *               ring in exactly one variable, i.e., K[a], where K is allowed
12  *               to be any field (representable in SINGULAR and which may
13  *               itself be some extension field, thus allowing for extension
14  *               towers).
15  *           2.) Moreover, this implementation assumes that
16  *               cf->extRing->qideal is not NULL but an ideal with at
17  *               least one non-zero generator which may be accessed by
18  *               cf->extRing->qideal->m[0] and which represents the minimal
19  *               polynomial f(a) of the extension variable 'a' in K[a].
20  *           3.) As soon as an std method for polynomial rings becomes
21  *               availabe, all reduction steps modulo f(a) should be replaced
22  *               by a call to std. Moreover, in this situation one can finally
23  *               move from K[a] / < f(a) > to
24  *                  K[a_1, ..., a_s] / I, with I some zero-dimensional ideal
25  *                                        in K[a_1, ..., a_s] given by a lex
26  *                                        Gröbner basis.
27  *               The code in algext.h and algext.cc is then capable of
28  *               computing in K[a_1, ..., a_s] / I.
29  **/
30
31#include "misc/auxiliary.h"
32
33#include "reporter/reporter.h"
34
35#include "coeffs/coeffs.h"
36#include "coeffs/numbers.h"
37#include "coeffs/longrat.h"
38
39#include "polys/monomials/ring.h"
40#include "polys/monomials/p_polys.h"
41#include "polys/simpleideals.h"
42#include "polys/PolyEnumerator.h"
43
44#include "factory/factory.h"
45#include "polys/clapconv.h"
46#include "polys/clapsing.h"
47#include "polys/prCopy.h"
48
49#include "polys/ext_fields/algext.h"
50#define TRANSEXT_PRIVATES 1
51#include "polys/ext_fields/transext.h"
52
53#ifdef LDEBUG
54#define naTest(a) naDBTest(a,__FILE__,__LINE__,cf)
55BOOLEAN  naDBTest(number a, const char *f, const int l, const coeffs r);
56#else
57#define naTest(a) do {} while (0)
58#endif
59
60/* polynomial ring in which our numbers live */
61#define naRing cf->extRing
62
63/* coeffs object in which the coefficients of our numbers live;
64 * methods attached to naCoeffs may be used to compute with the
65 * coefficients of our numbers, e.g., use naCoeffs->nAdd to add
66 * coefficients of our numbers */
67#define naCoeffs cf->extRing->cf
68
69/* minimal polynomial */
70#define naMinpoly naRing->qideal->m[0]
71
72/// forward declarations
73BOOLEAN  naGreaterZero(number a, const coeffs cf);
74BOOLEAN  naGreater(number a, number b, const coeffs cf);
75BOOLEAN  naEqual(number a, number b, const coeffs cf);
76BOOLEAN  naIsOne(number a, const coeffs cf);
77BOOLEAN  naIsMOne(number a, const coeffs cf);
78number   naInit(long i, const coeffs cf);
79number   naNeg(number a, const coeffs cf);
80number   naInvers(number a, const coeffs cf);
81number   naAdd(number a, number b, const coeffs cf);
82number   naSub(number a, number b, const coeffs cf);
83number   naMult(number a, number b, const coeffs cf);
84number   naDiv(number a, number b, const coeffs cf);
85void     naPower(number a, int exp, number *b, const coeffs cf);
86number   naCopy(number a, const coeffs cf);
87void     naWriteLong(number a, const coeffs cf);
88void     naWriteShort(number a, const coeffs cf);
89number   naGetDenom(number &a, const coeffs cf);
90number   naGetNumerator(number &a, const coeffs cf);
91number   naGcd(number a, number b, const coeffs cf);
92void     naDelete(number *a, const coeffs cf);
93void     naCoeffWrite(const coeffs cf, BOOLEAN details);
94//number   naIntDiv(number a, number b, const coeffs cf);
95const char * naRead(const char *s, number *a, const coeffs cf);
96
97static BOOLEAN naCoeffIsEqual(const coeffs cf, n_coeffType n, void * param);
98
99
100/// returns NULL if p == NULL, otherwise makes p monic by dividing
101///   by its leading coefficient (only done if this is not already 1);
102///   this assumes that we are over a ground field so that division
103///   is well-defined;
104///   modifies p
105// void      p_Monic(poly p, const ring r);
106
107///   assumes that p and q are univariate polynomials in r,
108///   mentioning the same variable;
109///   assumes a global monomial ordering in r;
110///   assumes that not both p and q are NULL;
111///   returns the gcd of p and q;
112///   leaves p and q unmodified
113// poly      p_Gcd(const poly p, const poly q, const ring r);
114
115/* returns NULL if p == NULL, otherwise makes p monic by dividing
116   by its leading coefficient (only done if this is not already 1);
117   this assumes that we are over a ground field so that division
118   is well-defined;
119   modifies p */
120static inline void p_Monic(poly p, const ring r)
121{
122  if (p == NULL) return;
123  number n = n_Init(1, r->cf);
124  if (p->next==NULL) { p_SetCoeff(p,n,r); return; }
125  poly pp = p;
126  number lc = p_GetCoeff(p, r);
127  if (n_IsOne(lc, r->cf)) return;
128  number lcInverse = n_Invers(lc, r->cf);
129  p_SetCoeff(p, n, r);   // destroys old leading coefficient!
130  pIter(p);
131  while (p != NULL)
132  {
133    number n = n_Mult(p_GetCoeff(p, r), lcInverse, r->cf);
134    n_Normalize(n,r->cf);
135    p_SetCoeff(p, n, r);   // destroys old leading coefficient!
136    pIter(p);
137  }
138  n_Delete(&lcInverse, r->cf);
139  p = pp;
140}
141
142/// see p_Gcd;
143///   additional assumption: deg(p) >= deg(q);
144///   must destroy p and q (unless one of them is returned)
145static inline poly p_GcdHelper(poly &p, poly &q, const ring r)
146{
147  while (q != NULL)
148  {
149    p_PolyDiv(p, q, FALSE, r);
150    // swap p and q:
151    poly& t = q;
152    q = p;
153    p = t;
154
155  }
156  return p;
157}
158
159/* assumes that p and q are univariate polynomials in r,
160   mentioning the same variable;
161   assumes a global monomial ordering in r;
162   assumes that not both p and q are NULL;
163   returns the gcd of p and q;
164   leaves p and q unmodified */
165static inline poly      p_Gcd(const poly p, const poly q, const ring r)
166{
167  assume((p != NULL) || (q != NULL));
168
169  poly a = p; poly b = q;
170  if (p_Deg(a, r) < p_Deg(b, r)) { a = q; b = p; }
171  a = p_Copy(a, r); b = p_Copy(b, r);
172
173  /* We have to make p monic before we return it, so that if the
174     gcd is a unit in the ground field, we will actually return 1. */
175  a = p_GcdHelper(a, b, r);
176  p_Monic(a, r);
177  return a;
178}
179
180/* see p_ExtGcd;
181   additional assumption: deg(p) >= deg(q);
182   must destroy p and q (unless one of them is returned) */
183static inline poly p_ExtGcdHelper(poly &p, poly &pFactor, poly &q, poly &qFactor,
184                                  ring r)
185{
186  if (q == NULL)
187  {
188    qFactor = NULL;
189    pFactor = p_ISet(1, r);
190    p_SetCoeff(pFactor, n_Invers(p_GetCoeff(p, r), r->cf), r);
191    p_Monic(p, r);
192    return p;
193  }
194  else
195  {
196    poly pDivQ = p_PolyDiv(p, q, TRUE, r);
197    poly ppFactor = NULL; poly qqFactor = NULL;
198    poly theGcd = p_ExtGcdHelper(q, qqFactor, p, ppFactor, r);
199    pFactor = ppFactor;
200    qFactor = p_Add_q(qqFactor,
201                      p_Neg(p_Mult_q(pDivQ, p_Copy(ppFactor, r), r), r),
202                      r);
203    return theGcd;
204  }
205}
206
207
208/* assumes that p and q are univariate polynomials in r,
209   mentioning the same variable;
210   assumes a global monomial ordering in r;
211   assumes that not both p and q are NULL;
212   returns the gcd of p and q;
213   moreover, afterwards pFactor and qFactor contain appropriate
214   factors such that gcd(p, q) = p * pFactor + q * qFactor;
215   leaves p and q unmodified */
216poly p_ExtGcd(poly p, poly &pFactor, poly q, poly &qFactor, ring r)
217{
218  assume((p != NULL) || (q != NULL));
219  poly a = p; poly b = q; BOOLEAN aCorrespondsToP = TRUE;
220  if (p_Deg(a, r) < p_Deg(b, r))
221    { a = q; b = p; aCorrespondsToP = FALSE; }
222  a = p_Copy(a, r); b = p_Copy(b, r);
223  poly aFactor = NULL; poly bFactor = NULL;
224  poly theGcd = p_ExtGcdHelper(a, aFactor, b, bFactor, r);
225  if (aCorrespondsToP) { pFactor = aFactor; qFactor = bFactor; }
226  else                 { pFactor = bFactor; qFactor = aFactor; }
227  return theGcd;
228}
229
230
231
232#ifdef LDEBUG
233BOOLEAN naDBTest(number a, const char *f, const int l, const coeffs cf)
234{
235  if (a == NULL) return TRUE;
236  p_Test((poly)a, naRing);
237  if (getCoeffType(cf)==n_algExt)
238  {
239    if((((poly)a)!=naMinpoly)
240    && p_Totaldegree((poly)a, naRing) >= p_Totaldegree(naMinpoly, naRing)
241    && (p_Totaldegree((poly)a, naRing)> 1)) // allow to output par(1)
242    {
243      dReportError("deg >= deg(minpoly) in %s:%d\n",f,l);
244      return FALSE;
245    }
246  }
247  return TRUE;
248}
249#endif
250
251void heuristicReduce(poly &p, poly reducer, const coeffs cf);
252void definiteReduce(poly &p, poly reducer, const coeffs cf);
253
254/* returns the bottom field in this field extension tower; if the tower
255   is flat, i.e., if there is no extension, then r itself is returned;
256   as a side-effect, the counter 'height' is filled with the height of
257   the extension tower (in case the tower is flat, 'height' is zero) */
258static coeffs nCoeff_bottom(const coeffs r, int &height)
259{
260  assume(r != NULL);
261  coeffs cf = r;
262  height = 0;
263  while (nCoeff_is_Extension(cf))
264  {
265    assume(cf->extRing != NULL); assume(cf->extRing->cf != NULL);
266    cf = cf->extRing->cf;
267    height++;
268  }
269  return cf;
270}
271
272BOOLEAN naIsZero(number a, const coeffs cf)
273{
274  naTest(a);
275  return (a == NULL);
276}
277
278void naDelete(number * a, const coeffs cf)
279{
280  if (*a == NULL) return;
281  if (((poly)*a)==naMinpoly) { *a=NULL;return;}
282  poly aAsPoly = (poly)(*a);
283  p_Delete(&aAsPoly, naRing);
284  *a = NULL;
285}
286
287BOOLEAN naEqual(number a, number b, const coeffs cf)
288{
289  naTest(a); naTest(b);
290  /// simple tests
291  if (a == NULL) return (b == NULL);
292  if (b == NULL) return (a == NULL);
293  return p_EqualPolys((poly)a,(poly)b,naRing);
294}
295
296number naCopy(number a, const coeffs cf)
297{
298  naTest(a);
299  if (a == NULL) return NULL;
300  if (((poly)a)==naMinpoly) return a;
301  return (number)p_Copy((poly)a, naRing);
302}
303
304number naGetNumerator(number &a, const coeffs cf)
305{
306  return naCopy(a, cf);
307}
308
309number naGetDenom(number &a, const coeffs cf)
310{
311  naTest(a);
312  return naInit(1, cf);
313}
314
315BOOLEAN naIsOne(number a, const coeffs cf)
316{
317  naTest(a);
318  poly aAsPoly = (poly)a;
319  if ((a==NULL) || (!p_IsConstant(aAsPoly, naRing))) return FALSE;
320  return n_IsOne(p_GetCoeff(aAsPoly, naRing), naCoeffs);
321}
322
323BOOLEAN naIsMOne(number a, const coeffs cf)
324{
325  naTest(a);
326  poly aAsPoly = (poly)a;
327  if ((a==NULL) || (!p_IsConstant(aAsPoly, naRing))) return FALSE;
328  return n_IsMOne(p_GetCoeff(aAsPoly, naRing), naCoeffs);
329}
330
331/// this is in-place, modifies a
332number naNeg(number a, const coeffs cf)
333{
334  naTest(a);
335  if (a != NULL) a = (number)p_Neg((poly)a, naRing);
336  return a;
337}
338
339number naInit(long i, const coeffs cf)
340{
341  if (i == 0) return NULL;
342  else        return (number)p_ISet(i, naRing);
343}
344
345long naInt(number &a, const coeffs cf)
346{
347  naTest(a);
348  poly aAsPoly = (poly)a;
349  if(aAsPoly == NULL)
350    return 0;
351  if (!p_IsConstant(aAsPoly, naRing))
352    return 0;
353  assume( aAsPoly != NULL );
354  return n_Int(p_GetCoeff(aAsPoly, naRing), naCoeffs);
355}
356
357/* TRUE iff (a != 0 and (b == 0 or deg(a) > deg(b) or (deg(a)==deg(b) && lc(a)>lc(b))) */
358BOOLEAN naGreater(number a, number b, const coeffs cf)
359{
360  naTest(a); naTest(b);
361  if (naIsZero(a, cf))
362  {
363    if (naIsZero(b, cf)) return FALSE;
364    return !n_GreaterZero(pGetCoeff((poly)b),naCoeffs);
365  }
366  if (naIsZero(b, cf))
367  {
368    return n_GreaterZero(pGetCoeff((poly)a),naCoeffs);
369  }
370  int aDeg = p_Totaldegree((poly)a, naRing);
371  int bDeg = p_Totaldegree((poly)b, naRing);
372  if (aDeg>bDeg) return TRUE;
373  if (aDeg<bDeg) return FALSE;
374  return n_Greater(pGetCoeff((poly)a),pGetCoeff((poly)b),naCoeffs);
375}
376
377/* TRUE iff a != 0 and (LC(a) > 0 or deg(a) > 0) */
378BOOLEAN naGreaterZero(number a, const coeffs cf)
379{
380  naTest(a);
381  if (a == NULL)                                            return FALSE;
382  if (n_GreaterZero(p_GetCoeff((poly)a, naRing), naCoeffs)) return TRUE;
383  if (p_Totaldegree((poly)a, naRing) > 0)                   return TRUE;
384  return FALSE;
385}
386
387void naCoeffWrite(const coeffs cf, BOOLEAN details)
388{
389  assume( cf != NULL );
390
391  const ring A = cf->extRing;
392
393  assume( A != NULL );
394  assume( A->cf != NULL );
395
396  n_CoeffWrite(A->cf, details);
397
398//  rWrite(A);
399
400  const int P = rVar(A);
401  assume( P > 0 );
402
403  PrintS("[");
404
405  for (int nop=0; nop < P; nop ++)
406  {
407    Print("%s", rRingVar(nop, A));
408    if (nop!=P-1) PrintS(", ");
409  }
410
411  PrintS("]/(");
412
413  const ideal I = A->qideal;
414
415  assume( I != NULL );
416  assume( IDELEMS(I) == 1 );
417
418
419  if ( details )
420  {
421    p_Write0( I->m[0], A);
422    PrintS(")");
423  }
424  else
425    PrintS("...)");
426
427/*
428  char *x = rRingVar(0, A);
429
430  Print("//   Coefficients live in the extension field K[%s]/<f(%s)>\n", x, x);
431  Print("//   with the minimal polynomial f(%s) = %s\n", x,
432        p_String(A->qideal->m[0], A));
433  PrintS("//   and K: ");
434*/
435}
436
437number naAdd(number a, number b, const coeffs cf)
438{
439  naTest(a); naTest(b);
440  if (a == NULL) return naCopy(b, cf);
441  if (b == NULL) return naCopy(a, cf);
442  poly aPlusB = p_Add_q(p_Copy((poly)a, naRing),
443                        p_Copy((poly)b, naRing), naRing);
444  //definiteReduce(aPlusB, naMinpoly, cf);
445  return (number)aPlusB;
446}
447
448number naSub(number a, number b, const coeffs cf)
449{
450  naTest(a); naTest(b);
451  if (b == NULL) return naCopy(a, cf);
452  poly minusB = p_Neg(p_Copy((poly)b, naRing), naRing);
453  if (a == NULL) return (number)minusB;
454  poly aMinusB = p_Add_q(p_Copy((poly)a, naRing), minusB, naRing);
455  //definiteReduce(aMinusB, naMinpoly, cf);
456  return (number)aMinusB;
457}
458
459number naMult(number a, number b, const coeffs cf)
460{
461  naTest(a); naTest(b);
462  if ((a == NULL)||(b == NULL)) return NULL;
463  poly aTimesB = pp_Mult_qq((poly)a, (poly)b, naRing);
464  definiteReduce(aTimesB, naMinpoly, cf);
465  p_Normalize(aTimesB,naRing);
466  return (number)aTimesB;
467}
468
469number naDiv(number a, number b, const coeffs cf)
470{
471  naTest(a); naTest(b);
472  if (b == NULL) WerrorS(nDivBy0);
473  if (a == NULL) return NULL;
474  poly bInverse = (poly)naInvers(b, cf);
475  if(bInverse != NULL) // b is non-zero divisor!
476  {
477    poly aDivB = p_Mult_q(p_Copy((poly)a, naRing), bInverse, naRing);
478    definiteReduce(aDivB, naMinpoly, cf);
479    p_Normalize(aDivB,naRing);
480    return (number)aDivB;
481  }
482  return NULL;
483}
484
485/* 0^0 = 0;
486   for |exp| <= 7 compute power by a simple multiplication loop;
487   for |exp| >= 8 compute power along binary presentation of |exp|, e.g.
488      p^13 = p^1 * p^4 * p^8, where we utilise that
489      p^(2^(k+1)) = p^(2^k) * p^(2^k);
490   intermediate reduction modulo the minimal polynomial is controlled by
491   the in-place method heuristicReduce(poly, poly, coeffs); see there.
492*/
493void naPower(number a, int exp, number *b, const coeffs cf)
494{
495  naTest(a);
496
497  /* special cases first */
498  if (a == NULL)
499  {
500    if (exp >= 0) *b = NULL;
501    else          WerrorS(nDivBy0);
502    return;
503  }
504  else if (exp ==  0) { *b = naInit(1, cf); return; }
505  else if (exp ==  1) { *b = naCopy(a, cf); return; }
506  else if (exp == -1) { *b = naInvers(a, cf); return; }
507
508  int expAbs = exp; if (expAbs < 0) expAbs = -expAbs;
509
510  /* now compute a^expAbs */
511  poly pow; poly aAsPoly = (poly)a;
512  if (expAbs <= 7)
513  {
514    pow = p_Copy(aAsPoly, naRing);
515    for (int i = 2; i <= expAbs; i++)
516    {
517      pow = p_Mult_q(pow, p_Copy(aAsPoly, naRing), naRing);
518      heuristicReduce(pow, naMinpoly, cf);
519    }
520    definiteReduce(pow, naMinpoly, cf);
521  }
522  else
523  {
524    pow = p_ISet(1, naRing);
525    poly factor = p_Copy(aAsPoly, naRing);
526    while (expAbs != 0)
527    {
528      if (expAbs & 1)
529      {
530        pow = p_Mult_q(pow, p_Copy(factor, naRing), naRing);
531        heuristicReduce(pow, naMinpoly, cf);
532      }
533      expAbs = expAbs / 2;
534      if (expAbs != 0)
535      {
536        factor = p_Mult_q(factor, p_Copy(factor, naRing), naRing);
537        heuristicReduce(factor, naMinpoly, cf);
538      }
539    }
540    p_Delete(&factor, naRing);
541    definiteReduce(pow, naMinpoly, cf);
542  }
543
544  /* invert if original exponent was negative */
545  number n = (number)pow;
546  if (exp < 0)
547  {
548    number m = naInvers(n, cf);
549    naDelete(&n, cf);
550    n = m;
551  }
552  *b = n;
553}
554
555/* may reduce p modulo the reducer by calling definiteReduce;
556   the decision is made based on the following heuristic
557   (which should also only be changed here in this method):
558      if (deg(p) > 10*deg(reducer) then perform reduction;
559   modifies p */
560void heuristicReduce(poly &p, poly reducer, const coeffs cf)
561{
562  #ifdef LDEBUG
563  p_Test((poly)p, naRing);
564  p_Test((poly)reducer, naRing);
565  #endif
566  if (p_Totaldegree(p, naRing) > 10 * p_Totaldegree(reducer, naRing))
567    definiteReduce(p, reducer, cf);
568}
569
570void naWriteLong(number a, const coeffs cf)
571{
572  naTest(a);
573  if (a == NULL)
574    StringAppendS("0");
575  else
576  {
577    poly aAsPoly = (poly)a;
578    /* basically, just write aAsPoly using p_Write,
579       but use brackets around the output, if a is not
580       a constant living in naCoeffs = cf->extRing->cf */
581    BOOLEAN useBrackets = !(p_IsConstant(aAsPoly, naRing));
582    if (useBrackets) StringAppendS("(");
583    p_String0Long(aAsPoly, naRing, naRing);
584    if (useBrackets) StringAppendS(")");
585  }
586}
587
588void naWriteShort(number a, const coeffs cf)
589{
590  naTest(a);
591  if (a == NULL)
592    StringAppendS("0");
593  else
594  {
595    poly aAsPoly = (poly)a;
596    /* basically, just write aAsPoly using p_Write,
597       but use brackets around the output, if a is not
598       a constant living in naCoeffs = cf->extRing->cf */
599    BOOLEAN useBrackets = !(p_IsConstant(aAsPoly, naRing));
600    if (useBrackets) StringAppendS("(");
601    p_String0Short(aAsPoly, naRing, naRing);
602    if (useBrackets) StringAppendS(")");
603  }
604}
605
606const char * naRead(const char *s, number *a, const coeffs cf)
607{
608  poly aAsPoly;
609  const char * result = p_Read(s, aAsPoly, naRing);
610  if (aAsPoly!=NULL) definiteReduce(aAsPoly, naMinpoly, cf);
611  *a = (number)aAsPoly;
612  return result;
613}
614
615#if 0
616/* implemented by the rule lcm(a, b) = a * b / gcd(a, b) */
617number naLcm(number a, number b, const coeffs cf)
618{
619  naTest(a); naTest(b);
620  if (a == NULL) return NULL;
621  if (b == NULL) return NULL;
622  number theProduct = (number)pp_Mult_qq((poly)a, (poly)b, naRing);
623  /* note that theProduct needs not be reduced w.r.t. naMinpoly;
624     but the final division will take care of the necessary reduction */
625  number theGcd = naGcd(a, b, cf);
626  return naDiv(theProduct, theGcd, cf);
627}
628#endif
629number napNormalizeHelper(number b, const coeffs cf)
630{
631  number h=n_Init(1,naRing->cf);
632  poly bb=(poly)b;
633  number d;
634  while(bb!=NULL)
635  {
636    d=n_NormalizeHelper(h,pGetCoeff(bb), naRing->cf);
637    n_Delete(&h,naRing->cf);
638    h=d;
639    pIter(bb);
640  }
641  return h;
642}
643number naLcmContent(number a, number b, const coeffs cf)
644{
645  if (nCoeff_is_Zp(naRing->cf)) return naCopy(a,cf);
646#if 0
647  else {
648    number g = ndGcd(a, b, cf);
649    return g;
650  }
651#else
652  {
653    a=(number)p_Copy((poly)a,naRing);
654    number t=napNormalizeHelper(b,cf);
655    if(!n_IsOne(t,naRing->cf))
656    {
657      number bt, rr;
658      poly xx=(poly)a;
659      while (xx!=NULL)
660      {
661        bt = n_SubringGcd(t, pGetCoeff(xx), naRing->cf);
662        rr = n_Mult(t, pGetCoeff(xx), naRing->cf);
663        n_Delete(&pGetCoeff(xx),naRing->cf);
664        pGetCoeff(xx) = n_Div(rr, bt, naRing->cf);
665        n_Normalize(pGetCoeff(xx),naRing->cf);
666        n_Delete(&bt,naRing->cf);
667        n_Delete(&rr,naRing->cf);
668        pIter(xx);
669      }
670    }
671    n_Delete(&t,naRing->cf);
672    return (number) a;
673  }
674#endif
675}
676
677/* expects *param to be castable to AlgExtInfo */
678static BOOLEAN naCoeffIsEqual(const coeffs cf, n_coeffType n, void * param)
679{
680  if (n_algExt != n) return FALSE;
681  AlgExtInfo *e = (AlgExtInfo *)param;
682  /* for extension coefficient fields we expect the underlying
683     polynomial rings to be IDENTICAL, i.e. the SAME OBJECT;
684     this expectation is based on the assumption that we have properly
685     registered cf and perform reference counting rather than creating
686     multiple copies of the same coefficient field/domain/ring */
687  if (naRing == e->r)
688    return TRUE;
689  /* (Note that then also the minimal ideals will necessarily be
690     the same, as they are attached to the ring.) */
691
692  // NOTE: Q(a)[x] && Q(a)[y] should better share the _same_ Q(a)...
693  if( rEqual(naRing, e->r, TRUE) ) // also checks the equality of qideals
694  {
695    const ideal mi = naRing->qideal;
696    assume( IDELEMS(mi) == 1 );
697    const ideal ii = e->r->qideal;
698    assume( IDELEMS(ii) == 1 );
699
700    // TODO: the following should be extended for 2 *equal* rings...
701    assume( p_EqualPolys(mi->m[0], ii->m[0], naRing, e->r) );
702
703    rDelete(e->r);
704
705    return TRUE;
706  }
707
708  return FALSE;
709
710}
711
712int naSize(number a, const coeffs cf)
713{
714  if (a == NULL) return 0;
715  poly aAsPoly = (poly)a;
716  int theDegree = 0; int noOfTerms = 0;
717  while (aAsPoly != NULL)
718  {
719    noOfTerms++;
720    int d = p_GetExp(aAsPoly, 1, naRing);
721    if (d > theDegree) theDegree = d;
722    pIter(aAsPoly);
723  }
724  return (theDegree +1) * noOfTerms;
725}
726
727/* performs polynomial division and overrides p by the remainder
728   of division of p by the reducer;
729   modifies p */
730void definiteReduce(poly &p, poly reducer, const coeffs cf)
731{
732  #ifdef LDEBUG
733  p_Test((poly)p, naRing);
734  p_Test((poly)reducer, naRing);
735  #endif
736  if ((p!=NULL) && (p_GetExp(p,1,naRing)>=p_GetExp(reducer,1,naRing)))
737  {
738    p_PolyDiv(p, reducer, FALSE, naRing);
739  }
740}
741
742void  naNormalize(number &a, const coeffs cf)
743{
744  poly aa=(poly)a;
745  if (aa!=naMinpoly)
746    definiteReduce(aa,naMinpoly,cf);
747  a=(number)aa;
748}
749
750number naConvFactoryNSingN( const CanonicalForm n, const coeffs cf)
751{
752  if (n.isZero()) return NULL;
753  poly p=convFactoryPSingP(n,naRing);
754  return (number)p;
755}
756CanonicalForm naConvSingNFactoryN( number n, BOOLEAN /*setChar*/, const coeffs cf )
757{
758  naTest(n);
759  if (n==NULL) return CanonicalForm(0);
760
761  return convSingPFactoryP((poly)n,naRing);
762}
763
764/* IMPORTANT NOTE: Since an algebraic field extension is again a field,
765                   the gcd of two elements is not very interesting. (It
766                   is actually any unit in the field, i.e., any non-
767                   zero element.) Note that the below method does not operate
768                   in this strong sense but rather computes the gcd of
769                   two given elements in the underlying polynomial ring. */
770number naGcd(number a, number b, const coeffs cf)
771{
772  if (a==NULL)  return naCopy(b,cf);
773  if (b==NULL)  return naCopy(a,cf);
774
775  poly ax=(poly)a;
776  poly bx=(poly)b;
777  if (pNext(ax)!=NULL)
778    return (number)p_Copy(ax, naRing);
779  else
780  {
781    if(nCoeff_is_Zp(naRing->cf))
782      return naInit(1,cf);
783    else
784    {
785      number x = n_Copy(pGetCoeff((poly)a),naRing->cf);
786      if (n_IsOne(x,naRing->cf))
787        return (number)p_NSet(x,naRing);
788      while (pNext(ax)!=NULL)
789      {
790        pIter(ax);
791        number y = n_SubringGcd(x, pGetCoeff(ax), naRing->cf);
792        n_Delete(&x,naRing->cf);
793        x = y;
794        if (n_IsOne(x,naRing->cf))
795          return (number)p_NSet(x,naRing);
796      }
797      do
798      {
799        number y = n_SubringGcd(x, pGetCoeff(bx), naRing->cf);
800        n_Delete(&x,naRing->cf);
801        x = y;
802        if (n_IsOne(x,naRing->cf))
803          return (number)p_NSet(x,naRing);
804        pIter(bx);
805      }
806      while (bx!=NULL);
807      return (number)p_NSet(x,naRing);
808    }
809  }
810#if 0
811  naTest(a); naTest(b);
812  const ring R = naRing;
813  return (number) singclap_gcd_r((poly)a, (poly)b, R);
814#endif
815//  return (number)p_Gcd((poly)a, (poly)b, naRing);
816}
817
818number naInvers(number a, const coeffs cf)
819{
820  naTest(a);
821  if (a == NULL) WerrorS(nDivBy0);
822
823  poly aFactor = NULL; poly mFactor = NULL; poly theGcd = NULL;
824// singclap_extgcd!
825  const BOOLEAN ret = singclap_extgcd ((poly)a, naMinpoly, theGcd, aFactor, mFactor, naRing);
826
827  assume( !ret );
828
829//  if( ret ) theGcd = p_ExtGcd((poly)a, aFactor, naMinpoly, mFactor, naRing);
830
831  naTest((number)theGcd); naTest((number)aFactor); naTest((number)mFactor);
832  p_Delete(&mFactor, naRing);
833
834  //  /* the gcd must be 1 since naMinpoly is irreducible and a != NULL: */
835  //  assume(naIsOne((number)theGcd, cf));
836
837  if( !naIsOne((number)theGcd, cf) )
838  {
839    WerrorS("zero divisor found - your minpoly is not irreducible");
840    p_Delete(&aFactor, naRing); aFactor = NULL;
841  }
842  p_Delete(&theGcd, naRing);
843
844  return (number)(aFactor);
845}
846
847/* assumes that src = Q or Z, dst = Q(a) */
848number naMap00(number a, const coeffs src, const coeffs dst)
849{
850  if (n_IsZero(a, src)) return NULL;
851  assume(src->rep == dst->extRing->cf->rep);
852  poly result = p_One(dst->extRing);
853  p_SetCoeff(result, n_Copy(a, src), dst->extRing);
854  return (number)result;
855}
856
857/* assumes that src = Z, dst = K(a) */
858number naMapZ0(number a, const coeffs src, const coeffs dst)
859{
860  if (n_IsZero(a, src)) return NULL;
861  poly result = p_One(dst->extRing);
862  nMapFunc nMap=n_SetMap(src,dst->extRing->cf);
863  p_SetCoeff(result, nMap(a, src, dst->extRing->cf), dst->extRing);
864  if (n_IsZero(pGetCoeff(result),dst->extRing->cf))
865    p_Delete(&result,dst->extRing);
866  return (number)result;
867}
868
869/* assumes that src = Z/p, dst = Q(a) */
870number naMapP0(number a, const coeffs src, const coeffs dst)
871{
872  if (n_IsZero(a, src)) return NULL;
873  /* mapping via intermediate int: */
874  int n = n_Int(a, src);
875  number q = n_Init(n, dst->extRing->cf);
876  poly result = p_One(dst->extRing);
877  p_SetCoeff(result, q, dst->extRing);
878  return (number)result;
879}
880
881#if 0
882/* assumes that either src = Q(a), dst = Q(a), or
883                       src = Z/p(a), dst = Z/p(a)     */
884number naCopyMap(number a, const coeffs src, const coeffs dst)
885{
886  return naCopy(a, dst);
887}
888#endif
889
890number naCopyTrans2AlgExt(number a, const coeffs src, const coeffs dst)
891{
892  assume (nCoeff_is_transExt (src));
893  assume (nCoeff_is_algExt (dst));
894  fraction fa=(fraction)a;
895  poly p, q;
896  if (rSamePolyRep(src->extRing, dst->extRing))
897  {
898    p = p_Copy(NUM(fa),src->extRing);
899    if (!DENIS1(fa))
900    {
901      q = p_Copy(DEN(fa),src->extRing);
902      assume (q != NULL);
903    }
904  }
905  else
906  {
907    assume ((strcmp(rRingVar(0,src->extRing),rRingVar(0,dst->extRing))==0) && (rVar (src->extRing) == rVar (dst->extRing)));
908
909    nMapFunc nMap= n_SetMap (src->extRing->cf, dst->extRing->cf);
910
911    assume (nMap != NULL);
912    p= p_PermPoly (NUM (fa), NULL, src->extRing, dst->extRing,nMap, NULL,rVar (src->extRing));
913    if (!DENIS1(fa))
914    {
915      q= p_PermPoly (DEN (fa), NULL, src->extRing, dst->extRing,nMap, NULL,rVar (src->extRing));
916      assume (q != NULL);
917    }
918  }
919  definiteReduce(p, dst->extRing->qideal->m[0], dst);
920  p_Test (p, dst->extRing);
921  if (!DENIS1(fa))
922  {
923    definiteReduce(q, dst->extRing->qideal->m[0], dst);
924    p_Test (q, dst->extRing);
925    if (q != NULL)
926    {
927      number t= naDiv ((number)p,(number)q, dst);
928      p_Delete (&p, dst->extRing);
929      p_Delete (&q, dst->extRing);
930      return t;
931    }
932    WerrorS ("mapping denominator to zero");
933  }
934  return (number) p;
935}
936
937/* assumes that src = Q, dst = Z/p(a) */
938number naMap0P(number a, const coeffs src, const coeffs dst)
939{
940  if (n_IsZero(a, src)) return NULL;
941  // int p = rChar(dst->extRing);
942
943  number q = nlModP(a, src, dst->extRing->cf); // FIXME? TODO? // extern number nlModP(number q, const coeffs Q, const coeffs Zp); // Map q \in QQ \to pZ
944
945  poly result = p_NSet(q, dst->extRing);
946
947  return (number)result;
948}
949
950/* assumes that src = Z/p, dst = Z/p(a) */
951number naMapPP(number a, const coeffs src, const coeffs dst)
952{
953  if (n_IsZero(a, src)) return NULL;
954  assume(src == dst->extRing->cf);
955  poly result = p_One(dst->extRing);
956  p_SetCoeff(result, n_Copy(a, src), dst->extRing);
957  return (number)result;
958}
959
960/* assumes that src = Z/u, dst = Z/p(a), where u != p */
961number naMapUP(number a, const coeffs src, const coeffs dst)
962{
963  if (n_IsZero(a, src)) return NULL;
964  /* mapping via intermediate int: */
965  int n = n_Int(a, src);
966  number q = n_Init(n, dst->extRing->cf);
967  poly result = p_One(dst->extRing);
968  p_SetCoeff(result, q, dst->extRing);
969  return (number)result;
970}
971
972number naGenMap(number a, const coeffs cf, const coeffs dst)
973{
974  if (a==NULL) return NULL;
975
976  const ring rSrc = cf->extRing;
977  const ring rDst = dst->extRing;
978
979  const nMapFunc nMap=n_SetMap(rSrc->cf,rDst->cf);
980  poly f = (poly)a;
981  poly g = prMapR(f, nMap, rSrc, rDst);
982
983  n_Test((number)g, dst);
984  return (number)g;
985}
986
987number naGenTrans2AlgExt(number a, const coeffs cf, const coeffs dst)
988{
989  if (a==NULL) return NULL;
990
991  const ring rSrc = cf->extRing;
992  const ring rDst = dst->extRing;
993
994  const nMapFunc nMap=n_SetMap(rSrc->cf,rDst->cf);
995  fraction f = (fraction)a;
996  poly g = prMapR(NUM(f), nMap, rSrc, rDst);
997
998  number result=NULL;
999  poly h = NULL;
1000
1001  if (!DENIS1(f))
1002     h = prMapR(DEN(f), nMap, rSrc, rDst);
1003
1004  if (h!=NULL)
1005  {
1006    result=naDiv((number)g,(number)h,dst);
1007    p_Delete(&g,dst->extRing);
1008    p_Delete(&h,dst->extRing);
1009  }
1010  else
1011    result=(number)g;
1012
1013  n_Test((number)result, dst);
1014  return (number)result;
1015}
1016
1017nMapFunc naSetMap(const coeffs src, const coeffs dst)
1018{
1019  /* dst is expected to be an algebraic field extension */
1020  assume(getCoeffType(dst) == n_algExt);
1021
1022  int h = 0; /* the height of the extension tower given by dst */
1023  coeffs bDst = nCoeff_bottom(dst, h); /* the bottom field in the tower dst */
1024  coeffs bSrc = nCoeff_bottom(src, h); /* the bottom field in the tower src */
1025
1026  /* for the time being, we only provide maps if h = 1 or 0 */
1027  if (h==0)
1028  {
1029    if ((src->rep==n_rep_gap_rat) && nCoeff_is_Q(bDst))
1030      return naMap00;                            /// Q or Z     -->  Q(a)
1031    if ((src->rep==n_rep_gap_gmp) && nCoeff_is_Q(bDst))
1032      return naMapZ0;                            /// Z     -->  Q(a)
1033    if (nCoeff_is_Zp(src) && nCoeff_is_Q(bDst))
1034      return naMapP0;                            /// Z/p   -->  Q(a)
1035    if (nCoeff_is_Q_or_BI(src) && nCoeff_is_Zp(bDst))
1036      return naMap0P;                            /// Q      --> Z/p(a)
1037    if ((src->rep==n_rep_gap_gmp) && nCoeff_is_Zp(bDst))
1038      return naMapZ0;                            /// Z     -->  Z/p(a)
1039    if (nCoeff_is_Zp(src) && nCoeff_is_Zp(bDst))
1040    {
1041      if (src->ch == dst->ch) return naMapPP;    /// Z/p    --> Z/p(a)
1042      else return naMapUP;                       /// Z/u    --> Z/p(a)
1043    }
1044  }
1045  if (h != 1) return NULL;
1046  if ((!nCoeff_is_Zp(bDst)) && (!nCoeff_is_Q(bDst))) return NULL;
1047  if ((!nCoeff_is_Zp(bSrc)) && (!nCoeff_is_Q_or_BI(bSrc))) return NULL;
1048
1049  nMapFunc nMap=n_SetMap(src->extRing->cf,dst->extRing->cf);
1050  if (rSamePolyRep(src->extRing, dst->extRing) && (strcmp(rRingVar(0, src->extRing), rRingVar(0, dst->extRing)) == 0))
1051  {
1052    if (src->type==n_algExt)
1053       return ndCopyMap; // naCopyMap;         /// K(a)   --> K(a)
1054    else
1055       return naCopyTrans2AlgExt;
1056  }
1057  else if ((nMap!=NULL) && (strcmp(rRingVar(0,src->extRing),rRingVar(0,dst->extRing))==0) && (rVar (src->extRing) == rVar (dst->extRing)))
1058  {
1059    if (src->type==n_algExt)
1060       return naGenMap; // naCopyMap;         /// K(a)   --> K'(a)
1061    else
1062       return naGenTrans2AlgExt;
1063  }
1064
1065  return NULL;                                           /// default
1066}
1067
1068int naParDeg(number a, const coeffs cf)
1069{
1070  if (a == NULL) return -1;
1071  poly aa=(poly)a;
1072  return cf->extRing->pFDeg(aa,cf->extRing);
1073}
1074
1075/// return the specified parameter as a number in the given alg. field
1076number naParameter(const int iParameter, const coeffs cf)
1077{
1078  assume(getCoeffType(cf) == n_algExt);
1079
1080  const ring R = cf->extRing;
1081  assume( R != NULL );
1082  assume( 0 < iParameter && iParameter <= rVar(R) );
1083
1084  poly p = p_One(R); p_SetExp(p, iParameter, 1, R); p_Setm(p, R);
1085
1086  return (number) p;
1087}
1088
1089
1090/// if m == var(i)/1 => return i,
1091int naIsParam(number m, const coeffs cf)
1092{
1093  assume((getCoeffType(cf) == n_algExt)||(getCoeffType(cf) == n_polyExt));
1094
1095  const ring R = cf->extRing;
1096  assume( R != NULL );
1097
1098  return p_Var( (poly)m, R );
1099}
1100
1101
1102static void naClearContent(ICoeffsEnumerator& numberCollectionEnumerator, number& c, const coeffs cf)
1103{
1104  assume(cf != NULL);
1105  assume(getCoeffType(cf) == n_algExt);
1106  assume(nCoeff_is_Q_algext(cf)); // only over (Q[a]/m(a)), while the default impl. is used over Zp[a]/m(a) !
1107
1108  const ring   R = cf->extRing;
1109  assume(R != NULL);
1110  const coeffs Q = R->cf;
1111  assume(Q != NULL);
1112  assume(nCoeff_is_Q(Q));
1113
1114  numberCollectionEnumerator.Reset();
1115
1116  if( !numberCollectionEnumerator.MoveNext() ) // empty zero polynomial?
1117  {
1118    c = n_Init(1, cf);
1119    return;
1120  }
1121
1122  naTest(numberCollectionEnumerator.Current());
1123
1124  // part 1, find a small candidate for gcd
1125  int s1; int s=2147483647; // max. int
1126
1127  const BOOLEAN lc_is_pos=naGreaterZero(numberCollectionEnumerator.Current(),cf);
1128
1129  int normalcount = 0;
1130
1131  poly cand1, cand;
1132
1133  do
1134  {
1135    number& n = numberCollectionEnumerator.Current();
1136    naNormalize(n, cf); ++normalcount;
1137
1138    naTest(n);
1139
1140    cand1 = (poly)n;
1141
1142    s1 = p_Deg(cand1, R); // naSize?
1143    if (s>s1)
1144    {
1145      cand = cand1;
1146      s = s1;
1147    }
1148  } while (numberCollectionEnumerator.MoveNext() );
1149
1150//  assume( nlGreaterZero(cand,cf) ); // cand may be a negative integer!
1151
1152  cand = p_Copy(cand, R);
1153  // part 2: compute gcd(cand,all coeffs)
1154
1155  numberCollectionEnumerator.Reset();
1156
1157  int length = 0;
1158  while (numberCollectionEnumerator.MoveNext() )
1159  {
1160    number& n = numberCollectionEnumerator.Current();
1161    ++length;
1162
1163    if( (--normalcount) <= 0)
1164      naNormalize(n, cf);
1165
1166    naTest(n);
1167
1168//    p_InpGcd(cand, (poly)n, R);
1169
1170    { // R->cf is QQ
1171      poly tmp=gcd_over_Q(cand,(poly)n,R);
1172      p_Delete(&cand,R);
1173      cand=tmp;
1174    }
1175
1176//    cand1 = p_Gcd(cand,(poly)n, R); p_Delete(&cand, R); cand = cand1;
1177
1178    assume( naGreaterZero((number)cand, cf) ); // ???
1179/*
1180    if(p_IsConstant(cand,R))
1181    {
1182      c = cand;
1183
1184      if(!lc_is_pos)
1185      {
1186        // make the leading coeff positive
1187        c = nlNeg(c, cf);
1188        numberCollectionEnumerator.Reset();
1189
1190        while (numberCollectionEnumerator.MoveNext() )
1191        {
1192          number& nn = numberCollectionEnumerator.Current();
1193          nn = nlNeg(nn, cf);
1194        }
1195      }
1196      return;
1197    }
1198*/
1199
1200  }
1201
1202
1203  // part3: all coeffs = all coeffs / cand
1204  if (!lc_is_pos)
1205    cand = p_Neg(cand, R);
1206
1207  c = (number)cand; naTest(c);
1208
1209  poly cInverse = (poly)naInvers(c, cf);
1210  assume(cInverse != NULL); // c is non-zero divisor!?
1211
1212
1213  numberCollectionEnumerator.Reset();
1214
1215
1216  while (numberCollectionEnumerator.MoveNext() )
1217  {
1218    number& n = numberCollectionEnumerator.Current();
1219
1220    assume( length > 0 );
1221
1222    if( --length > 0 )
1223    {
1224      assume( cInverse != NULL );
1225      n = (number) p_Mult_q(p_Copy(cInverse, R), (poly)n, R);
1226    }
1227    else
1228    {
1229      n = (number) p_Mult_q(cInverse, (poly)n, R);
1230      cInverse = NULL;
1231      assume(length == 0);
1232    }
1233
1234    definiteReduce((poly &)n, naMinpoly, cf);
1235  }
1236
1237  assume(length == 0);
1238  assume(cInverse == NULL); //   p_Delete(&cInverse, R);
1239
1240  // Quick and dirty fix for constant content clearing... !?
1241  CRecursivePolyCoeffsEnumerator<NAConverter> itr(numberCollectionEnumerator); // recursively treat the numbers as polys!
1242
1243  number cc;
1244
1245  n_ClearContent(itr, cc, Q); // TODO: get rid of (-LC) normalization!?
1246
1247  // over alg. ext. of Q // takes over the input number
1248  c = (number) __p_Mult_nn( (poly)c, cc, R);
1249//      p_Mult_q(p_NSet(cc, R), , R);
1250
1251  n_Delete(&cc, Q);
1252
1253  // TODO: the above is not enough! need GCD's of polynomial coeffs...!
1254/*
1255  // old and wrong part of p_Content
1256    if (rField_is_Q_a(r) && !CLEARENUMERATORS) // should not be used anymore if CLEARENUMERATORS is 1
1257    {
1258      // we only need special handling for alg. ext.
1259      if (getCoeffType(r->cf)==n_algExt)
1260      {
1261        number hzz = n_Init(1, r->cf->extRing->cf);
1262        p=ph;
1263        while (p!=NULL)
1264        { // each monom: coeff in Q_a
1265          poly c_n_n=(poly)pGetCoeff(p);
1266          poly c_n=c_n_n;
1267          while (c_n!=NULL)
1268          { // each monom: coeff in Q
1269            d=n_NormalizeHelper(hzz,pGetCoeff(c_n),r->cf->extRing->cf);
1270            n_Delete(&hzz,r->cf->extRing->cf);
1271            hzz=d;
1272            pIter(c_n);
1273          }
1274          pIter(p);
1275        }
1276        // hzz contains the 1/lcm of all denominators in c_n_n
1277        h=n_Invers(hzz,r->cf->extRing->cf);
1278        n_Delete(&hzz,r->cf->extRing->cf);
1279        n_Normalize(h,r->cf->extRing->cf);
1280        if(!n_IsOne(h,r->cf->extRing->cf))
1281        {
1282          p=ph;
1283          while (p!=NULL)
1284          { // each monom: coeff in Q_a
1285            poly c_n=(poly)pGetCoeff(p);
1286            while (c_n!=NULL)
1287            { // each monom: coeff in Q
1288              d=n_Mult(h,pGetCoeff(c_n),r->cf->extRing->cf);
1289              n_Normalize(d,r->cf->extRing->cf);
1290              n_Delete(&pGetCoeff(c_n),r->cf->extRing->cf);
1291              pGetCoeff(c_n)=d;
1292              pIter(c_n);
1293            }
1294            pIter(p);
1295          }
1296        }
1297        n_Delete(&h,r->cf->extRing->cf);
1298      }
1299    }
1300*/
1301
1302
1303//  c = n_Init(1, cf); assume(FALSE); // TODO: NOT YET IMPLEMENTED!!!
1304}
1305
1306
1307void naClearDenominators(ICoeffsEnumerator& numberCollectionEnumerator, number& c, const coeffs cf)
1308{
1309  assume(cf != NULL);
1310  assume((getCoeffType(cf) == n_algExt)||(getCoeffType(cf) == n_polyExt));
1311  assume(nCoeff_is_Q_algext(cf)); // only over (Q[a]/m(a)), while the default impl. is used over Zp[a]/m(a) !
1312
1313  assume(cf->extRing != NULL);
1314  const coeffs Q = cf->extRing->cf;
1315  assume(Q != NULL);
1316  assume(nCoeff_is_Q(Q));
1317  number n;
1318  CRecursivePolyCoeffsEnumerator<NAConverter> itr(numberCollectionEnumerator); // recursively treat the numbers as polys!
1319  n_ClearDenominators(itr, n, Q); // this should probably be fine...
1320  c = (number)p_NSet(n, cf->extRing); // over alg. ext. of Q // takes over the input number
1321}
1322
1323void naKillChar(coeffs cf)
1324{
1325   if ((--cf->extRing->ref) == 0)
1326     rDelete(cf->extRing);
1327}
1328
1329char* naCoeffString(const coeffs r) // currently also for tranext.
1330{
1331  const char* const* p=n_ParameterNames(r);
1332  int l=0;
1333  int i;
1334  for(i=0; i<n_NumberOfParameters(r);i++)
1335  {
1336    l+=(strlen(p[i])+1);
1337  }
1338  char *s=(char *)omAlloc(l+10+1);
1339  s[0]='\0';
1340  snprintf(s,10+1,"%d",r->ch); /* Fp(a) or Q(a) */
1341  char tt[2];
1342  tt[0]=',';
1343  tt[1]='\0';
1344  for(i=0; i<n_NumberOfParameters(r);i++)
1345  {
1346    strcat(s,tt);
1347    strcat(s,p[i]);
1348  }
1349  return s;
1350}
1351
1352char* naCoeffName(const coeffs r) // currently also for tranext.
1353{
1354  const char* const* p=n_ParameterNames(r);
1355  int l=0;
1356  int i;
1357  for(i=0; i<n_NumberOfParameters(r);i++)
1358  {
1359    l+=(strlen(p[i])+1);
1360  }
1361  STATIC_VAR char s[200];
1362  s[0]='\0';
1363  snprintf(s,10+1,"%d",r->ch); /* Fp(a) or Q(a) */
1364  char tt[2];
1365  tt[0]=',';
1366  tt[1]='\0';
1367  for(i=0; i<n_NumberOfParameters(r);i++)
1368  {
1369    strcat(s,tt);
1370    strcat(s,p[i]);
1371  }
1372  return s;
1373}
1374
1375number  naChineseRemainder(number *x, number *q,int rl, BOOLEAN /*sym*/,CFArray &inv_cache,const coeffs cf)
1376{
1377  poly *P=(poly*)omAlloc(rl*sizeof(poly*));
1378  number *X=(number *)omAlloc(rl*sizeof(number));
1379  int i;
1380  for(i=0;i<rl;i++) P[i]=p_Copy((poly)(x[i]),cf->extRing);
1381  poly result=p_ChineseRemainder(P,X,q,rl,inv_cache,cf->extRing);
1382  omFreeSize(X,rl*sizeof(number));
1383  omFreeSize(P,rl*sizeof(poly*));
1384  return ((number)result);
1385}
1386
1387number  naFarey(number p, number n, const coeffs cf)
1388{
1389  // n is really a bigint
1390  poly result=p_Farey(p_Copy((poly)p,cf->extRing),n,cf->extRing);
1391  return ((number)result);
1392}
1393
1394
1395BOOLEAN naInitChar(coeffs cf, void * infoStruct)
1396{
1397  assume( infoStruct != NULL );
1398
1399  AlgExtInfo *e = (AlgExtInfo *)infoStruct;
1400  /// first check whether cf->extRing != NULL and delete old ring???
1401
1402  assume(e->r                     != NULL);      // extRing;
1403  assume(e->r->cf                 != NULL);      // extRing->cf;
1404
1405  assume((e->r->qideal            != NULL) &&    // minideal has one
1406         (IDELEMS(e->r->qideal)   == 1)    &&    // non-zero generator
1407         (e->r->qideal->m[0]      != NULL)    ); // at m[0];
1408
1409  assume( cf != NULL );
1410  assume(getCoeffType(cf) == n_algExt);                     // coeff type;
1411
1412  e->r->ref ++; // increase the ref.counter for the ground poly. ring!
1413  const ring R = e->r; // no copy!
1414  cf->extRing  = R;
1415
1416  /* propagate characteristic up so that it becomes
1417     directly accessible in cf: */
1418  cf->ch = R->cf->ch;
1419
1420  cf->is_field=TRUE;
1421  cf->is_domain=TRUE;
1422  cf->rep=n_rep_poly;
1423
1424  #ifdef LDEBUG
1425  p_Test((poly)naMinpoly, naRing);
1426  #endif
1427
1428  cf->cfCoeffString  = naCoeffString;
1429  cf->cfCoeffName    = naCoeffName;
1430
1431  cf->cfGreaterZero  = naGreaterZero;
1432  cf->cfGreater      = naGreater;
1433  cf->cfEqual        = naEqual;
1434  cf->cfIsZero       = naIsZero;
1435  cf->cfIsOne        = naIsOne;
1436  cf->cfIsMOne       = naIsMOne;
1437  cf->cfInit         = naInit;
1438  cf->cfFarey        = naFarey;
1439  cf->cfChineseRemainder= naChineseRemainder;
1440  cf->cfInt          = naInt;
1441  cf->cfInpNeg       = naNeg;
1442  cf->cfAdd          = naAdd;
1443  cf->cfSub          = naSub;
1444  cf->cfMult         = naMult;
1445  cf->cfDiv          = naDiv;
1446  cf->cfExactDiv     = naDiv;
1447  cf->cfPower        = naPower;
1448  cf->cfCopy         = naCopy;
1449
1450  cf->cfWriteLong        = naWriteLong;
1451
1452  if( rCanShortOut(naRing) )
1453    cf->cfWriteShort = naWriteShort;
1454  else
1455    cf->cfWriteShort = naWriteLong;
1456
1457  cf->cfRead         = naRead;
1458  cf->cfDelete       = naDelete;
1459  cf->cfSetMap       = naSetMap;
1460  cf->cfGetDenom     = naGetDenom;
1461  cf->cfGetNumerator = naGetNumerator;
1462  cf->cfRePart       = naCopy;
1463  cf->cfCoeffWrite   = naCoeffWrite;
1464  cf->cfNormalize    = naNormalize;
1465  cf->cfKillChar     = naKillChar;
1466#ifdef LDEBUG
1467  cf->cfDBTest       = naDBTest;
1468#endif
1469  cf->cfGcd          = naGcd;
1470  cf->cfNormalizeHelper          = naLcmContent;
1471  cf->cfSize         = naSize;
1472  cf->nCoeffIsEqual  = naCoeffIsEqual;
1473  cf->cfInvers       = naInvers;
1474  cf->convFactoryNSingN=naConvFactoryNSingN;
1475  cf->convSingNFactoryN=naConvSingNFactoryN;
1476  cf->cfParDeg = naParDeg;
1477
1478  cf->iNumberOfParameters = rVar(R);
1479  cf->pParameterNames = (const char**)R->names;
1480  cf->cfParameter = naParameter;
1481  cf->has_simple_Inverse= R->cf->has_simple_Inverse;
1482  /* cf->has_simple_Alloc= FALSE; */
1483
1484  if( nCoeff_is_Q(R->cf) )
1485  {
1486    cf->cfClearContent = naClearContent;
1487    cf->cfClearDenominators = naClearDenominators;
1488  }
1489
1490  return FALSE;
1491}
1492
1493template class CRecursivePolyCoeffsEnumerator<NAConverter>;
1494
1495template class IAccessor<snumber*>;
1496
1497/* --------------------------------------------------------------------*/
1498/****************************************
1499*  Computer Algebra System SINGULAR     *
1500****************************************/
1501/**
1502  * ABSTRACT: numbers as polys in the ring K[a]
1503  *           Assuming that we have a coeffs object cf, then these numbers
1504  *           are polynomials in the polynomial ring K[a] represented by
1505  *           cf->extRing.
1506  *           IMPORTANT ASSUMPTIONS:
1507  *           1.) So far we assume that cf->extRing is a valid polynomial
1508  *               ring
1509  **/
1510
1511#ifdef LDEBUG
1512#define n2pTest(a) n2pDBTest(a,__FILE__,__LINE__,cf)
1513BOOLEAN  n2pDBTest(number a, const char *f, const int l, const coeffs r);
1514#else
1515#define n2pTest(a) do {} while (0)
1516#endif
1517
1518/* polynomial ring in which our numbers live */
1519#define n2pRing cf->extRing
1520
1521/* coeffs object in which the coefficients of our numbers live;
1522 * methods attached to n2pCoeffs may be used to compute with the
1523 * coefficients of our numbers, e.g., use n2pCoeffs->nAdd to add
1524 * coefficients of our numbers */
1525#define n2pCoeffs cf->extRing->cf
1526
1527#ifdef LDEBUG
1528BOOLEAN n2pDBTest(number a, const char *f, const int l, const coeffs cf)
1529{
1530  if (a == NULL) return TRUE;
1531  return p_Test((poly)a, n2pRing);
1532}
1533#endif
1534
1535void  n2pNormalize(number &a, const coeffs cf)
1536{
1537  poly aa=(poly)a;
1538  p_Normalize(aa,n2pRing);
1539}
1540
1541/* TRUE iff (a != 0 and (b == 0 or deg(a) > deg(b) or (deg(a)==deg(b) && lc(a)>lc(b))) */
1542number n2pMult(number a, number b, const coeffs cf)
1543{
1544  n2pTest(a); n2pTest(b);
1545  if ((a == NULL)||(b == NULL)) return NULL;
1546  poly aTimesB = pp_Mult_qq((poly)a, (poly)b, n2pRing);
1547  return (number)aTimesB;
1548}
1549
1550number n2pDiv(number a, number b, const coeffs cf)
1551{
1552  n2pTest(a); n2pTest(b);
1553  if (b == NULL) WerrorS(nDivBy0);
1554  if (a == NULL) return NULL;
1555  poly p=singclap_pdivide((poly)a,(poly)b,n2pRing);
1556  return (number)p;
1557}
1558
1559void n2pPower(number a, int exp, number *b, const coeffs cf)
1560{
1561  n2pTest(a);
1562
1563  *b= (number)p_Power((poly)a,exp,n2pRing);
1564}
1565
1566const char * n2pRead(const char *s, number *a, const coeffs cf)
1567{
1568  poly aAsPoly;
1569  const char * result = p_Read(s, aAsPoly, n2pRing);
1570  *a = (number)aAsPoly;
1571  return result;
1572}
1573
1574/* expects *param to be castable to AlgExtInfo */
1575static BOOLEAN n2pCoeffIsEqual(const coeffs cf, n_coeffType n, void * param)
1576{
1577  if (n_polyExt != n) return FALSE;
1578  AlgExtInfo *e = (AlgExtInfo *)param;
1579  /* for extension coefficient fields we expect the underlying
1580     polynomial rings to be IDENTICAL, i.e. the SAME OBJECT;
1581     this expectation is based on the assumption that we have properly
1582     registered cf and perform reference counting rather than creating
1583     multiple copies of the same coefficient field/domain/ring */
1584  if (n2pRing == e->r)
1585    return TRUE;
1586  // NOTE: Q(a)[x] && Q(a)[y] should better share the _same_ Q(a)...
1587  if( rEqual(n2pRing, e->r, TRUE) ) // also checks the equality of qideals
1588  {
1589    rDelete(e->r);
1590    return TRUE;
1591  }
1592  return FALSE;
1593}
1594
1595char* n2pCoeffString(const coeffs cf)
1596{
1597  const char* const* p=n_ParameterNames(cf);
1598  int l=0;
1599  int i;
1600  for(i=0; i<rVar(n2pRing);i++)
1601  {
1602    l+=(strlen(p[i])+1);
1603  }
1604  char *cf_s=nCoeffString(n2pRing->cf);
1605  char *s=(char *)omAlloc(l+5+strlen(cf_s));
1606  s[0]='\0';
1607  snprintf(s,strlen(cf_s)+2,"%s",cf_s);
1608  omFree(cf_s);
1609  char tt[2];
1610  tt[0]='[';
1611  tt[1]='\0';
1612  strcat(s,tt);
1613  tt[0]=',';
1614  for(i=0; i<rVar(n2pRing);i++)
1615  {
1616    strcat(s,p[i]);
1617    if (i+1!=rVar(n2pRing)) strcat(s,tt);
1618    else { tt[0]=']'; strcat(s,tt); }
1619  }
1620  return s;
1621}
1622
1623char* n2pCoeffName(const coeffs cf)
1624{
1625  const char* const* p=n_ParameterNames(cf);
1626  int l=0;
1627  int i;
1628  for(i=0; i<rVar(n2pRing);i++)
1629  {
1630    l+=(strlen(p[i])+1);
1631  }
1632  char *cf_s=nCoeffString(n2pRing->cf);
1633  STATIC_VAR char s[200];
1634  s[0]='\0';
1635  snprintf(s,strlen(cf_s)+2,"%s",cf_s);
1636  omFree(cf_s);
1637  char tt[2];
1638  tt[0]='[';
1639  tt[1]='\0';
1640  strcat(s,tt);
1641  tt[0]=',';
1642  for(i=0; i<rVar(n2pRing);i++)
1643  {
1644    strcat(s,p[i]);
1645    if (i+1!=rVar(n2pRing)) strcat(s,tt);
1646    else { tt[0]=']'; strcat(s,tt); }
1647  }
1648  return s;
1649}
1650
1651void n2pCoeffWrite(const coeffs cf, BOOLEAN details)
1652{
1653  assume( cf != NULL );
1654
1655  const ring A = cf->extRing;
1656
1657  assume( A != NULL );
1658  PrintS("// polynomial ring as coefficient ring :\n");
1659  rWrite(A);
1660  PrintLn();
1661}
1662
1663number  n2pInvers(number a, const coeffs cf)
1664{
1665  poly aa=(poly)a;
1666  if(p_IsConstant(aa, n2pRing))
1667  {
1668    poly p=p_Init(n2pRing);
1669    p_SetCoeff0(p,n_Invers(pGetCoeff(aa),n2pCoeffs),n2pRing);
1670    return (number)p;
1671  }
1672  else
1673  {
1674    WerrorS("not invertible");
1675    return NULL;
1676  }
1677}
1678
1679BOOLEAN n2pInitChar(coeffs cf, void * infoStruct)
1680{
1681  assume( infoStruct != NULL );
1682
1683  AlgExtInfo *e = (AlgExtInfo *)infoStruct;
1684  /// first check whether cf->extRing != NULL and delete old ring???
1685
1686  assume(e->r                     != NULL);      // extRing;
1687  assume(e->r->cf                 != NULL);      // extRing->cf;
1688
1689  assume( cf != NULL );
1690
1691  e->r->ref ++; // increase the ref.counter for the ground poly. ring!
1692  const ring R = e->r; // no copy!
1693  cf->extRing  = R;
1694
1695  /* propagate characteristic up so that it becomes
1696     directly accessible in cf: */
1697  cf->ch = R->cf->ch;
1698  cf->is_field=FALSE;
1699  cf->is_domain=TRUE;
1700
1701  cf->cfCoeffString  = n2pCoeffString;
1702  cf->cfCoeffName    = n2pCoeffName;
1703
1704  cf->cfGreaterZero  = naGreaterZero;
1705  cf->cfGreater      = naGreater;
1706  cf->cfEqual        = naEqual;
1707  cf->cfIsZero       = naIsZero;
1708  cf->cfIsOne        = naIsOne;
1709  cf->cfIsMOne       = naIsMOne;
1710  cf->cfInit         = naInit;
1711  cf->cfFarey        = naFarey;
1712  cf->cfChineseRemainder= naChineseRemainder;
1713  cf->cfInt          = naInt;
1714  cf->cfInpNeg       = naNeg;
1715  cf->cfAdd          = naAdd;
1716  cf->cfSub          = naSub;
1717  cf->cfMult         = n2pMult;
1718  cf->cfDiv          = n2pDiv;
1719  cf->cfPower        = n2pPower;
1720  cf->cfCopy         = naCopy;
1721
1722  cf->cfWriteLong        = naWriteLong;
1723
1724  if( rCanShortOut(n2pRing) )
1725    cf->cfWriteShort = naWriteShort;
1726  else
1727    cf->cfWriteShort = naWriteLong;
1728
1729  cf->cfRead         = n2pRead;
1730  cf->cfDelete       = naDelete;
1731  cf->cfSetMap       = naSetMap;
1732  cf->cfGetDenom     = naGetDenom;
1733  cf->cfGetNumerator = naGetNumerator;
1734  cf->cfRePart       = naCopy;
1735  cf->cfCoeffWrite   = n2pCoeffWrite;
1736  cf->cfNormalize    = n2pNormalize;
1737  cf->cfKillChar     = naKillChar;
1738#ifdef LDEBUG
1739  cf->cfDBTest       = naDBTest;
1740#endif
1741  cf->cfGcd          = naGcd;
1742  cf->cfNormalizeHelper          = naLcmContent;
1743  cf->cfSize         = naSize;
1744  cf->nCoeffIsEqual  = n2pCoeffIsEqual;
1745  cf->cfInvers       = n2pInvers;
1746  cf->convFactoryNSingN=naConvFactoryNSingN;
1747  cf->convSingNFactoryN=naConvSingNFactoryN;
1748  cf->cfParDeg = naParDeg;
1749
1750  cf->iNumberOfParameters = rVar(R);
1751  cf->pParameterNames = (const char**)R->names;
1752  cf->cfParameter = naParameter;
1753  cf->has_simple_Inverse=FALSE;
1754  /* cf->has_simple_Alloc= FALSE; */
1755
1756  if( nCoeff_is_Q(R->cf) )
1757  {
1758    cf->cfClearContent = naClearContent;
1759    cf->cfClearDenominators = naClearDenominators;
1760  }
1761
1762  return FALSE;
1763}
Note: See TracBrowser for help on using the repository browser.