source: git/kernel/linearAlgebra.cc @ 854405

spielwiese
Last change on this file since 854405 was 762407, checked in by Oleksandr Motsak <motsak@…>, 12 years ago
config.h is for sources files only FIX: config.h should only be used by source (not from inside kernel/mod2.h!) NOTE: each source file should better include mod2.h right after config.h, while headers should better not include mod2.h.
  • Property mode set to 100644
File size: 51.1 KB
Line 
1/*****************************************************************************\
2 * Computer Algebra System SINGULAR
3\*****************************************************************************/
4/** @file lineareAlgebra.cc
5 *
6 * This file implements basic linear algebra functionality.
7 *
8 * For more general information, see the documentation in
9 * lineareAlgebra.h.
10 *
11 * @author Frank Seelisch
12 *
13 * @internal @version \$Id$
14 *
15 **/
16/*****************************************************************************/
17
18// include header files
19#include "config.h"
20#include "mod2.h"
21
22#include <coeffs/coeffs.h>
23#include <coeffs/numbers.h>
24
25#include <coeffs/mpr_complex.h>
26#include <polys/monomials/p_polys.h>
27#include <polys/simpleideals.h>
28#include <polys/matpol.h>
29
30// #include <kernel/polys.h>
31
32#include <kernel/structs.h>
33#include <kernel/ideals.h>
34#include <kernel/linearAlgebra.h>
35
36/**
37 * The returned score is based on the implementation of 'nSize' for
38 * numbers (, see numbers.h): nSize(n) provides a measure for the
39 * complexity of n. Thus, less complex pivot elements will be
40 * prefered, and get therefore a smaller pivot score. Consequently,
41 * we simply return the value of nSize.
42 * An exception to this rule are the ground fields R, long R, and
43 * long C: In these, the result of nSize relates to |n|. And since
44 * a larger modulus of the pivot element ensures a numerically more
45 * stable Gauss elimination, we would like to have a smaller score
46 * for larger values of |n|. Therefore, in R, long R, and long C,
47 * the negative of nSize will be returned.
48 **/
49int pivotScore(number n, const ring r)
50{
51  int s = n_Size(n, r->cf);
52  if (rField_is_long_C(r) ||
53      rField_is_long_R(r) ||
54      rField_is_R(r))
55    return -s;
56  else
57    return s;
58}
59
60/**
61 * This code computes a score for each non-zero matrix entry in
62 * aMat[r1..r2, c1..c2]. If all entries are zero, false is returned,
63 * otherwise true. In the latter case, the minimum of all scores
64 * is sought, and the row and column indices of the corresponding
65 * matrix entry are stored in bestR and bestC.
66 **/
67bool pivot(const matrix aMat, const int r1, const int r2, const int c1,
68           const int c2, int* bestR, int* bestC, const ring R)
69{
70  int bestScore; int score; bool foundBestScore = false; poly matEntry;
71
72  for (int c = c1; c <= c2; c++)
73  {
74    for (int r = r1; r <= r2; r++)
75    {
76      matEntry = MATELEM(aMat, r, c);
77      if (matEntry != NULL)
78      {
79        score = pivotScore(pGetCoeff(matEntry), R);
80        if ((!foundBestScore) || (score < bestScore))
81        {
82          bestScore = score;
83          *bestR = r;
84          *bestC = c;
85        }
86        foundBestScore = true;
87      }
88    }
89  }
90
91  return foundBestScore;
92}
93
94bool unitMatrix(const int n, matrix &unitMat, const ring R)
95{
96  if (n < 1) return false;
97  unitMat = mpNew(n, n);
98  for (int r = 1; r <= n; r++) MATELEM(unitMat, r, r) = p_One(R);
99  return true;
100}
101
102void luDecomp(const matrix aMat, matrix &pMat, matrix &lMat, matrix &uMat,
103              const ring R)
104{
105  int rr = aMat->rows();
106  int cc = aMat->cols();
107  pMat = mpNew(rr, rr);
108  uMat = mpNew(rr, cc);
109  /* copy aMat into uMat: */
110  for (int r = 1; r <= rr; r++)
111    for (int c = 1; c <= cc; c++)
112      MATELEM(uMat, r, c) = p_Copy(aMat->m[c - 1 + (r - 1) * cc], R);
113
114  /* we use an int array to store all row permutations;
115     note that we only make use of the entries [1..rr] */
116  int* permut = new int[rr + 1];
117  for (int i = 1; i <= rr; i++) permut[i] = i;
118
119  /* fill lMat with the (rr x rr) unit matrix */
120  unitMatrix(rr, lMat,R);
121
122  int bestR; int bestC; int intSwap; poly pSwap; int cOffset = 0;
123  for (int r = 1; r < rr; r++)
124  {
125    if (r > cc) break;
126    while ((r + cOffset <= cc) &&
127           (!pivot(uMat, r, rr, r + cOffset, r + cOffset, &bestR, &bestC, R)))
128      cOffset++;
129    if (r + cOffset <= cc)
130    {
131      /* swap rows with indices r and bestR in permut */
132      intSwap = permut[r];
133      permut[r] = permut[bestR];
134      permut[bestR] = intSwap;
135
136      /* swap rows with indices r and bestR in uMat;
137         it is sufficient to do this for columns >= r + cOffset*/
138      for (int c = r + cOffset; c <= cc; c++)
139      {
140        pSwap = MATELEM(uMat, r, c);
141        MATELEM(uMat, r, c) = MATELEM(uMat, bestR, c);
142        MATELEM(uMat, bestR, c) = pSwap;
143      }
144
145      /* swap rows with indices r and bestR in lMat;
146         we must do this only for columns < r */
147      for (int c = 1; c < r; c++)
148      {
149        pSwap = MATELEM(lMat, r, c);
150        MATELEM(lMat, r, c) = MATELEM(lMat, bestR, c);
151        MATELEM(lMat, bestR, c) = pSwap;
152      }
153
154      /* perform next Gauss elimination step, i.e., below the
155         row with index r;
156         we need to adjust lMat and uMat;
157         we are certain that the matrix entry at [r, r + cOffset]
158         is non-zero: */
159      number pivotElement = pGetCoeff(MATELEM(uMat, r, r + cOffset));
160      poly p; number n;
161      for (int rGauss = r + 1; rGauss <= rr; rGauss++)
162      {
163        p = MATELEM(uMat, rGauss, r + cOffset);
164        if (p != NULL)
165        {
166          n = n_Div(pGetCoeff(p), pivotElement, R->cf);
167          n_Normalize(n,R->cf);
168
169          /* filling lMat;
170             old entry was zero, so no need to call pDelete(.) */
171          MATELEM(lMat, rGauss, r) = p_NSet(n_Copy(n,R->cf),R);
172
173          /* adjusting uMat: */
174          MATELEM(uMat, rGauss, r + cOffset) = NULL; p_Delete(&p,R);
175          n = n_Neg(n,R->cf);
176          for (int cGauss = r + cOffset + 1; cGauss <= cc; cGauss++)
177          {
178            MATELEM(uMat, rGauss, cGauss)
179              = p_Add_q(MATELEM(uMat, rGauss, cGauss),
180                     pp_Mult_nn(MATELEM(uMat, r, cGauss), n, R), R);
181            p_Normalize(MATELEM(uMat, rGauss, cGauss),R);
182          }
183
184          n_Delete(&n,R->cf); /* clean up n */
185        }
186      }
187    }
188  }
189
190  /* building the permutation matrix from 'permut' */
191  for (int r = 1; r <= rr; r++)
192    MATELEM(pMat, r, permut[r]) = p_One(R);
193  delete[] permut;
194
195  return;
196}
197
198/**
199 * This code first computes the LU-decomposition of aMat,
200 * and then calls the method for inverting a matrix which
201 * is given by its LU-decomposition.
202 **/
203bool luInverse(const matrix aMat, matrix &iMat, const ring R)
204{ /* aMat is guaranteed to be an (n x n)-matrix */
205  matrix pMat;
206  matrix lMat;
207  matrix uMat;
208  luDecomp(aMat, pMat, lMat, uMat, R);
209  bool result = luInverseFromLUDecomp(pMat, lMat, uMat, iMat, R);
210
211  /* clean-up */
212  id_Delete((ideal*)&pMat,R);
213  id_Delete((ideal*)&lMat,R);
214  id_Delete((ideal*)&uMat,R);
215
216  return result;
217}
218
219/* Assumes that aMat is already in row echelon form */
220int rankFromRowEchelonForm(const matrix aMat)
221{
222  int rank = 0;
223  int rr = aMat->rows(); int cc = aMat->cols();
224  int r = 1; int c = 1;
225  while ((r <= rr) && (c <= cc))
226  {
227    if (MATELEM(aMat, r, c) == NULL) c++;
228    else { rank++; r++; }
229  }
230  return rank;
231}
232
233int luRank(const matrix aMat, const bool isRowEchelon, const ring R)
234{
235  if (isRowEchelon) return rankFromRowEchelonForm(aMat);
236  else
237  { /* compute the LU-decomposition and read off the rank from
238       the upper triangular matrix of that decomposition */
239    matrix pMat;
240    matrix lMat;
241    matrix uMat;
242    luDecomp(aMat, pMat, lMat, uMat,R);
243    int result = rankFromRowEchelonForm(uMat);
244
245    /* clean-up */
246    id_Delete((ideal*)&pMat,R);
247    id_Delete((ideal*)&lMat,R);
248    id_Delete((ideal*)&uMat,R);
249
250    return result;
251  }
252}
253
254bool upperRightTriangleInverse(const matrix uMat, matrix &iMat,
255                               bool diagonalIsOne, const ring R)
256{
257  int d = uMat->rows();
258  poly p; poly q;
259
260  /* check whether uMat is invertible */
261  bool invertible = diagonalIsOne;
262  if (!invertible)
263  {
264    invertible = true;
265    for (int r = 1; r <= d; r++)
266    {
267      if (MATELEM(uMat, r, r) == NULL)
268      {
269        invertible = false;
270        break;
271      }
272    }
273  }
274
275  if (invertible)
276  {
277    iMat = mpNew(d, d);
278    for (int r = d; r >= 1; r--)
279    {
280      if (diagonalIsOne)
281        MATELEM(iMat, r, r) = p_One(R);
282      else
283        MATELEM(iMat, r, r) = p_NSet(n_Invers(p_GetCoeff(MATELEM(uMat, r, r),R),R->cf),R);
284      for (int c = r + 1; c <= d; c++)
285      {
286        p = NULL;
287        for (int k = r + 1; k <= c; k++)
288        {
289          q = pp_Mult_qq(MATELEM(uMat, r, k), MATELEM(iMat, k, c),R);
290          p = p_Add_q(p, q,R);
291        }
292        p = p_Neg(p,R);
293        p = p_Mult_q(p, p_Copy(MATELEM(iMat, r, r),R),R);
294        p_Normalize(p,R);
295        MATELEM(iMat, r, c) = p;
296      }
297    }
298  }
299
300  return invertible;
301}
302
303bool lowerLeftTriangleInverse(const matrix lMat, matrix &iMat,
304                              bool diagonalIsOne)
305{
306  int d = lMat->rows(); poly p; poly q;
307
308  /* check whether lMat is invertible */
309  bool invertible = diagonalIsOne;
310  if (!invertible)
311  {
312    invertible = true;
313    for (int r = 1; r <= d; r++)
314    {
315      if (MATELEM(lMat, r, r) == NULL)
316      {
317        invertible = false;
318        break;
319      }
320    }
321  }
322
323  if (invertible)
324  {
325    iMat = mpNew(d, d);
326    for (int c = d; c >= 1; c--)
327    {
328      if (diagonalIsOne)
329        MATELEM(iMat, c, c) = pOne();
330      else
331        MATELEM(iMat, c, c) = pNSet(nInvers(pGetCoeff(MATELEM(lMat, c, c))));
332      for (int r = c + 1; r <= d; r++)
333      {
334        p = NULL;
335        for (int k = c; k <= r - 1; k++)
336        {
337          q = ppMult_qq(MATELEM(lMat, r, k), MATELEM(iMat, k, c));
338          p = pAdd(p, q);
339        }
340        p = pNeg(p);
341        p = pMult(p, pCopy(MATELEM(iMat, c, c)));
342        pNormalize(p);
343        MATELEM(iMat, r, c) = p;
344      }
345    }
346  }
347
348  return invertible;
349}
350
351/**
352 * This code computes the inverse by inverting lMat and uMat, and
353 * then performing two matrix multiplications.
354 **/
355bool luInverseFromLUDecomp(const matrix pMat, const matrix lMat,
356                           const matrix uMat, matrix &iMat, const ring R)
357{ /* uMat is guaranteed to be quadratic */
358  //int d = uMat->rows();
359
360  matrix lMatInverse; /* for storing the inverse of lMat;
361                         this inversion will always work                */
362  matrix uMatInverse; /* for storing the inverse of uMat, if invertible */
363
364  bool result = upperRightTriangleInverse(uMat, uMatInverse, false);
365  if (result)
366  {
367    /* next will always work, since lMat is known to have all diagonal
368       entries equal to 1 */
369    lowerLeftTriangleInverse(lMat, lMatInverse, true);
370    iMat = mp_Mult(mp_Mult(uMatInverse, lMatInverse,R), pMat,R);
371
372    /* clean-up */
373    idDelete((ideal*)&lMatInverse);
374    idDelete((ideal*)&uMatInverse);
375  }
376
377  return result;
378}
379
380bool luSolveViaLUDecomp(const matrix pMat, const matrix lMat,
381                        const matrix uMat, const matrix bVec,
382                        matrix &xVec, matrix &H)
383{
384  int m = uMat->rows(); int n = uMat->cols();
385  matrix cVec = mpNew(m, 1);  /* for storing pMat * bVec */
386  matrix yVec = mpNew(m, 1);  /* for storing the unique solution of
387                                 lMat * yVec = cVec */
388
389  /* compute cVec = pMat * bVec but without actual multiplications */
390  for (int r = 1; r <= m; r++)
391  {
392    for (int c = 1; c <= m; c++)
393    {
394      if (MATELEM(pMat, r, c) != NULL)
395        { MATELEM(cVec, r, 1) = pCopy(MATELEM(bVec, c, 1)); break; }
396    }
397  }
398
399  /* solve lMat * yVec = cVec; this will always work as lMat is invertible;
400     moreover, no divisions are needed, since lMat[i, i] = 1, for all i */
401  for (int r = 1; r <= m; r++)
402  {
403    poly p = pNeg(pCopy(MATELEM(cVec, r, 1)));
404    for (int c = 1; c < r; c++)
405      p = pAdd(p, ppMult_qq(MATELEM(lMat, r, c), MATELEM(yVec, c, 1) ));
406    MATELEM(yVec, r, 1) = pNeg(p);
407    pNormalize(MATELEM(yVec, r, 1));
408  }
409
410  /* determine whether uMat * xVec = yVec is solvable */
411  bool isSolvable = true;
412  bool isZeroRow; int nonZeroRowIndex;
413  for (int r = m; r >= 1; r--)
414  {
415    isZeroRow = true;
416    for (int c = 1; c <= n; c++)
417      if (MATELEM(uMat, r, c) != NULL) { isZeroRow = false; break; }
418    if (isZeroRow)
419    {
420      if (MATELEM(yVec, r, 1) != NULL) { isSolvable = false; break; }
421    }
422    else { nonZeroRowIndex = r; break; }
423  }
424
425  if (isSolvable)
426  {
427    xVec = mpNew(n, 1);
428    matrix N = mpNew(n, n); int dim = 0;
429    poly p; poly q;
430    /* solve uMat * xVec = yVec and determine a basis of the solution
431       space of the homogeneous system uMat * xVec = 0;
432       We do not know in advance what the dimension (dim) of the latter
433       solution space will be. Thus, we start with the possibly too wide
434       matrix N and later copy the relevant columns of N into H. */
435    int nonZeroC; int lastNonZeroC = n + 1;
436    for (int r = nonZeroRowIndex; r >= 1; r--)
437    {
438      for (nonZeroC = 1; nonZeroC <= n; nonZeroC++)
439        if (MATELEM(uMat, r, nonZeroC) != NULL) break;
440      for (int w = lastNonZeroC - 1; w >= nonZeroC + 1; w--)
441      {
442        /* this loop will only be done when the given linear system has
443           more than one, i.e., infinitely many solutions */
444        dim++;
445        /* now we fill two entries of the dim-th column of N */
446        MATELEM(N, w, dim) = pNeg(pCopy(MATELEM(uMat, r, nonZeroC)));
447        MATELEM(N, nonZeroC, dim) = pCopy(MATELEM(uMat, r, w));
448      }
449      for (int d = 1; d <= dim; d++)
450      {
451        /* here we fill the entry of N at [r, d], for each valid vector
452           that we already have in N;
453           again, this will only be done when the given linear system has
454           more than one, i.e., infinitely many solutions */
455        p = NULL;
456        for (int c = nonZeroC + 1; c <= n; c++)
457          if (MATELEM(N, c, d) != NULL)
458            p = pAdd(p, ppMult_qq(MATELEM(uMat, r, c), MATELEM(N, c, d)));
459        q = pNSet(nInvers(pGetCoeff(MATELEM(uMat, r, nonZeroC))));
460        MATELEM(N, nonZeroC, d) = pMult(pNeg(p), q);
461        pNormalize(MATELEM(N, nonZeroC, d));
462      }
463      p = pNeg(pCopy(MATELEM(yVec, r, 1)));
464      for (int c = nonZeroC + 1; c <= n; c++)
465        if (MATELEM(xVec, c, 1) != NULL)
466          p = pAdd(p, ppMult_qq(MATELEM(uMat, r, c), MATELEM(xVec, c, 1)));
467      q = pNSet(nInvers(pGetCoeff(MATELEM(uMat, r, nonZeroC))));
468      MATELEM(xVec, nonZeroC, 1) = pMult(pNeg(p), q);
469      pNormalize(MATELEM(xVec, nonZeroC, 1));
470      lastNonZeroC = nonZeroC;
471    }
472    if (dim == 0)
473    {
474      /* that means the given linear system has exactly one solution;
475         we return as H the 1x1 matrix with entry zero */
476      H = mpNew(1, 1);
477    }
478    else
479    {
480      /* copy the first 'dim' columns of N into H */
481      H = mpNew(n, dim);
482      for (int r = 1; r <= n; r++)
483        for (int c = 1; c <= dim; c++)
484          MATELEM(H, r, c) = pCopy(MATELEM(N, r, c));
485    }
486    /* clean up N */
487    idDelete((ideal*)&N);
488  }
489
490  idDelete((ideal*)&cVec);
491  idDelete((ideal*)&yVec);
492
493  return isSolvable;
494}
495
496/* for debugging:
497   for printing numbers to the console
498   DELETE LATER */
499void printNumber(const number z)
500{
501  if (nIsZero(z)) printf("number = 0\n");
502  else
503  {
504    poly p = pOne();
505    pSetCoeff(p, nCopy(z));
506    pSetm(p);
507    printf("number = %s\n", pString(p));
508    pDelete(&p);
509  }
510}
511
512/* for debugging:
513   for printing matrices to the console
514   DELETE LATER */
515void printMatrix(const matrix m)
516{
517  int rr = MATROWS(m); int cc = MATCOLS(m);
518  printf("\n-------------\n");
519  for (int r = 1; r <= rr; r++)
520  {
521    for (int c = 1; c <= cc; c++)
522      printf("%s  ", pString(MATELEM(m, r, c)));
523    printf("\n");
524  }
525  printf("-------------\n");
526}
527
528/**
529 * Creates a new complex number from real and imaginary parts given
530 * by doubles.
531 *
532 * @return the new complex number
533 **/
534number complexNumber(const double r, const double i)
535{
536  gmp_complex* n= new gmp_complex(r, i);
537  return (number)n;
538}
539
540/**
541 * Returns one over the exponent-th power of ten.
542 *
543 * The method assumes that the base ring is the complex numbers.
544 *
545 * return one over the exponent-th power of 10
546 **/
547number tenToTheMinus(
548       const int exponent  /**< [in]  the exponent for 1/10 */
549                    )
550{
551  number ten = complexNumber(10.0, 0.0);
552  number result = complexNumber(1.0, 0.0);
553  number tmp;
554  /* compute 10^{-exponent} inside result by subsequent divisions by 10 */
555  for (int i = 1; i <= exponent; i++)
556  {
557    tmp = nDiv(result, ten);
558    nDelete(&result);
559    result = tmp;
560  }
561  nDelete(&ten);
562  return result;
563}
564
565/* for debugging:
566   for printing numbers to the console
567   DELETE LATER */
568void printSolutions(const int a, const int b, const int c)
569{
570  printf("\n------\n");
571  /* build the polynomial a*x^2 + b*x + c: */
572  poly p = NULL; poly q = NULL; poly r = NULL;
573  if (a != 0)
574  { p = pOne(); pSetExp(p, 1, 2); pSetm(p); pSetCoeff(p, nInit(a)); }
575  if (b != 0)
576  { q = pOne(); pSetExp(q, 1, 1); pSetm(q); pSetCoeff(q, nInit(b)); }
577  if (c != 0)
578  { r = pOne(); pSetCoeff(r, nInit(c)); }
579  p = pAdd(p, q); p = pAdd(p, r);
580  printf("poly = %s\n", pString(p));
581  number tol = tenToTheMinus(20);
582  number s1; number s2; int nSol = quadraticSolve(p, s1, s2, tol);
583  nDelete(&tol);
584  printf("solution code = %d\n", nSol);
585  if ((1 <= nSol) && (nSol <= 3))
586  {
587    if (nSol != 3) { printNumber(s1); nDelete(&s1); }
588    else { printNumber(s1); nDelete(&s1); printNumber(s2); nDelete(&s2); }
589  }
590  printf("------\n");
591  pDelete(&p);
592}
593
594bool realSqrt(const number n, const number tolerance, number &root)
595{
596  if (!nGreaterZero(n)) return false;
597  if (nIsZero(n)) return nInit(0);
598
599  number oneHalf = complexNumber(0.5, 0.0);
600  number nHalf   = nMult(n, oneHalf);
601  root           = nCopy(n);
602  number nOld    = complexNumber(10.0, 0.0);
603  number nDiff   = nCopy(nOld);
604
605  while (nGreater(nDiff, tolerance))
606  {
607    nDelete(&nOld);
608    nOld = root;
609    root = nAdd(nMult(oneHalf, nOld), nDiv(nHalf, nOld));
610    nDelete(&nDiff);
611    nDiff = nSub(nOld, root);
612    if (!nGreaterZero(nDiff)) nDiff = nNeg(nDiff);
613  }
614
615  nDelete(&nOld); nDelete(&nDiff); nDelete(&oneHalf); nDelete(&nHalf);
616  return true;
617}
618
619int quadraticSolve(const poly p, number &s1, number &s2,
620                   const number tolerance)
621{
622  poly q = pCopy(p);
623  int result;
624
625  if (q == NULL) result = -1;
626  else
627  {
628    int degree = pGetExp(q, 1);
629    if (degree == 0) result = 0;   /* constant polynomial <> 0 */
630    else
631    {
632      number c2 = nInit(0);   /* coefficient of var(1)^2 */
633      number c1 = nInit(0);   /* coefficient of var(1)^1 */
634      number c0 = nInit(0);   /* coefficient of var(1)^0 */
635      if (pGetExp(q, 1) == 2)
636      { nDelete(&c2); c2 = nCopy(pGetCoeff(q)); q = q->next; }
637      if ((q != NULL) && (pGetExp(q, 1) == 1))
638      { nDelete(&c1); c1 = nCopy(pGetCoeff(q)); q = q->next; }
639      if ((q != NULL) && (pGetExp(q, 1) == 0))
640      { nDelete(&c0); c0 = nCopy(pGetCoeff(q)); q = q->next; }
641
642      if (degree == 1)
643      {
644        c0 = nNeg(c0);
645        s1 = nDiv(c0, c1);
646        result = 1;
647      }
648      else
649      {
650        number tmp = nMult(c0, c2);
651        number tmp2 = nAdd(tmp, tmp); nDelete(&tmp);
652        number tmp4 = nAdd(tmp2, tmp2); nDelete(&tmp2);
653        number discr = nSub(nMult(c1, c1), tmp4); nDelete(&tmp4);
654        if (nIsZero(discr))
655        {
656          tmp = nAdd(c2, c2);
657          s1 = nDiv(c1, tmp); nDelete(&tmp);
658          s1 = nNeg(s1);
659          result = 2;
660        }
661        else if (nGreaterZero(discr))
662        {
663          realSqrt(discr, tolerance, tmp);   /* sqrt of the discriminant */
664          tmp2 = nSub(tmp, c1);
665          tmp4 = nAdd(c2, c2);
666          s1 = nDiv(tmp2, tmp4); nDelete(&tmp2);
667          tmp = nNeg(tmp);
668          tmp2 = nSub(tmp, c1); nDelete(&tmp);
669          s2 = nDiv(tmp2, tmp4); nDelete(&tmp2); nDelete(&tmp4);
670          result = 3;
671        }
672        else
673        {
674          discr = nNeg(discr);
675          realSqrt(discr, tolerance, tmp);   /* sqrt of |discriminant| */
676          tmp2 = nAdd(c2, c2);
677          tmp4 = nDiv(tmp, tmp2); nDelete(&tmp);
678          tmp = nDiv(c1, tmp2); nDelete(&tmp2);
679          tmp = nNeg(tmp);
680          s1 = (number)new gmp_complex(((gmp_complex*)tmp)->real(),
681                                       ((gmp_complex*)tmp4)->real());
682          tmp4 = nNeg(tmp4);
683          s2 = (number)new gmp_complex(((gmp_complex*)tmp)->real(),
684                                       ((gmp_complex*)tmp4)->real());
685          nDelete(&tmp); nDelete(&tmp4);
686          result = 3;
687        }
688        nDelete(&discr);
689      }
690      nDelete(&c0); nDelete(&c1); nDelete(&c2);
691    }
692  }
693  pDelete(&q);
694
695  return result;
696}
697
698number euclideanNormSquared(const matrix aMat)
699{
700  int rr = MATROWS(aMat);
701  number result = nInit(0);
702  number tmp1; number tmp2;
703  for (int r = 1; r <= rr; r++)
704    if (MATELEM(aMat, r, 1) != NULL)
705    {
706      tmp1 = nMult(pGetCoeff(MATELEM(aMat, r, 1)),
707                   pGetCoeff(MATELEM(aMat, r, 1)));
708      tmp2 = nAdd(result, tmp1); nDelete(&result); nDelete(&tmp1);
709      result = tmp2;
710    }
711  return result;
712}
713
714/* Returns a new number which is the absolute value of the coefficient
715   of the given polynomial.
716 *
717 * The method assumes that the coefficient has imaginary part zero. */
718number absValue(poly p)
719{
720  if (p == NULL) return nInit(0);
721  number result = nCopy(pGetCoeff(p));
722  if (!nGreaterZero(result)) result = nNeg(result);
723  return result;
724}
725
726bool subMatrix(const matrix aMat, const int rowIndex1, const int rowIndex2,
727               const int colIndex1, const int colIndex2, matrix &subMat)
728{
729  if (rowIndex1 > rowIndex2) return false;
730  if (colIndex1 > colIndex2) return false;
731  int rr = rowIndex2 - rowIndex1 + 1;
732  int cc = colIndex2 - colIndex1 + 1;
733  subMat = mpNew(rr, cc);
734  for (int r = 1; r <= rr; r++)
735    for (int c = 1; c <= cc; c++)
736      MATELEM(subMat, r, c) =
737        pCopy(MATELEM(aMat, rowIndex1 + r - 1, colIndex1 + c - 1));
738  return true;
739}
740
741bool charPoly(const matrix aMat, poly &charPoly)
742{
743  if (MATROWS(aMat) != 2) return false;
744  if (MATCOLS(aMat) != 2) return false;
745  number b = nInit(0); number t;
746  if (MATELEM(aMat, 1, 1) != NULL)
747  { t = nAdd(b, pGetCoeff(MATELEM(aMat, 1, 1))); nDelete(&b); b = t;}
748  if (MATELEM(aMat, 2, 2) != NULL)
749  { t = nAdd(b, pGetCoeff(MATELEM(aMat, 2, 2))); nDelete(&b); b = t;}
750  b = nNeg(b);
751  number t1;
752  if ((MATELEM(aMat, 1, 1) != NULL) && (MATELEM(aMat, 2, 2) != NULL))
753    t1 = nMult(pGetCoeff(MATELEM(aMat, 1, 1)),
754               pGetCoeff(MATELEM(aMat, 2, 2)));
755  else t1 = nInit(0);
756  number t2;
757  if ((MATELEM(aMat, 1, 2) != NULL) && (MATELEM(aMat, 2, 1) != NULL))
758    t2 = nMult(pGetCoeff(MATELEM(aMat, 1, 2)),
759               pGetCoeff(MATELEM(aMat, 2, 1)));
760  else t2 = nInit(0);
761  number c = nSub(t1, t2); nDelete(&t1); nDelete(&t2);
762  poly p = pOne(); pSetExp(p, 1, 2); pSetm(p);
763  poly q = NULL;
764  if (!nIsZero(b))
765  { q = pOne(); pSetExp(q, 1, 1); pSetm(q); pSetCoeff(q, b); }
766  poly r = NULL;
767  if (!nIsZero(c))
768  { r = pOne(); pSetCoeff(r, c); }
769  p = pAdd(p, q); p = pAdd(p, r);
770  charPoly = p;
771  return true;
772}
773
774void swapRows(int row1, int row2, matrix& aMat)
775{
776  poly p;
777  int cc = MATCOLS(aMat);
778  for (int c = 1; c <= cc; c++)
779  {
780    p = MATELEM(aMat, row1, c);
781    MATELEM(aMat, row1, c) = MATELEM(aMat, row2, c);
782    MATELEM(aMat, row2, c) = p;
783  }
784}
785
786void swapColumns(int column1, int column2,  matrix& aMat)
787{
788  poly p;
789  int rr = MATROWS(aMat);
790  for (int r = 1; r <= rr; r++)
791  {
792    p = MATELEM(aMat, r, column1);
793    MATELEM(aMat, r, column1) = MATELEM(aMat, r, column2);
794    MATELEM(aMat, r, column2) = p;
795  }
796}
797
798void matrixBlock(const matrix aMat, const matrix bMat, matrix &block)
799{
800  int rowsA = MATROWS(aMat);
801  int rowsB = MATROWS(bMat);
802  int n = rowsA + rowsB;
803  block = mpNew(n, n);
804  for (int i = 1; i <= rowsA; i++)
805    for (int j = 1; j <= rowsA; j++)
806      MATELEM(block, i, j) = pCopy(MATELEM(aMat, i, j));
807  for (int i = 1; i <= rowsB; i++)
808    for (int j = 1; j <= rowsB; j++)
809      MATELEM(block, i + rowsA, j + rowsA) = pCopy(MATELEM(bMat, i, j));
810}
811
812/**
813 * Computes information related to one householder transformation step for
814 * constructing the Hessenberg form of a given non-derogative matrix.
815 *
816 * The method assumes that all matrix entries are numbers coming from some
817 * subfield of the reals. And that v has a non-zero first entry v_1 and a
818 * second non-zero entry somewhere else.
819 * Given such a vector v, it computes a number r (which will be the return
820 * value of the method), a vector u and a matrix P such that:
821 * 1) P * v = r * e_1,
822 * 2) P = E - u * u^T,
823 * 3) P = P^{-1}.
824 * Note that enforcing norm(u) = sqrt(2), which is done in the algorithm,
825 * guarantees property 3). This can be checked by expanding P^2 using
826 * property 2).
827 *
828 * @return the number r
829 **/
830number hessenbergStep(
831      const matrix vVec,     /**< [in]  the input vector v */
832      matrix &uVec,          /**< [out] the output vector u */
833      matrix &pMat,          /**< [out] the output matrix P */
834      const number tolerance /**< [in]  accuracy for square roots */
835                      )
836{
837  int rr = MATROWS(vVec);
838  number vNormSquared = euclideanNormSquared(vVec);
839  number vNorm; realSqrt(vNormSquared, tolerance, vNorm);
840  /* v1 is guaranteed to be non-zero: */
841  number v1 = pGetCoeff(MATELEM(vVec, 1, 1));
842  bool v1Sign = true; if (nGreaterZero(v1)) v1Sign = false;
843
844  number v1Abs = nCopy(v1); if (v1Sign) v1Abs = nNeg(v1Abs);
845  number t1 = nDiv(v1Abs, vNorm);
846  number one = nInit(1);
847  number t2 = nAdd(t1, one); nDelete(&t1);
848  number denominator; realSqrt(t2, tolerance, denominator); nDelete(&t2);
849  uVec = mpNew(rr, 1);
850  t1 = nDiv(v1Abs, vNorm);
851  t2 = nAdd(t1, one); nDelete(&t1);
852  t1 = nDiv(t2, denominator); nDelete(&t2);
853  MATELEM(uVec, 1, 1) = pOne();
854  pSetCoeff(MATELEM(uVec, 1, 1), t1);   /* we know that t1 != 0 */
855  for (int r = 2; r <= rr; r++)
856  {
857    if (MATELEM(vVec, r, 1) != NULL)
858      t1 = nCopy(pGetCoeff(MATELEM(vVec, r, 1)));
859    else t1 = nInit(0);
860    if (v1Sign) t1 = nNeg(t1);
861    t2 = nDiv(t1, vNorm); nDelete(&t1);
862    t1 = nDiv(t2, denominator); nDelete(&t2);
863    if (!nIsZero(t1))
864    {
865      MATELEM(uVec, r, 1) = pOne();
866      pSetCoeff(MATELEM(uVec, r, 1), t1);
867    }
868    else nDelete(&t1);
869  }
870  nDelete(&denominator);
871
872  /* finished building vector u; now turn to pMat */
873  pMat = mpNew(rr, rr);
874  /* we set P := E - u * u^T, as desired */
875  for (int r = 1; r <= rr; r++)
876    for (int c = 1; c <= rr; c++)
877    {
878      if ((MATELEM(uVec, r, 1) != NULL) && (MATELEM(uVec, c, 1) != NULL))
879        t1 = nMult(pGetCoeff(MATELEM(uVec, r, 1)),
880                   pGetCoeff(MATELEM(uVec, c, 1)));
881      else t1 = nInit(0);
882      if (r == c) { t2 = nSub(one, t1); nDelete(&t1); }
883      else          t2 = nNeg(t1);
884      if (!nIsZero(t2))
885      {
886        MATELEM(pMat, r, c) = pOne();
887        pSetCoeff(MATELEM(pMat, r, c), t2);
888      }
889      else nDelete(&t2);
890    }
891  nDelete(&one);
892  /* finished building pMat; now compute the return value */
893  t1 = vNormSquared; if (v1Sign) t1 = nNeg(t1);
894  t2 = nMult(v1, vNorm);
895  number t3 = nAdd(t1, t2); nDelete(&t1); nDelete(&t2);
896  t1 = nAdd(v1Abs, vNorm); nDelete(&v1Abs); nDelete(&vNorm);
897  t2 = nDiv(t3, t1); nDelete(&t1); nDelete(&t3);
898  t2 = nNeg(t2);
899  return t2;
900}
901
902void hessenberg(const matrix aMat, matrix &pMat, matrix &hessenbergMat,
903                const number tolerance, const ring R)
904{
905  int n = MATROWS(aMat);
906  unitMatrix(n, pMat);
907  subMatrix(aMat, 1, n, 1, n, hessenbergMat);
908  for (int c = 1; c <= n; c++)
909  {
910    /* find one or two non-zero entries in the current column */
911    int r1 = 0; int r2 = 0;
912    for (int r = c + 1; r <= n; r++)
913      if (MATELEM(hessenbergMat, r, c) != NULL)
914      {
915        if      (r1 == 0)   r1 = r;
916        else if (r2 == 0) { r2 = r; break; }
917      }
918    if (r1 != 0)
919    { /* At least one entry in the current column is non-zero. */
920      if (r1 != c + 1)
921      { /* swap rows to bring non-zero element to row with index c + 1 */
922        swapRows(r1, c + 1, hessenbergMat);
923        /* now also swap columns to reflect action of permutation
924           from the right-hand side */
925        swapColumns(r1, c + 1, hessenbergMat);
926        /* include action of permutation also in pMat */
927        swapRows(r1, c + 1, pMat);
928      }
929      if (r2 != 0)
930      { /* There is at least one more non-zero element in the current
931           column. So let us perform a hessenberg step in order to make
932           all additional non-zero elements zero. */
933        matrix v; subMatrix(hessenbergMat, c + 1, n, c, c, v);
934        matrix u; matrix pTmp;
935        number r = hessenbergStep(v, u, pTmp, tolerance);
936        idDelete((ideal*)&v); idDelete((ideal*)&u); nDelete(&r);
937        /* pTmp just acts on the lower right block of hessenbergMat;
938           i.e., it needs to be extended by a unit matrix block at the top
939           left in order to define a whole transformation matrix;
940           this code may be optimized */
941        unitMatrix(c, u);
942        matrix pTmpFull; matrixBlock(u, pTmp, pTmpFull);
943        idDelete((ideal*)&u); idDelete((ideal*)&pTmp);
944        /* now include pTmpFull in pMat (by letting it act from the left) */
945        pTmp = mp_Mult(pTmpFull, pMat,R); idDelete((ideal*)&pMat);
946        pMat = pTmp;
947        /* now let pTmpFull act on hessenbergMat from the left and from the
948           right (note that pTmpFull is self-inverse) */
949        pTmp = mp_Mult(pTmpFull, hessenbergMat,R);
950        idDelete((ideal*)&hessenbergMat);
951        hessenbergMat = mp_Mult(pTmp, pTmpFull, R);
952        idDelete((ideal*)&pTmp); idDelete((ideal*)&pTmpFull);
953        /* as there may be inaccuracy, we erase those entries of hessenbergMat
954           which must have become zero by the last transformation */
955        for (int r = c + 2; r <= n; r++)
956          pDelete(&MATELEM(hessenbergMat, r, c));
957      }
958    }
959  }
960}
961
962/**
963 * Performs one transformation step on the given matrix H as part of
964 * the gouverning QR double shift algorith.
965 * The method will change the given matrix H side-effect-wise. The resulting
966 * matrix H' will be in Hessenberg form.
967 * The iteration index is needed, since for the 11th and 21st iteration,
968 * the transformation step is different from the usual step, to avoid
969 * convergence problems of the gouverning QR double shift process (who is
970 * also the only caller of this method).
971 **/
972void mpTrafo(
973      matrix &H,             /**< [in/out]  the matrix to be transformed */
974      int it,                /**< [in]      iteration index */
975      const number tolerance,/**< [in]      accuracy for square roots */
976      const ring R
977            )
978{
979  int n = MATROWS(H);
980  number trace; number det; number tmp1; number tmp2; number tmp3;
981
982  if ((it != 11) && (it != 21)) /* the standard case */
983  {
984    /* in this case 'trace' will really be the trace of the lowermost
985       (2x2) block of hMat */
986    trace = nInit(0);
987    det = nInit(0);
988    if (MATELEM(H, n - 1, n - 1) != NULL)
989    {
990      tmp1 = nAdd(trace, pGetCoeff(MATELEM(H, n - 1, n - 1)));
991      nDelete(&trace);
992      trace = tmp1;
993    }
994    if (MATELEM(H, n, n) != NULL)
995    {
996      tmp1 = nAdd(trace, pGetCoeff(MATELEM(H, n, n)));
997      nDelete(&trace);
998      trace = tmp1;
999    }
1000    /* likewise 'det' will really be the determinante of the lowermost
1001       (2x2) block of hMat */
1002    if ((MATELEM(H, n - 1, n - 1 ) != NULL) && (MATELEM(H, n, n) != NULL))
1003    {
1004      tmp1 = nMult(pGetCoeff(MATELEM(H, n - 1, n - 1)),
1005                   pGetCoeff(MATELEM(H, n, n)));
1006      tmp2 = nAdd(tmp1, det); nDelete(&tmp1); nDelete(&det);
1007      det = tmp2;
1008    }
1009    if ((MATELEM(H, n - 1, n) != NULL) && (MATELEM(H, n, n - 1) != NULL))
1010    {
1011      tmp1 = nMult(pGetCoeff(MATELEM(H, n - 1, n)),
1012                   pGetCoeff(MATELEM(H, n, n - 1)));
1013      tmp2 = nSub(det, tmp1); nDelete(&tmp1); nDelete(&det);
1014      det = tmp2;
1015    }
1016  }
1017  else
1018  {
1019    /* for it = 11 or it = 21, we use special formulae to avoid convergence
1020       problems of the gouverning QR double shift algorithm (who is the only
1021       caller of this method) */
1022    /* trace = 3/2 * (|hMat[n, n-1]| + |hMat[n-1, n-2]|) */
1023    tmp1 = nInit(0);
1024    if (MATELEM(H, n, n - 1) != NULL)
1025    { nDelete(&tmp1); tmp1 = nCopy(pGetCoeff(MATELEM(H, n, n - 1))); }
1026    if (!nGreaterZero(tmp1)) tmp1 = nNeg(tmp1);
1027    tmp2 = nInit(0);
1028    if (MATELEM(H, n - 1, n - 2) != NULL)
1029    { nDelete(&tmp2); tmp2 = nCopy(pGetCoeff(MATELEM(H, n - 1, n - 2))); }
1030    if (!nGreaterZero(tmp2)) tmp2 = nNeg(tmp2);
1031    tmp3 = nAdd(tmp1, tmp2); nDelete(&tmp1); nDelete(&tmp2);
1032    tmp1 = nInit(3); tmp2 = nInit(2);
1033    trace = nDiv(tmp1, tmp2); nDelete(&tmp1); nDelete(&tmp2);
1034    tmp1 = nMult(tmp3, trace); nDelete(&trace);
1035    trace = tmp1;
1036    /* det = (|hMat[n, n-1]| + |hMat[n-1, n-2]|)^2 */
1037    det = nMult(tmp3, tmp3); nDelete(&tmp3);
1038  }
1039  matrix c = mpNew(n, 1);
1040  trace = nNeg(trace);
1041  MATELEM(c,1,1) = pAdd(pAdd(pAdd(ppMult_qq(MATELEM(H,1,1), MATELEM(H,1,1)),
1042                                  ppMult_qq(MATELEM(H,1,2), MATELEM(H,2,1))),
1043                             ppMult_nn(MATELEM(H,1,1), trace)),
1044                        pMult_nn(pOne(), det));
1045  MATELEM(c,2,1) = pAdd(pMult(pCopy(MATELEM(H,2,1)),
1046                              pAdd(pCopy(MATELEM(H,1,1)),
1047                                   pCopy(MATELEM(H,2,2)))),
1048                        ppMult_nn(MATELEM(H,2,1), trace));
1049  MATELEM(c,3,1) = ppMult_qq(MATELEM(H,2,1), MATELEM(H,3,2));
1050  nDelete(&trace); nDelete(&det);
1051
1052  /* for applying hessenbergStep, we need to make sure that c[1, 1] is
1053     not zero */
1054  if ((MATELEM(c,1,1) != NULL) &&
1055      ((MATELEM(c,2,1) != NULL) || (MATELEM(c,3,1) != NULL)))
1056  {
1057    matrix uVec; matrix hMat;
1058    tmp1 = hessenbergStep(c, uVec, hMat, tolerance); nDelete(&tmp1);
1059    /* now replace H by hMat * H * hMat: */
1060    matrix wMat = mp_Mult(hMat, H,R); idDelete((ideal*)&H);
1061    matrix H1 = mp_Mult(wMat, hMat,R);
1062    idDelete((ideal*)&wMat); idDelete((ideal*)&hMat);
1063    /* now need to re-establish Hessenberg form of H1 and put it in H */
1064    hessenberg(H1, wMat, H, tolerance,R);
1065    idDelete((ideal*)&wMat); idDelete((ideal*)&H1);
1066  }
1067  else if ((MATELEM(c,1,1) == NULL) && (MATELEM(c,2,1) != NULL))
1068  {
1069    swapRows(1, 2, H);
1070    swapColumns(1, 2, H);
1071  }
1072  else if ((MATELEM(c,1,1) == NULL) && (MATELEM(c,3,1) != NULL))
1073  {
1074    swapRows(1, 3, H);
1075    swapColumns(1, 3, H);
1076  }
1077  else
1078  { /* c is the zero vector or a multiple of e_1;
1079       no hessenbergStep needed */ }
1080}
1081
1082/* helper for qrDoubleShift */
1083bool qrDS(
1084       const int n,
1085       matrix* queue,
1086       int& queueL,
1087       number* eigenValues,
1088       int& eigenValuesL,
1089       const number tol1,
1090       const number tol2,
1091       const ring R
1092         )
1093{
1094  bool deflationFound = true;
1095  /* we loop until the working queue is empty,
1096     provided we always find deflation */
1097  while (deflationFound && (queueL > 0))
1098  {
1099    /* take out last queue entry */
1100    matrix currentMat = queue[queueL - 1]; queueL--;
1101    int m = MATROWS(currentMat);
1102    if (m == 1)
1103    {
1104      number newEigenvalue;
1105      /* the entry at [1, 1] is the eigenvalue */
1106      if (MATELEM(currentMat, 1, 1) == NULL) newEigenvalue = nInit(0);
1107      else newEigenvalue = nCopy(pGetCoeff(MATELEM(currentMat, 1, 1)));
1108      eigenValues[eigenValuesL++] = newEigenvalue;
1109    }
1110    else if (m == 2)
1111    {
1112      /* there are two eigenvalues which come as zeros of the characteristic
1113         polynomial */
1114      poly p; charPoly(currentMat, p);
1115      number s1; number s2;
1116      int nSol = quadraticSolve(p, s1, s2, tol2); pDelete(&p);
1117      assume(nSol >= 2);
1118      eigenValues[eigenValuesL++] = s1;
1119      /* if nSol = 2, then s1 is a double zero, and s2 is invalid: */
1120      if (nSol == 2) s2 = nCopy(s1);
1121      eigenValues[eigenValuesL++] = s2;
1122    }
1123    else /* m > 2 */
1124    {
1125      /* bring currentMat into Hessenberg form to fasten computations: */
1126      matrix mm1; matrix mm2;
1127      hessenberg(currentMat, mm1, mm2, tol2,R);
1128      idDelete((ideal*)&currentMat); idDelete((ideal*)&mm1);
1129      currentMat = mm2;
1130      int it = 1; bool doLoop = true;
1131      while (doLoop && (it <= 30 * m))
1132      {
1133        /* search for deflation */
1134        number w1; number w2;
1135        number test1; number test2; bool stopCriterion = false; int k;
1136        for (k = 1; k < m; k++)
1137        {
1138          test1 = absValue(MATELEM(currentMat, k + 1, k));
1139          w1 = absValue(MATELEM(currentMat, k, k));
1140          w2 = absValue(MATELEM(currentMat, k + 1, k + 1));
1141          test2 = nMult(tol1, nAdd(w1, w2));
1142          nDelete(&w1); nDelete(&w2);
1143          if (!nGreater(test1, test2)) stopCriterion = true;
1144          nDelete(&test1); nDelete(&test2);
1145          if (stopCriterion) break;
1146        }
1147        if (k < m)   /* found deflation at position (k + 1, k) */
1148        {
1149          pDelete(&MATELEM(currentMat, k + 1, k)); /* make this entry zero */
1150          subMatrix(currentMat, 1, k, 1, k, queue[queueL++]);
1151          subMatrix(currentMat, k + 1, m, k + 1, m, queue[queueL++]);
1152          doLoop = false;
1153        }
1154        else   /* no deflation found yet */
1155        {
1156          mpTrafo(currentMat, it, tol2,R);
1157          it++;   /* try again */
1158        }
1159      }
1160      if (doLoop)   /* could not find deflation for currentMat */
1161      {
1162        deflationFound = false;
1163      }
1164      idDelete((ideal*)&currentMat);
1165    }
1166  }
1167  return deflationFound;
1168}
1169
1170/**
1171 * Tries to find the number n in the array nn[0..nnLength-1].
1172 *
1173 * The method assumes that the ground field is the complex numbers.
1174 * n and an entry of nn will be regarded equal when the absolute
1175 * value of their difference is not larger than the given tolerance.
1176 * In this case, the index of the respective entry of nn is returned,
1177 * otherwise -1.
1178 *
1179 * @return the index of n in nn (up to tolerance) or -1
1180 **/
1181int similar(
1182       const number* nn,       /**< [in] array of numbers to look-up */
1183       const int nnLength,     /**< [in] length of nn                */
1184       const number n,         /**< [in] number to loop-up in nn     */
1185       const number tolerance  /**< [in] tolerance for comparison    */
1186           )
1187{
1188  int result = -1;
1189  number tt = nMult(tolerance, tolerance);
1190  number nr = (number)new gmp_complex(((gmp_complex*)n)->real());
1191  number ni = (number)new gmp_complex(((gmp_complex*)n)->imag());
1192  number rr; number ii;
1193  number w1; number w2; number w3; number w4; number w5;
1194  for (int i = 0; i < nnLength; i++)
1195  {
1196    rr = (number)new gmp_complex(((gmp_complex*)nn[i])->real());
1197    ii = (number)new gmp_complex(((gmp_complex*)nn[i])->imag());
1198    w1 = nSub(nr, rr); w2 = nMult(w1, w1);
1199    w3 = nSub(ni, ii); w4 = nMult(w3, w3);
1200    w5 = nAdd(w2, w4);
1201    if (!nGreater(w5, tt)) result = i;
1202    nDelete(&w1); nDelete(&w2); nDelete(&w3); nDelete(&w4);
1203                nDelete(&w5); nDelete(&rr); nDelete(&ii);
1204    if (result != -1) break;
1205  }
1206  nDelete(&tt); nDelete(&nr); nDelete(&ni);
1207  return result;
1208}
1209
1210/* This codes assumes that there are at least two variables in the current
1211   base ring. No assumption is made regarding the monomial ordering. */
1212void henselFactors(const int xIndex, const int yIndex, const poly h,
1213                   const poly f0, const poly g0, const int d, poly &f, poly &g)
1214{
1215  int n = (int)p_Deg(f0,currRing);
1216  int m = (int)p_Deg(g0,currRing);
1217  matrix aMat = mpNew(n + m, n + m);     /* matrix A for linear system */
1218  matrix pMat; matrix lMat; matrix uMat; /* for the decomposition of A */
1219  f = pCopy(f0); g = pCopy(g0);          /* initially: h = f*g mod <x^1> */
1220
1221  /* initial step: read off coefficients of f0, and g0 */
1222  poly p = f0; poly matEntry; number c;
1223  while (p != NULL)
1224  {
1225    c = nCopy(pGetCoeff(p));
1226    matEntry = pOne(); pSetCoeff(matEntry, c);
1227    MATELEM(aMat, pGetExp(p, yIndex) + 1, 1) = matEntry;
1228    p = pNext(p);
1229  }
1230  p = g0;
1231  while (p != NULL)
1232  {
1233    c = nCopy(pGetCoeff(p));
1234    matEntry = pOne(); pSetCoeff(matEntry, c);
1235    MATELEM(aMat, pGetExp(p, yIndex) + 1, m + 1) = matEntry;
1236    p = pNext(p);
1237  }
1238  /* fill the rest of A */
1239  for (int row = 2; row <= n + 1; row++)
1240    for (int col = 2; col <= m; col++)
1241    {
1242      if (col > row) break;
1243      MATELEM(aMat, row, col) = pCopy(MATELEM(aMat, row - 1, col - 1));
1244    }
1245  for (int row = n + 2; row <= n + m; row++)
1246    for (int col = row - n; col <= m; col++)
1247      MATELEM(aMat, row, col) = pCopy(MATELEM(aMat, row - 1, col - 1));
1248  for (int row = 2; row <= m + 1; row++)
1249    for (int col = m + 2; col <= m + n; col++)
1250    {
1251      if (col - m > row) break;
1252      MATELEM(aMat, row, col) = pCopy(MATELEM(aMat, row - 1, col - 1));
1253    }
1254  for (int row = m + 2; row <= n + m; row++)
1255    for (int col = row; col <= m + n; col++)
1256      MATELEM(aMat, row, col) = pCopy(MATELEM(aMat, row - 1, col - 1));
1257
1258  /* constructing the LU-decomposition of A */
1259  luDecomp(aMat, pMat, lMat, uMat);
1260
1261  /* Before the xExp-th loop, we know that h = f*g mod <x^xExp>.
1262     Afterwards the algorithm ensures      h = f*g mod <x^(xExp + 1)>.
1263     Hence in the end we obtain f and g as required, i.e.,
1264                                           h = f*g mod <x^(d+1)>.
1265     The algorithm works by solving a (m+n)x(m+n) linear equation system
1266     A*x = b with constant matrix A (as decomposed above). By theory, the
1267     system is guaranteed to have a unique solution. */
1268  poly fg = ppMult_qq(f, g);   /* for storing the product of f and g */
1269  for (int xExp = 1; xExp <= d; xExp++)
1270  {
1271    matrix bVec = mpNew(n + m, 1);     /* b */
1272    matrix xVec = mpNew(n + m, 1);     /* x */
1273
1274    p = pCopy(fg);
1275    p = pAdd(pCopy(h), pNeg(p));       /* p = h - f*g */
1276    /* we collect all terms in p with x-exponent = xExp and use their
1277       coefficients to build the vector b */
1278    int bIsZeroVector = true;
1279    while (p != NULL)
1280    {
1281      if (pGetExp(p, xIndex) == xExp)
1282      {
1283        number c = nCopy(pGetCoeff(p));
1284        poly matEntry = pOne(); pSetCoeff(matEntry, c);
1285        MATELEM(bVec, pGetExp(p, yIndex) + 1, 1) = matEntry;
1286        if (matEntry != NULL) bIsZeroVector = false;
1287      }
1288      pLmDelete(&p); /* destruct leading term of p and move to next term */
1289    }
1290    /* solve the linear equation system */
1291    if (!bIsZeroVector) /* otherwise x = 0 and f, g do not change */
1292    {
1293      matrix notUsedMat;
1294      luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, notUsedMat);
1295      idDelete((ideal*)&notUsedMat);
1296      /* update f and g by newly computed terms, and update f*g */
1297      poly fNew = NULL; poly gNew = NULL;
1298      for (int row = 1; row <= m; row++)
1299      {
1300        if (MATELEM(xVec, row, 1) != NULL)
1301        {
1302          p = pCopy(MATELEM(xVec, row, 1));   /* p = c                  */
1303          pSetExp(p, xIndex, xExp);           /* p = c * x^xExp         */
1304          pSetExp(p, yIndex, row - 1);        /* p = c * x^xExp * y^i   */
1305          pSetm(p);
1306          gNew = pAdd(gNew, p);
1307        }
1308      }
1309      for (int row = m + 1; row <= m + n; row++)
1310      {
1311        if (MATELEM(xVec, row, 1) != NULL)
1312        {
1313          p = pCopy(MATELEM(xVec, row, 1));   /* p = c                  */
1314          pSetExp(p, xIndex, xExp);           /* p = c * x^xExp         */
1315          pSetExp(p, yIndex, row - m - 1);    /* p = c * x^xExp * y^i   */
1316          pSetm(p);
1317          fNew = pAdd(fNew, p);
1318        }
1319      }
1320      fg = pAdd(fg, ppMult_qq(f, gNew));
1321      fg = pAdd(fg, ppMult_qq(g, fNew));
1322      fg = pAdd(fg, ppMult_qq(fNew, gNew));
1323      f = pAdd(f, fNew);
1324      g = pAdd(g, gNew);
1325    }
1326    /* clean-up loop-dependent vectors */
1327    idDelete((ideal*)&bVec); idDelete((ideal*)&xVec);
1328  }
1329
1330  /* clean-up matrices A, P, L and U, and polynomial fg */
1331  idDelete((ideal*)&aMat); idDelete((ideal*)&pMat);
1332  idDelete((ideal*)&lMat); idDelete((ideal*)&uMat);
1333  pDelete(&fg);
1334}
1335
1336void lduDecomp(const matrix aMat, matrix &pMat, matrix &lMat, matrix &dMat,
1337               matrix &uMat, poly &l, poly &u, poly &lTimesU)
1338{
1339  int rr = aMat->rows();
1340  int cc = aMat->cols();
1341  /* we use an int array to store all row permutations;
1342     note that we only make use of the entries [1..rr] */
1343  int* permut = new int[rr + 1];
1344  for (int i = 1; i <= rr; i++) permut[i] = i;
1345  /* fill lMat and dMat with the (rr x rr) unit matrix */
1346  unitMatrix(rr, lMat);
1347  unitMatrix(rr, dMat);
1348  uMat = mpNew(rr, cc);
1349  /* copy aMat into uMat: */
1350  for (int r = 1; r <= rr; r++)
1351    for (int c = 1; c <= cc; c++)
1352      MATELEM(uMat, r, c) = pCopy(MATELEM(aMat, r, c));
1353  u = pOne(); l = pOne();
1354
1355  int col = 1; int row = 1;
1356  while ((col <= cc) & (row < rr))
1357  {
1358    int pivotR; int pivotC; bool pivotValid = false;
1359    while (col <= cc)
1360    {
1361      pivotValid = pivot(uMat, row, rr, col, col, &pivotR, &pivotC);
1362      if (pivotValid)  break;
1363      col++;
1364    }
1365    if (pivotValid)
1366    {
1367      if (pivotR != row)
1368      {
1369        swapRows(row, pivotR, uMat);
1370        poly p = MATELEM(dMat, row, row);
1371        MATELEM(dMat, row, row) = MATELEM(dMat, pivotR, pivotR);
1372        MATELEM(dMat, pivotR, pivotR) = p;
1373        swapColumns(row, pivotR, lMat);
1374        swapRows(row, pivotR, lMat);
1375        int temp = permut[row];
1376        permut[row] = permut[pivotR]; permut[pivotR] = temp;
1377      }
1378      /* in gg, we compute the gcd of all non-zero elements in
1379         uMat[row..rr, col];
1380         the next number is the pivot and thus guaranteed to be different
1381         from zero: */
1382      number gg = nCopy(pGetCoeff(MATELEM(uMat, row, col))); number t;
1383      for (int r = row + 1; r <= rr; r++)
1384      {
1385        if (MATELEM(uMat, r, col) != NULL)
1386        {
1387          t = gg;
1388          gg = nGcd(t, pGetCoeff(MATELEM(uMat, r, col)));
1389          nDelete(&t);
1390        }
1391      }
1392      t = nDiv(pGetCoeff(MATELEM(uMat, row, col)), gg);
1393      nNormalize(t);   /* this division works without remainder */
1394      if (!nIsOne(t))
1395      {
1396        for (int r = row; r <= rr; r++)
1397          pMult_nn(MATELEM(dMat, r, r), t);
1398        pMult_nn(MATELEM(lMat, row, row), t);
1399      }
1400      l = pMult(l, pCopy(MATELEM(lMat, row, row)));
1401      u = pMult(u, pCopy(MATELEM(uMat, row, col)));
1402
1403      for (int r = row + 1; r <= rr; r++)
1404      {
1405        if (MATELEM(uMat, r, col) != NULL)
1406        {
1407          number g = nGcd(pGetCoeff(MATELEM(uMat, row, col)),
1408                          pGetCoeff(MATELEM(uMat, r, col)));
1409          number f1 = nDiv(pGetCoeff(MATELEM(uMat, r, col)), g);
1410          nNormalize(f1);   /* this division works without remainder */
1411          number f2 = nDiv(pGetCoeff(MATELEM(uMat, row, col)), g);
1412          nNormalize(f2);   /* this division works without remainder */
1413          pDelete(&MATELEM(uMat, r, col)); MATELEM(uMat, r, col) = NULL;
1414          for (int c = col + 1; c <= cc; c++)
1415          {
1416            poly p = MATELEM(uMat, r, c);
1417            pMult_nn(p, f2);
1418            poly q = pCopy(MATELEM(uMat, row, c));
1419            pMult_nn(q, f1); q = pNeg(q);
1420            MATELEM(uMat, r, c) = pAdd(p, q);
1421          }
1422          number tt = nDiv(g, gg);
1423          nNormalize(tt);   /* this division works without remainder */
1424          pMult_nn(MATELEM(lMat, r, r), tt); nDelete(&tt);
1425          MATELEM(lMat, r, row) = pCopy(MATELEM(lMat, r, r));
1426          pMult_nn(MATELEM(lMat, r, row), f1);
1427          nDelete(&f1); nDelete(&f2); nDelete(&g);
1428        }
1429        else pMult_nn(MATELEM(lMat, r, r), t);
1430      }
1431      nDelete(&t); nDelete(&gg);
1432      col++; row++;
1433    }
1434  }
1435  /* one factor in the product u might be missing: */
1436  if (row == rr)
1437  {
1438    while ((col <= cc) && (MATELEM(uMat, row, col) == NULL)) col++;
1439    if (col <= cc) u = pMult(u, pCopy(MATELEM(uMat, row, col)));
1440  }
1441
1442  /* building the permutation matrix from 'permut' and computing l */
1443  pMat = mpNew(rr, rr);
1444  for (int r = 1; r <= rr; r++)
1445    MATELEM(pMat, r, permut[r]) = pOne();
1446  delete[] permut;
1447
1448  lTimesU = ppMult_qq(l, u);
1449}
1450
1451bool luSolveViaLDUDecomp(const matrix pMat, const matrix lMat,
1452                         const matrix dMat, const matrix uMat,
1453                         const poly l, const poly u, const poly lTimesU,
1454                         const matrix bVec, matrix &xVec, matrix &H)
1455{
1456  int m = uMat->rows(); int n = uMat->cols();
1457  matrix cVec = mpNew(m, 1);  /* for storing l * pMat * bVec */
1458  matrix yVec = mpNew(m, 1);  /* for storing the unique solution of
1459                                 lMat * yVec = cVec */
1460
1461  /* compute cVec = l * pMat * bVec but without actual matrix mult. */
1462  for (int r = 1; r <= m; r++)
1463  {
1464    for (int c = 1; c <= m; c++)
1465    {
1466      if (MATELEM(pMat, r, c) != NULL)
1467        { MATELEM(cVec, r, 1) = ppMult_qq(l, MATELEM(bVec, c, 1)); break; }
1468    }
1469  }
1470
1471  /* solve lMat * yVec = cVec; this will always work as lMat is invertible;
1472     moreover, all divisions are guaranteed to be without remainder */
1473  poly p; poly q;
1474  for (int r = 1; r <= m; r++)
1475  {
1476    p = pNeg(pCopy(MATELEM(cVec, r, 1)));
1477    for (int c = 1; c < r; c++)
1478      p = pAdd(p, ppMult_qq(MATELEM(lMat, r, c), MATELEM(yVec, c, 1) ));
1479    /* The following division is without remainder. */
1480    q = pNSet(nInvers(pGetCoeff(MATELEM(lMat, r, r))));
1481    MATELEM(yVec, r, 1) = pMult(pNeg(p), q);
1482    pNormalize(MATELEM(yVec, r, 1));
1483  }
1484
1485  /* compute u * dMat * yVec and put result into yVec */
1486  for (int r = 1; r <= m; r++)
1487  {
1488    p = ppMult_qq(u, MATELEM(dMat, r, r));
1489    MATELEM(yVec, r, 1) = pMult(p, MATELEM(yVec, r, 1));
1490  }
1491
1492  /* determine whether uMat * xVec = yVec is solvable */
1493  bool isSolvable = true;
1494  bool isZeroRow; int nonZeroRowIndex;
1495  for (int r = m; r >= 1; r--)
1496  {
1497    isZeroRow = true;
1498    for (int c = 1; c <= n; c++)
1499      if (MATELEM(uMat, r, c) != NULL) { isZeroRow = false; break; }
1500    if (isZeroRow)
1501    {
1502      if (MATELEM(yVec, r, 1) != NULL) { isSolvable = false; break; }
1503    }
1504    else { nonZeroRowIndex = r; break; }
1505  }
1506
1507  if (isSolvable)
1508  {
1509    xVec = mpNew(n, 1);
1510    matrix N = mpNew(n, n); int dim = 0;
1511    /* solve uMat * xVec = yVec and determine a basis of the solution
1512       space of the homogeneous system uMat * xVec = 0;
1513       We do not know in advance what the dimension (dim) of the latter
1514       solution space will be. Thus, we start with the possibly too wide
1515       matrix N and later copy the relevant columns of N into H. */
1516    int nonZeroC; int lastNonZeroC = n + 1;
1517    for (int r = nonZeroRowIndex; r >= 1; r--)
1518    {
1519      for (nonZeroC = 1; nonZeroC <= n; nonZeroC++)
1520        if (MATELEM(uMat, r, nonZeroC) != NULL) break;
1521      for (int w = lastNonZeroC - 1; w >= nonZeroC + 1; w--)
1522      {
1523        /* this loop will only be done when the given linear system has
1524           more than one, i.e., infinitely many solutions */
1525        dim++;
1526        /* now we fill two entries of the dim-th column of N */
1527        MATELEM(N, w, dim) = pNeg(pCopy(MATELEM(uMat, r, nonZeroC)));
1528        MATELEM(N, nonZeroC, dim) = pCopy(MATELEM(uMat, r, w));
1529      }
1530      for (int d = 1; d <= dim; d++)
1531      {
1532        /* here we fill the entry of N at [r, d], for each valid vector
1533           that we already have in N;
1534           again, this will only be done when the given linear system has
1535           more than one, i.e., infinitely many solutions */
1536        p = NULL;
1537        for (int c = nonZeroC + 1; c <= n; c++)
1538          if (MATELEM(N, c, d) != NULL)
1539            p = pAdd(p, ppMult_qq(MATELEM(uMat, r, c), MATELEM(N, c, d)));
1540        /* The following division may be with remainder but only takes place
1541           when dim > 0. */
1542        q = pNSet(nInvers(pGetCoeff(MATELEM(uMat, r, nonZeroC))));
1543        MATELEM(N, nonZeroC, d) = pMult(pNeg(p), q);
1544        pNormalize(MATELEM(N, nonZeroC, d));
1545      }
1546      p = pNeg(pCopy(MATELEM(yVec, r, 1)));
1547      for (int c = nonZeroC + 1; c <= n; c++)
1548        if (MATELEM(xVec, c, 1) != NULL)
1549          p = pAdd(p, ppMult_qq(MATELEM(uMat, r, c), MATELEM(xVec, c, 1)));
1550      /* The following division is without remainder. */
1551      q = pNSet(nInvers(pGetCoeff(MATELEM(uMat, r, nonZeroC))));
1552      MATELEM(xVec, nonZeroC, 1) = pMult(pNeg(p), q);
1553      pNormalize(MATELEM(xVec, nonZeroC, 1));
1554      lastNonZeroC = nonZeroC;
1555    }
1556
1557    /* divide xVec by l*u = lTimesU and put result in xVec */
1558    number z = nInvers(pGetCoeff(lTimesU));
1559    for (int c = 1; c <= n; c++)
1560    {
1561      pMult_nn(MATELEM(xVec, c, 1), z);
1562      pNormalize(MATELEM(xVec, c, 1));
1563    }
1564    nDelete(&z);
1565
1566    if (dim == 0)
1567    {
1568      /* that means the given linear system has exactly one solution;
1569         we return as H the 1x1 matrix with entry zero */
1570      H = mpNew(1, 1);
1571    }
1572    else
1573    {
1574      /* copy the first 'dim' columns of N into H */
1575      H = mpNew(n, dim);
1576      for (int r = 1; r <= n; r++)
1577        for (int c = 1; c <= dim; c++)
1578          MATELEM(H, r, c) = pCopy(MATELEM(N, r, c));
1579    }
1580    /* clean up N */
1581    idDelete((ideal*)&N);
1582  }
1583
1584  idDelete((ideal*)&cVec);
1585  idDelete((ideal*)&yVec);
1586
1587  return isSolvable;
1588}
1589
Note: See TracBrowser for help on using the repository browser.