source: git/kernel/linearAlgebra.cc @ 16f511

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