Mercurial > octave
changeset 23296:3b2dbed26762 stable
Fix eigs for the generalized eigenvalue problem (bug #50546)
* liboctave/numeric/eigs-base.cc: fix ltsolve and utsolve when a nontrivial
Q is given, fix the operator which computes mtmp in EigsRealSymmetricMatrix.
* scripts/sparse/eigs.m: improve the documentation for permB, add tests for
the generalized problem.
author | Marco Caliari <marco.caliari@univr.it> |
---|---|
date | Thu, 16 Mar 2017 09:44:44 +0100 |
parents | 6cbf5c2d4d55 |
children | f093b9d4ef30 |
files | liboctave/numeric/eigs-base.cc scripts/sparse/eigs.m |
diffstat | 2 files changed, 66 insertions(+), 29 deletions(-) [+] |
line wrap: on
line diff
--- a/liboctave/numeric/eigs-base.cc Fri Mar 10 13:15:23 2017 +0100 +++ b/liboctave/numeric/eigs-base.cc Thu Mar 16 09:44:44 2017 +0100 @@ -78,12 +78,33 @@ static M ltsolve (const SM& L, const ColumnVector& Q, const M& m) { + // Solve (Q_mat * L) * x = m, that is L * x = Q_mat' * m = m(Q) octave_idx_type n = L.cols (); octave_idx_type b_nc = m.cols (); octave_idx_type err = 0; double rcond; MatrixType ltyp (MatrixType::Lower); - M tmp = L.solve (ltyp, m, err, rcond, 0); + M retval (n, b_nc); + const double* qv = Q.fortran_vec (); + for (octave_idx_type j = 0; j < b_nc; j++) + { + for (octave_idx_type i = 0; i < n; i++) + retval.elem (i,j) = m.elem (static_cast<octave_idx_type>(qv[i]), j); + } + return L.solve (ltyp, retval, err, rcond, 0); +} + +template <typename SM, typename M> +static M +utsolve (const SM& U, const ColumnVector& Q, const M& m) +{ + // Solve (U * Q_mat') * x = m by U * tmp = m, x(Q) = tmp (Q_mat * tmp = x) + octave_idx_type n = U.cols (); + octave_idx_type b_nc = m.cols (); + octave_idx_type err = 0; + double rcond; + MatrixType utyp (MatrixType::Upper); + M tmp = U.solve (utyp, m, err, rcond, 0); M retval; const double* qv = Q.fortran_vec (); @@ -101,26 +122,6 @@ return retval; } -template <typename SM, typename M> -static M -utsolve (const SM& U, const ColumnVector& Q, const M& m) -{ - octave_idx_type n = U.cols (); - octave_idx_type b_nc = m.cols (); - octave_idx_type err = 0; - double rcond; - MatrixType utyp (MatrixType::Upper); - - M retval (n, b_nc); - const double* qv = Q.fortran_vec (); - for (octave_idx_type j = 0; j < b_nc; j++) - { - for (octave_idx_type i = 0; i < n; i++) - retval.elem (i,j) = m.elem (static_cast<octave_idx_type>(qv[i]), j); - } - return U.solve (utyp, retval, err, rcond, 0); -} - static bool vector_product (const SparseMatrix& m, const double* x, double* y) { @@ -199,7 +200,7 @@ return false; else { - bt = fact.chol_matrix (); + bt = fact.chol_matrix (); // upper triangular b = bt.transpose (); permB = ColumnVector (n); for (octave_idx_type i = 0; i < n; i++) @@ -218,7 +219,7 @@ return false; else { - b = fact.L (); + b = fact.L (); // lower triangular bt = b.transpose (); permB = fact.perm () - 1.0; return true; @@ -236,7 +237,7 @@ return false; else { - bt = fact.chol_matrix (); + bt = fact.chol_matrix (); // upper triangular b = bt.hermitian (); permB = ColumnVector (n); for (octave_idx_type i = 0; i < n; i++) @@ -256,7 +257,7 @@ return false; else { - b = fact.L (); + b = fact.L (); // lower triangular bt = b.hermitian (); permB = fact.perm () - 1.0; return true; @@ -766,7 +767,7 @@ for (octave_idx_type i = 0; i < n; i++) mtmp(i,0) = workd[i + iptr(0) - 1]; - mtmp = utsolve (bt, permB, m * ltsolve (b, permB, mtmp)); + mtmp = ltsolve (b, permB, m * utsolve (bt, permB, mtmp)); for (octave_idx_type i = 0; i < n; i++) workd[i+iptr(1)-1] = mtmp(i,0); @@ -854,7 +855,7 @@ } if (note3) - eig_vec = ltsolve (b, permB, eig_vec); + eig_vec = utsolve (bt, permB, eig_vec); } } else
--- a/scripts/sparse/eigs.m Fri Mar 10 13:15:23 2017 +0100 +++ b/scripts/sparse/eigs.m Thu Mar 16 09:44:44 2017 +0100 @@ -143,8 +143,8 @@ ## ## @item permB ## The permutation vector of the Cholesky@tie{}factorization of @var{B} if -## @code{cholB} is true. That is @code{chol (@var{B}(permB, permB))}. The -## default is @code{1:@var{n}}. +## @code{cholB} is true. It is obtained by @code{[R, ~, permB] = +## chol (@var{B}, @qcode{"vector"})}. The default is @code{1:@var{n}}. ## ## @end table ## @@ -743,6 +743,42 @@ %! for i=1:k %! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! A = toeplitz (sparse (1:10)); +%! B = toeplitz (sparse ([1, 1], [1, 2], [2, 1], 1, 10)); +%! [v, d] = eigs (A, B, 5, "lm"); +%! for i = 1:5 +%! assert (A * v(:,i), d(i, i) * B * v(:,i), 1e-12) +%! endfor +%! ddiag = diag (d); +%! [ddiag, idx] = sort (ddiag); +%! v = v(:, idx); +%! R = chol (B); +%! [v1, d1] = eigs (R' \ A / R, 5, "lm"); +%! d1diag = diag (d1); +%! [d1diag, idx] = sort (d1diag); +%! v1 = v1(:, idx); +%! assert (abs (v), abs (R \ v1), 1e-12); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! A = toeplitz (sparse (1:10)); +%! B = toeplitz (sparse ([1, 1], [1, 2], [2, 1], 1, 10)); +%! R = chol (B); +%! opts.cholB = R; +%! [v, d] = eigs (A, R, 5, "lm", opts); +%! for i = 1:5 +%! assert (A * v(:,i), d(i, i) * B * v(:,i), 1e-12) +%! endfor +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! A = toeplitz (sparse (1:10)); +%! B = toeplitz (sparse ([1, 1], [1, 2], [2, 1], 1, 10)); +%! [R, ~, permB] = chol (B, "vector"); +%! opts.cholB = R; +%! opts.permB = permB; +%! [v, d] = eigs (A, R, 5, "lm", opts); +%! for i = 1:5 +%! assert (A * v(:,i), d(i, i) * B * v(:,i), 1e-12) +%! endfor + #### FULL MATRIX VERSIONS ####