Mercurial > octave
changeset 22329:7f3c7a8bd131
maint: Indent namespaces in liboctave/numeric files.
| author | John W. Eaton <jwe@octave.org> |
|---|---|
| date | Wed, 17 Aug 2016 10:55:38 -0400 |
| parents | 3563b423afd3 |
| children | 53e246fd8124 |
| files | liboctave/numeric/aepbalance.cc liboctave/numeric/aepbalance.h liboctave/numeric/chol.cc liboctave/numeric/chol.h liboctave/numeric/gepbalance.cc liboctave/numeric/gepbalance.h liboctave/numeric/hess.cc liboctave/numeric/hess.h liboctave/numeric/lu.cc liboctave/numeric/lu.h liboctave/numeric/qr.cc liboctave/numeric/qr.h liboctave/numeric/qrp.cc liboctave/numeric/qrp.h liboctave/numeric/schur.cc liboctave/numeric/schur.h liboctave/numeric/sparse-chol.cc liboctave/numeric/sparse-chol.h liboctave/numeric/sparse-lu.cc liboctave/numeric/sparse-lu.h liboctave/numeric/sparse-qr.cc liboctave/numeric/sparse-qr.h liboctave/numeric/svd.cc liboctave/numeric/svd.h |
| diffstat | 24 files changed, 7907 insertions(+), 7956 deletions(-) [+] |
line wrap: on
line diff
--- a/liboctave/numeric/aepbalance.cc Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/aepbalance.cc Wed Aug 17 10:55:38 2016 -0400 @@ -46,189 +46,187 @@ namespace octave { -namespace math -{ + namespace math + { + template <> + aepbalance<Matrix>::aepbalance (const Matrix& a, bool noperm, bool noscal) + : balanced_mat (a), scale (), ilo (), ihi (), job (get_job (noperm, noscal)) + { + octave_idx_type n = a.cols (); -template <> -aepbalance<Matrix>::aepbalance (const Matrix& a, bool noperm, bool noscal) - : balanced_mat (a), scale (), ilo (), ihi (), job (get_job (noperm, noscal)) -{ - octave_idx_type n = a.cols (); + if (a.rows () != n) + (*current_liboctave_error_handler) ("aepbalance: requires square matrix"); - if (a.rows () != n) - (*current_liboctave_error_handler) ("aepbalance: requires square matrix"); + scale = ColumnVector (n); - scale = ColumnVector (n); - - octave_idx_type info; + octave_idx_type info; - F77_XFCN (dgebal, DGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), n, - balanced_mat.fortran_vec (), n, ilo, ihi, - scale.fortran_vec (), info - F77_CHAR_ARG_LEN (1))); -} + F77_XFCN (dgebal, DGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), n, + balanced_mat.fortran_vec (), n, ilo, ihi, + scale.fortran_vec (), info + F77_CHAR_ARG_LEN (1))); + } -template <> -Matrix -aepbalance<Matrix>::balancing_matrix (void) const -{ - octave_idx_type n = balanced_mat.rows (); - Matrix balancing_mat (n, n, 0.0); - for (octave_idx_type i = 0; i < n; i++) - balancing_mat.elem (i ,i) = 1.0; + template <> + Matrix + aepbalance<Matrix>::balancing_matrix (void) const + { + octave_idx_type n = balanced_mat.rows (); + Matrix balancing_mat (n, n, 0.0); + for (octave_idx_type i = 0; i < n; i++) + balancing_mat.elem (i ,i) = 1.0; - octave_idx_type info; + octave_idx_type info; - char side = 'R'; + char side = 'R'; - F77_XFCN (dgebak, DGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 (&side, 1), - n, ilo, ihi, scale.data (), n, - balancing_mat.fortran_vec (), n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_XFCN (dgebak, DGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 (&side, 1), + n, ilo, ihi, scale.data (), n, + balancing_mat.fortran_vec (), n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); - return balancing_mat; -} + return balancing_mat; + } -template <> -aepbalance<FloatMatrix>::aepbalance (const FloatMatrix& a, bool noperm, - bool noscal) - : balanced_mat (a), scale (), ilo (), ihi (), job (get_job (noperm, noscal)) -{ - octave_idx_type n = a.cols (); + template <> + aepbalance<FloatMatrix>::aepbalance (const FloatMatrix& a, bool noperm, + bool noscal) + : balanced_mat (a), scale (), ilo (), ihi (), job (get_job (noperm, noscal)) + { + octave_idx_type n = a.cols (); - if (a.rows () != n) - (*current_liboctave_error_handler) ("aepbalance: requires square matrix"); + if (a.rows () != n) + (*current_liboctave_error_handler) ("aepbalance: requires square matrix"); - scale = FloatColumnVector (n); + scale = FloatColumnVector (n); - octave_idx_type info; + octave_idx_type info; - F77_XFCN (sgebal, SGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), n, - balanced_mat.fortran_vec (), n, ilo, ihi, - scale.fortran_vec (), info - F77_CHAR_ARG_LEN (1))); -} + F77_XFCN (sgebal, SGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), n, + balanced_mat.fortran_vec (), n, ilo, ihi, + scale.fortran_vec (), info + F77_CHAR_ARG_LEN (1))); + } -template <> -FloatMatrix -aepbalance<FloatMatrix>::balancing_matrix (void) const -{ - octave_idx_type n = balanced_mat.rows (); - FloatMatrix balancing_mat (n, n, 0.0); - for (octave_idx_type i = 0; i < n; i++) - balancing_mat.elem (i ,i) = 1.0; + template <> + FloatMatrix + aepbalance<FloatMatrix>::balancing_matrix (void) const + { + octave_idx_type n = balanced_mat.rows (); + FloatMatrix balancing_mat (n, n, 0.0); + for (octave_idx_type i = 0; i < n; i++) + balancing_mat.elem (i ,i) = 1.0; - octave_idx_type info; + octave_idx_type info; - char side = 'R'; + char side = 'R'; - F77_XFCN (sgebak, SGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 (&side, 1), - n, ilo, ihi, scale.data (), n, - balancing_mat.fortran_vec (), n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_XFCN (sgebak, SGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 (&side, 1), + n, ilo, ihi, scale.data (), n, + balancing_mat.fortran_vec (), n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); - return balancing_mat; -} + return balancing_mat; + } -template <> -aepbalance<ComplexMatrix>::aepbalance (const ComplexMatrix& a, bool noperm, - bool noscal) - : balanced_mat (a), scale (), ilo (), ihi (), job (get_job (noperm, noscal)) -{ - octave_idx_type n = a.cols (); + template <> + aepbalance<ComplexMatrix>::aepbalance (const ComplexMatrix& a, bool noperm, + bool noscal) + : balanced_mat (a), scale (), ilo (), ihi (), job (get_job (noperm, noscal)) + { + octave_idx_type n = a.cols (); - if (a.rows () != n) - (*current_liboctave_error_handler) ("aepbalance: requires square matrix"); + if (a.rows () != n) + (*current_liboctave_error_handler) ("aepbalance: requires square matrix"); - scale = ColumnVector (n); + scale = ColumnVector (n); - octave_idx_type info; + octave_idx_type info; - F77_XFCN (zgebal, ZGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), n, - F77_DBLE_CMPLX_ARG (balanced_mat.fortran_vec ()), n, ilo, ihi, - scale.fortran_vec (), info - F77_CHAR_ARG_LEN (1))); -} + F77_XFCN (zgebal, ZGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), n, + F77_DBLE_CMPLX_ARG (balanced_mat.fortran_vec ()), n, ilo, ihi, + scale.fortran_vec (), info + F77_CHAR_ARG_LEN (1))); + } -template <> -ComplexMatrix -aepbalance<ComplexMatrix>::balancing_matrix (void) const -{ - octave_idx_type n = balanced_mat.rows (); - ComplexMatrix balancing_mat (n, n, 0.0); - for (octave_idx_type i = 0; i < n; i++) - balancing_mat.elem (i, i) = 1.0; + template <> + ComplexMatrix + aepbalance<ComplexMatrix>::balancing_matrix (void) const + { + octave_idx_type n = balanced_mat.rows (); + ComplexMatrix balancing_mat (n, n, 0.0); + for (octave_idx_type i = 0; i < n; i++) + balancing_mat.elem (i, i) = 1.0; - octave_idx_type info; + octave_idx_type info; - char side = 'R'; + char side = 'R'; - F77_XFCN (zgebak, ZGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 (&side, 1), - n, ilo, ihi, scale.data (), n, - F77_DBLE_CMPLX_ARG (balancing_mat.fortran_vec ()), n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_XFCN (zgebak, ZGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 (&side, 1), + n, ilo, ihi, scale.data (), n, + F77_DBLE_CMPLX_ARG (balancing_mat.fortran_vec ()), n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); - return balancing_mat; -} + return balancing_mat; + } -template <> -aepbalance<FloatComplexMatrix>::aepbalance (const FloatComplexMatrix& a, - bool noperm, bool noscal) - : balanced_mat (a), scale (), ilo (), ihi (), job (get_job (noperm, noscal)) -{ - octave_idx_type n = a.cols (); + template <> + aepbalance<FloatComplexMatrix>::aepbalance (const FloatComplexMatrix& a, + bool noperm, bool noscal) + : balanced_mat (a), scale (), ilo (), ihi (), job (get_job (noperm, noscal)) + { + octave_idx_type n = a.cols (); - if (a.rows () != n) - (*current_liboctave_error_handler) ("aepbalance: requires square matrix"); + if (a.rows () != n) + (*current_liboctave_error_handler) ("aepbalance: requires square matrix"); - scale = FloatColumnVector (n); + scale = FloatColumnVector (n); - octave_idx_type info; + octave_idx_type info; - F77_XFCN (cgebal, CGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), n, - F77_CMPLX_ARG (balanced_mat.fortran_vec ()), n, ilo, ihi, - scale.fortran_vec (), info - F77_CHAR_ARG_LEN (1))); -} + F77_XFCN (cgebal, CGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), n, + F77_CMPLX_ARG (balanced_mat.fortran_vec ()), n, ilo, ihi, + scale.fortran_vec (), info + F77_CHAR_ARG_LEN (1))); + } -template <> -FloatComplexMatrix -aepbalance<FloatComplexMatrix>::balancing_matrix (void) const -{ - octave_idx_type n = balanced_mat.rows (); - FloatComplexMatrix balancing_mat (n, n, 0.0); - for (octave_idx_type i = 0; i < n; i++) - balancing_mat.elem (i, i) = 1.0; + template <> + FloatComplexMatrix + aepbalance<FloatComplexMatrix>::balancing_matrix (void) const + { + octave_idx_type n = balanced_mat.rows (); + FloatComplexMatrix balancing_mat (n, n, 0.0); + for (octave_idx_type i = 0; i < n; i++) + balancing_mat.elem (i, i) = 1.0; - octave_idx_type info; + octave_idx_type info; - char side = 'R'; + char side = 'R'; - F77_XFCN (cgebak, CGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 (&side, 1), - n, ilo, ihi, scale.data (), n, - F77_CMPLX_ARG (balancing_mat.fortran_vec ()), n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_XFCN (cgebak, CGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 (&side, 1), + n, ilo, ihi, scale.data (), n, + F77_CMPLX_ARG (balancing_mat.fortran_vec ()), n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); - return balancing_mat; -} + return balancing_mat; + } -// Instantiations we need. + // Instantiations we need. -template class aepbalance<Matrix>; + template class aepbalance<Matrix>; -template class aepbalance<FloatMatrix>; + template class aepbalance<FloatMatrix>; -template class aepbalance<ComplexMatrix>; + template class aepbalance<ComplexMatrix>; -template class aepbalance<FloatComplexMatrix>; - + template class aepbalance<FloatComplexMatrix>; + } } -}
--- a/liboctave/numeric/aepbalance.h Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/aepbalance.h Wed Aug 17 10:55:38 2016 -0400 @@ -28,101 +28,99 @@ namespace octave { -namespace math -{ + namespace math + { + template <typename MT> + class aepbalance + { + public: + + typedef typename MT::real_column_vector_type VT; -template <typename MT> -class aepbalance -{ -public: + aepbalance (void) : balanced_mat (), scale (), ilo (), ihi (), job () { } + + aepbalance (const MT& a, bool noperm = false, bool noscal = false); - typedef typename MT::real_column_vector_type VT; - - aepbalance (void) : balanced_mat (), scale (), ilo (), ihi (), job () { } - - aepbalance (const MT& a, bool noperm = false, bool noscal = false); + aepbalance (const aepbalance& a) + : balanced_mat (a.balanced_mat), scale (a.scale), + ilo(a.ilo), ihi(a.ihi), job(a.job) + { + } - aepbalance (const aepbalance& a) - : balanced_mat (a.balanced_mat), scale (a.scale), - ilo(a.ilo), ihi(a.ihi), job(a.job) - { - } + aepbalance& operator = (const aepbalance& a) + { + if (this != &a) + { + balanced_mat = a.balanced_mat; + scale = a.scale; + ilo = a.ilo; + ihi = a.ihi; + job = a.job; + } - aepbalance& operator = (const aepbalance& a) - { - if (this != &a) + return *this; + } + + virtual ~aepbalance (void) { } + + MT balancing_matrix (void) const; + + MT balanced_matrix (void) const { - balanced_mat = a.balanced_mat; - scale = a.scale; - ilo = a.ilo; - ihi = a.ihi; - job = a.job; + return balanced_mat; } - return *this; - } - - virtual ~aepbalance (void) { } + VT permuting_vector (void) const + { + octave_idx_type n = balanced_mat.rows (); - MT balancing_matrix (void) const; + VT pv (n); - MT balanced_matrix (void) const - { - return balanced_mat; - } + for (octave_idx_type i = 0; i < n; i++) + pv(i) = i+1; - VT permuting_vector (void) const - { - octave_idx_type n = balanced_mat.rows (); - - VT pv (n); + for (octave_idx_type i = n-1; i >= ihi; i--) + { + octave_idx_type j = scale(i) - 1; + std::swap (pv(i), pv(j)); + } - for (octave_idx_type i = 0; i < n; i++) - pv(i) = i+1; + for (octave_idx_type i = 0; i < ilo-1; i++) + { + octave_idx_type j = scale(i) - 1; + std::swap (pv(i), pv(j)); + } - for (octave_idx_type i = n-1; i >= ihi; i--) - { - octave_idx_type j = scale(i) - 1; - std::swap (pv(i), pv(j)); + return pv; } - for (octave_idx_type i = 0; i < ilo-1; i++) + VT scaling_vector (void) const { - octave_idx_type j = scale(i) - 1; - std::swap (pv(i), pv(j)); + octave_idx_type n = balanced_mat.rows (); + + VT scv (n); + + for (octave_idx_type i = 0; i < ilo-1; i++) + scv(i) = 1; + + for (octave_idx_type i = ilo-1; i < ihi; i++) + scv(i) = scale(i); + + for (octave_idx_type i = ihi; i < n; i++) + scv(i) = 1; + + return scv; } - return pv; - } - - VT scaling_vector (void) const - { - octave_idx_type n = balanced_mat.rows (); - - VT scv (n); - - for (octave_idx_type i = 0; i < ilo-1; i++) - scv(i) = 1; - - for (octave_idx_type i = ilo-1; i < ihi; i++) - scv(i) = scale(i); + protected: - for (octave_idx_type i = ihi; i < n; i++) - scv(i) = 1; - - return scv; + MT balanced_mat; + VT scale; + octave_idx_type ilo; + octave_idx_type ihi; + char job; + }; } - -protected: - - MT balanced_mat; - VT scale; - octave_idx_type ilo; - octave_idx_type ihi; - char job; -}; - -} } #endif
--- a/liboctave/numeric/chol.cc Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/chol.cc Wed Aug 17 10:55:38 2016 -0400 @@ -240,885 +240,883 @@ namespace octave { -namespace math -{ - -template <typename T> -T -chol2inv (const T& r) -{ - return chol2inv_internal (r); -} + namespace math + { + template <typename T> + T + chol2inv (const T& r) + { + return chol2inv_internal (r); + } -// Compute the inverse of a matrix using the Cholesky factorization. -template <typename T> -T -chol<T>::inverse (void) const -{ - return chol2inv_internal (chol_mat, is_upper); -} + // Compute the inverse of a matrix using the Cholesky factorization. + template <typename T> + T + chol<T>::inverse (void) const + { + return chol2inv_internal (chol_mat, is_upper); + } -template <typename T> -void -chol<T>::set (const T& R) -{ - if (! R.is_square ()) - (*current_liboctave_error_handler) ("chol: requires square matrix"); + template <typename T> + void + chol<T>::set (const T& R) + { + if (! R.is_square ()) + (*current_liboctave_error_handler) ("chol: requires square matrix"); - chol_mat = R; -} + chol_mat = R; + } #if ! defined (HAVE_QRUPDATE) -template <typename T> -void -chol<T>::update (const VT& u) -{ - warn_qrupdate_once (); + template <typename T> + void + chol<T>::update (const VT& u) + { + warn_qrupdate_once (); - octave_idx_type n = chol_mat.rows (); + octave_idx_type n = chol_mat.rows (); - if (u.numel () != n) - (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); + if (u.numel () != n) + (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); - init (chol_mat.hermitian () * chol_mat + T (u) * T (u).hermitian (), - true, false); -} + init (chol_mat.hermitian () * chol_mat + T (u) * T (u).hermitian (), + true, false); + } -template <typename T> -bool -singular (const T& a) -{ - static typename T::element_type zero (0); - for (octave_idx_type i = 0; i < a.rows (); i++) - if (a(i,i) == zero) return true; - return false; -} + template <typename T> + bool + singular (const T& a) + { + static typename T::element_type zero (0); + for (octave_idx_type i = 0; i < a.rows (); i++) + if (a(i,i) == zero) return true; + return false; + } + + template <typename T> + octave_idx_type + chol<T>::downdate (const VT& u) + { + warn_qrupdate_once (); -template <typename T> -octave_idx_type -chol<T>::downdate (const VT& u) -{ - warn_qrupdate_once (); + octave_idx_type info = -1; - octave_idx_type info = -1; + octave_idx_type n = chol_mat.rows (); - octave_idx_type n = chol_mat.rows (); + if (u.numel () != n) + (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); - if (u.numel () != n) - (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); + if (singular (chol_mat)) + info = 2; + else + { + info = init (chol_mat.hermitian () * chol_mat + - T (u) * T (u).hermitian (), true, false); + if (info) info = 1; + } - if (singular (chol_mat)) - info = 2; - else - { - info = init (chol_mat.hermitian () * chol_mat - - T (u) * T (u).hermitian (), true, false); - if (info) info = 1; + return info; } - return info; -} + template <typename T> + octave_idx_type + chol<T>::insert_sym (const VT& u, octave_idx_type j) + { + static typename T::element_type zero (0); -template <typename T> -octave_idx_type -chol<T>::insert_sym (const VT& u, octave_idx_type j) -{ - static typename T::element_type zero (0); + warn_qrupdate_once (); - warn_qrupdate_once (); + octave_idx_type info = -1; - octave_idx_type info = -1; + octave_idx_type n = chol_mat.rows (); - octave_idx_type n = chol_mat.rows (); - - if (u.numel () != n + 1) - (*current_liboctave_error_handler) ("cholinsert: dimension mismatch"); - if (j < 0 || j > n) - (*current_liboctave_error_handler) ("cholinsert: index out of range"); + if (u.numel () != n + 1) + (*current_liboctave_error_handler) ("cholinsert: dimension mismatch"); + if (j < 0 || j > n) + (*current_liboctave_error_handler) ("cholinsert: index out of range"); - if (singular (chol_mat)) - info = 2; - else if (octave::math::imag (u(j)) != zero) - info = 3; - else - { - T a = chol_mat.hermitian () * chol_mat; - T a1 (n+1, n+1); - for (octave_idx_type k = 0; k < n+1; k++) - for (octave_idx_type l = 0; l < n+1; l++) - { - if (l == j) - a1(k, l) = u(k); - else if (k == j) - a1(k, l) = octave::math::conj (u(l)); - else - a1(k, l) = a(k < j ? k : k-1, l < j ? l : l-1); - } - info = init (a1, true, false); - if (info) info = 1; + if (singular (chol_mat)) + info = 2; + else if (octave::math::imag (u(j)) != zero) + info = 3; + else + { + T a = chol_mat.hermitian () * chol_mat; + T a1 (n+1, n+1); + for (octave_idx_type k = 0; k < n+1; k++) + for (octave_idx_type l = 0; l < n+1; l++) + { + if (l == j) + a1(k, l) = u(k); + else if (k == j) + a1(k, l) = octave::math::conj (u(l)); + else + a1(k, l) = a(k < j ? k : k-1, l < j ? l : l-1); + } + info = init (a1, true, false); + if (info) info = 1; + } + + return info; } - return info; -} - -template <typename T> -void -chol<T>::delete_sym (octave_idx_type j) -{ - warn_qrupdate_once (); + template <typename T> + void + chol<T>::delete_sym (octave_idx_type j) + { + warn_qrupdate_once (); - octave_idx_type n = chol_mat.rows (); - - if (j < 0 || j > n-1) - (*current_liboctave_error_handler) ("choldelete: index out of range"); - - T a = chol_mat.hermitian () * chol_mat; - a.delete_elements (1, idx_vector (j)); - a.delete_elements (0, idx_vector (j)); - init (a, true, false); -} + octave_idx_type n = chol_mat.rows (); -template <typename T> -void -chol<T>::shift_sym (octave_idx_type i, octave_idx_type j) -{ - warn_qrupdate_once (); - - octave_idx_type n = chol_mat.rows (); - - if (i < 0 || i > n-1 || j < 0 || j > n-1) - (*current_liboctave_error_handler) ("cholshift: index out of range"); + if (j < 0 || j > n-1) + (*current_liboctave_error_handler) ("choldelete: index out of range"); - T a = chol_mat.hermitian () * chol_mat; - Array<octave_idx_type> p (dim_vector (n, 1)); - for (octave_idx_type k = 0; k < n; k++) p(k) = k; - if (i < j) - { - for (octave_idx_type k = i; k < j; k++) p(k) = k+1; - p(j) = i; - } - else if (j < i) - { - p(j) = i; - for (octave_idx_type k = j+1; k < i+1; k++) p(k) = k-1; + T a = chol_mat.hermitian () * chol_mat; + a.delete_elements (1, idx_vector (j)); + a.delete_elements (0, idx_vector (j)); + init (a, true, false); } - init (a.index (idx_vector (p), idx_vector (p)), true, false); -} + template <typename T> + void + chol<T>::shift_sym (octave_idx_type i, octave_idx_type j) + { + warn_qrupdate_once (); + + octave_idx_type n = chol_mat.rows (); + + if (i < 0 || i > n-1 || j < 0 || j > n-1) + (*current_liboctave_error_handler) ("cholshift: index out of range"); + + T a = chol_mat.hermitian () * chol_mat; + Array<octave_idx_type> p (dim_vector (n, 1)); + for (octave_idx_type k = 0; k < n; k++) p(k) = k; + if (i < j) + { + for (octave_idx_type k = i; k < j; k++) p(k) = k+1; + p(j) = i; + } + else if (j < i) + { + p(j) = i; + for (octave_idx_type k = j+1; k < i+1; k++) p(k) = k-1; + } + + init (a.index (idx_vector (p), idx_vector (p)), true, false); + } #endif -// Specializations. + // Specializations. -template <> -octave_idx_type -chol<Matrix>::init (const Matrix& a, bool upper, bool calc_cond) -{ - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); + template <> + octave_idx_type + chol<Matrix>::init (const Matrix& a, bool upper, bool calc_cond) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); - if (a_nr != a_nc) - (*current_liboctave_error_handler) ("chol: requires square matrix"); + if (a_nr != a_nc) + (*current_liboctave_error_handler) ("chol: requires square matrix"); - octave_idx_type n = a_nc; - octave_idx_type info; + octave_idx_type n = a_nc; + octave_idx_type info; - is_upper = upper; + is_upper = upper; - chol_mat.clear (n, n); - if (is_upper) - for (octave_idx_type j = 0; j < n; j++) - { - for (octave_idx_type i = 0; i <= j; i++) - chol_mat.xelem (i, j) = a(i, j); - for (octave_idx_type i = j+1; i < n; i++) - chol_mat.xelem (i, j) = 0.0; - } - else - for (octave_idx_type j = 0; j < n; j++) - { - for (octave_idx_type i = 0; i < j; i++) - chol_mat.xelem (i, j) = 0.0; - for (octave_idx_type i = j; i < n; i++) - chol_mat.xelem (i, j) = a(i, j); - } - double *h = chol_mat.fortran_vec (); + chol_mat.clear (n, n); + if (is_upper) + for (octave_idx_type j = 0; j < n; j++) + { + for (octave_idx_type i = 0; i <= j; i++) + chol_mat.xelem (i, j) = a(i, j); + for (octave_idx_type i = j+1; i < n; i++) + chol_mat.xelem (i, j) = 0.0; + } + else + for (octave_idx_type j = 0; j < n; j++) + { + for (octave_idx_type i = 0; i < j; i++) + chol_mat.xelem (i, j) = 0.0; + for (octave_idx_type i = j; i < n; i++) + chol_mat.xelem (i, j) = a(i, j); + } + double *h = chol_mat.fortran_vec (); - // Calculate the norm of the matrix, for later use. - double anorm = 0; - if (calc_cond) - anorm = xnorm (a, 1); - - if (is_upper) - F77_XFCN (dpotrf, DPOTRF, (F77_CONST_CHAR_ARG2 ("U", 1), n, h, n, info - F77_CHAR_ARG_LEN (1))); - else - F77_XFCN (dpotrf, DPOTRF, (F77_CONST_CHAR_ARG2 ("L", 1), n, h, n, info - F77_CHAR_ARG_LEN (1))); + // Calculate the norm of the matrix, for later use. + double anorm = 0; + if (calc_cond) + anorm = xnorm (a, 1); - xrcond = 0.0; - if (info > 0) - chol_mat.resize (info - 1, info - 1); - else if (calc_cond) - { - octave_idx_type dpocon_info = 0; - - // Now calculate the condition number for non-singular matrix. - Array<double> z (dim_vector (3*n, 1)); - double *pz = z.fortran_vec (); - Array<octave_idx_type> iz (dim_vector (n, 1)); - octave_idx_type *piz = iz.fortran_vec (); if (is_upper) - F77_XFCN (dpocon, DPOCON, (F77_CONST_CHAR_ARG2 ("U", 1), n, h, - n, anorm, xrcond, pz, piz, dpocon_info + F77_XFCN (dpotrf, DPOTRF, (F77_CONST_CHAR_ARG2 ("U", 1), n, h, n, info F77_CHAR_ARG_LEN (1))); else - F77_XFCN (dpocon, DPOCON, (F77_CONST_CHAR_ARG2 ("L", 1), n, h, - n, anorm, xrcond, pz, piz, dpocon_info + F77_XFCN (dpotrf, DPOTRF, (F77_CONST_CHAR_ARG2 ("L", 1), n, h, n, info F77_CHAR_ARG_LEN (1))); - if (dpocon_info != 0) - info = -1; + xrcond = 0.0; + if (info > 0) + chol_mat.resize (info - 1, info - 1); + else if (calc_cond) + { + octave_idx_type dpocon_info = 0; + + // Now calculate the condition number for non-singular matrix. + Array<double> z (dim_vector (3*n, 1)); + double *pz = z.fortran_vec (); + Array<octave_idx_type> iz (dim_vector (n, 1)); + octave_idx_type *piz = iz.fortran_vec (); + if (is_upper) + F77_XFCN (dpocon, DPOCON, (F77_CONST_CHAR_ARG2 ("U", 1), n, h, + n, anorm, xrcond, pz, piz, dpocon_info + F77_CHAR_ARG_LEN (1))); + else + F77_XFCN (dpocon, DPOCON, (F77_CONST_CHAR_ARG2 ("L", 1), n, h, + n, anorm, xrcond, pz, piz, dpocon_info + F77_CHAR_ARG_LEN (1))); + + if (dpocon_info != 0) + info = -1; + } + + return info; } - return info; -} - #if defined (HAVE_QRUPDATE) -template <> -void -chol<Matrix>::update (const ColumnVector& u) -{ - octave_idx_type n = chol_mat.rows (); + template <> + void + chol<Matrix>::update (const ColumnVector& u) + { + octave_idx_type n = chol_mat.rows (); - if (u.numel () != n) - (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); + if (u.numel () != n) + (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); - ColumnVector utmp = u; + ColumnVector utmp = u; - OCTAVE_LOCAL_BUFFER (double, w, n); + OCTAVE_LOCAL_BUFFER (double, w, n); - F77_XFCN (dch1up, DCH1UP, (n, chol_mat.fortran_vec (), chol_mat.rows (), - utmp.fortran_vec (), w)); -} + F77_XFCN (dch1up, DCH1UP, (n, chol_mat.fortran_vec (), chol_mat.rows (), + utmp.fortran_vec (), w)); + } -template <> -octave_idx_type -chol<Matrix>::downdate (const ColumnVector& u) -{ - octave_idx_type info = -1; + template <> + octave_idx_type + chol<Matrix>::downdate (const ColumnVector& u) + { + octave_idx_type info = -1; - octave_idx_type n = chol_mat.rows (); + octave_idx_type n = chol_mat.rows (); - if (u.numel () != n) - (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); + if (u.numel () != n) + (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); - ColumnVector utmp = u; + ColumnVector utmp = u; - OCTAVE_LOCAL_BUFFER (double, w, n); + OCTAVE_LOCAL_BUFFER (double, w, n); - F77_XFCN (dch1dn, DCH1DN, (n, chol_mat.fortran_vec (), chol_mat.rows (), - utmp.fortran_vec (), w, info)); + F77_XFCN (dch1dn, DCH1DN, (n, chol_mat.fortran_vec (), chol_mat.rows (), + utmp.fortran_vec (), w, info)); - return info; -} + return info; + } -template <> -octave_idx_type -chol<Matrix>::insert_sym (const ColumnVector& u, octave_idx_type j) -{ - octave_idx_type info = -1; + template <> + octave_idx_type + chol<Matrix>::insert_sym (const ColumnVector& u, octave_idx_type j) + { + octave_idx_type info = -1; - octave_idx_type n = chol_mat.rows (); + octave_idx_type n = chol_mat.rows (); - if (u.numel () != n + 1) - (*current_liboctave_error_handler) ("cholinsert: dimension mismatch"); - if (j < 0 || j > n) - (*current_liboctave_error_handler) ("cholinsert: index out of range"); + if (u.numel () != n + 1) + (*current_liboctave_error_handler) ("cholinsert: dimension mismatch"); + if (j < 0 || j > n) + (*current_liboctave_error_handler) ("cholinsert: index out of range"); - ColumnVector utmp = u; + ColumnVector utmp = u; - OCTAVE_LOCAL_BUFFER (double, w, n); + OCTAVE_LOCAL_BUFFER (double, w, n); - chol_mat.resize (n+1, n+1); + chol_mat.resize (n+1, n+1); - F77_XFCN (dchinx, DCHINX, (n, chol_mat.fortran_vec (), chol_mat.rows (), - j + 1, utmp.fortran_vec (), w, info)); + F77_XFCN (dchinx, DCHINX, (n, chol_mat.fortran_vec (), chol_mat.rows (), + j + 1, utmp.fortran_vec (), w, info)); - return info; -} + return info; + } -template <> -void -chol<Matrix>::delete_sym (octave_idx_type j) -{ - octave_idx_type n = chol_mat.rows (); + template <> + void + chol<Matrix>::delete_sym (octave_idx_type j) + { + octave_idx_type n = chol_mat.rows (); - if (j < 0 || j > n-1) - (*current_liboctave_error_handler) ("choldelete: index out of range"); + if (j < 0 || j > n-1) + (*current_liboctave_error_handler) ("choldelete: index out of range"); - OCTAVE_LOCAL_BUFFER (double, w, n); + OCTAVE_LOCAL_BUFFER (double, w, n); - F77_XFCN (dchdex, DCHDEX, (n, chol_mat.fortran_vec (), chol_mat.rows (), - j + 1, w)); + F77_XFCN (dchdex, DCHDEX, (n, chol_mat.fortran_vec (), chol_mat.rows (), + j + 1, w)); - chol_mat.resize (n-1, n-1); -} + chol_mat.resize (n-1, n-1); + } -template <> -void -chol<Matrix>::shift_sym (octave_idx_type i, octave_idx_type j) -{ - octave_idx_type n = chol_mat.rows (); + template <> + void + chol<Matrix>::shift_sym (octave_idx_type i, octave_idx_type j) + { + octave_idx_type n = chol_mat.rows (); - if (i < 0 || i > n-1 || j < 0 || j > n-1) - (*current_liboctave_error_handler) ("cholshift: index out of range"); + if (i < 0 || i > n-1 || j < 0 || j > n-1) + (*current_liboctave_error_handler) ("cholshift: index out of range"); - OCTAVE_LOCAL_BUFFER (double, w, 2*n); + OCTAVE_LOCAL_BUFFER (double, w, 2*n); - F77_XFCN (dchshx, DCHSHX, (n, chol_mat.fortran_vec (), chol_mat.rows (), - i + 1, j + 1, w)); -} + F77_XFCN (dchshx, DCHSHX, (n, chol_mat.fortran_vec (), chol_mat.rows (), + i + 1, j + 1, w)); + } #endif -template <> -octave_idx_type -chol<FloatMatrix>::init (const FloatMatrix& a, bool upper, bool calc_cond) -{ - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); + template <> + octave_idx_type + chol<FloatMatrix>::init (const FloatMatrix& a, bool upper, bool calc_cond) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); - if (a_nr != a_nc) - (*current_liboctave_error_handler) ("chol: requires square matrix"); + if (a_nr != a_nc) + (*current_liboctave_error_handler) ("chol: requires square matrix"); - octave_idx_type n = a_nc; - octave_idx_type info; + octave_idx_type n = a_nc; + octave_idx_type info; - is_upper = upper; + is_upper = upper; - chol_mat.clear (n, n); - if (is_upper) - for (octave_idx_type j = 0; j < n; j++) - { - for (octave_idx_type i = 0; i <= j; i++) - chol_mat.xelem (i, j) = a(i, j); - for (octave_idx_type i = j+1; i < n; i++) - chol_mat.xelem (i, j) = 0.0f; - } - else - for (octave_idx_type j = 0; j < n; j++) - { - for (octave_idx_type i = 0; i < j; i++) - chol_mat.xelem (i, j) = 0.0f; - for (octave_idx_type i = j; i < n; i++) - chol_mat.xelem (i, j) = a(i, j); - } - float *h = chol_mat.fortran_vec (); + chol_mat.clear (n, n); + if (is_upper) + for (octave_idx_type j = 0; j < n; j++) + { + for (octave_idx_type i = 0; i <= j; i++) + chol_mat.xelem (i, j) = a(i, j); + for (octave_idx_type i = j+1; i < n; i++) + chol_mat.xelem (i, j) = 0.0f; + } + else + for (octave_idx_type j = 0; j < n; j++) + { + for (octave_idx_type i = 0; i < j; i++) + chol_mat.xelem (i, j) = 0.0f; + for (octave_idx_type i = j; i < n; i++) + chol_mat.xelem (i, j) = a(i, j); + } + float *h = chol_mat.fortran_vec (); - // Calculate the norm of the matrix, for later use. - float anorm = 0; - if (calc_cond) - anorm = xnorm (a, 1); - - if (is_upper) - F77_XFCN (spotrf, SPOTRF, (F77_CONST_CHAR_ARG2 ("U", 1), n, h, n, info - F77_CHAR_ARG_LEN (1))); - else - F77_XFCN (spotrf, SPOTRF, (F77_CONST_CHAR_ARG2 ("L", 1), n, h, n, info - F77_CHAR_ARG_LEN (1))); + // Calculate the norm of the matrix, for later use. + float anorm = 0; + if (calc_cond) + anorm = xnorm (a, 1); - xrcond = 0.0; - if (info > 0) - chol_mat.resize (info - 1, info - 1); - else if (calc_cond) - { - octave_idx_type spocon_info = 0; - - // Now calculate the condition number for non-singular matrix. - Array<float> z (dim_vector (3*n, 1)); - float *pz = z.fortran_vec (); - Array<octave_idx_type> iz (dim_vector (n, 1)); - octave_idx_type *piz = iz.fortran_vec (); if (is_upper) - F77_XFCN (spocon, SPOCON, (F77_CONST_CHAR_ARG2 ("U", 1), n, h, - n, anorm, xrcond, pz, piz, spocon_info + F77_XFCN (spotrf, SPOTRF, (F77_CONST_CHAR_ARG2 ("U", 1), n, h, n, info F77_CHAR_ARG_LEN (1))); else - F77_XFCN (spocon, SPOCON, (F77_CONST_CHAR_ARG2 ("L", 1), n, h, - n, anorm, xrcond, pz, piz, spocon_info + F77_XFCN (spotrf, SPOTRF, (F77_CONST_CHAR_ARG2 ("L", 1), n, h, n, info F77_CHAR_ARG_LEN (1))); - if (spocon_info != 0) - info = -1; + xrcond = 0.0; + if (info > 0) + chol_mat.resize (info - 1, info - 1); + else if (calc_cond) + { + octave_idx_type spocon_info = 0; + + // Now calculate the condition number for non-singular matrix. + Array<float> z (dim_vector (3*n, 1)); + float *pz = z.fortran_vec (); + Array<octave_idx_type> iz (dim_vector (n, 1)); + octave_idx_type *piz = iz.fortran_vec (); + if (is_upper) + F77_XFCN (spocon, SPOCON, (F77_CONST_CHAR_ARG2 ("U", 1), n, h, + n, anorm, xrcond, pz, piz, spocon_info + F77_CHAR_ARG_LEN (1))); + else + F77_XFCN (spocon, SPOCON, (F77_CONST_CHAR_ARG2 ("L", 1), n, h, + n, anorm, xrcond, pz, piz, spocon_info + F77_CHAR_ARG_LEN (1))); + + if (spocon_info != 0) + info = -1; + } + + return info; } - return info; -} - #if defined (HAVE_QRUPDATE) -template <> -void -chol<FloatMatrix>::update (const FloatColumnVector& u) -{ - octave_idx_type n = chol_mat.rows (); + template <> + void + chol<FloatMatrix>::update (const FloatColumnVector& u) + { + octave_idx_type n = chol_mat.rows (); - if (u.numel () != n) - (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); + if (u.numel () != n) + (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); - FloatColumnVector utmp = u; + FloatColumnVector utmp = u; - OCTAVE_LOCAL_BUFFER (float, w, n); + OCTAVE_LOCAL_BUFFER (float, w, n); - F77_XFCN (sch1up, SCH1UP, (n, chol_mat.fortran_vec (), chol_mat.rows (), - utmp.fortran_vec (), w)); -} + F77_XFCN (sch1up, SCH1UP, (n, chol_mat.fortran_vec (), chol_mat.rows (), + utmp.fortran_vec (), w)); + } -template <> -octave_idx_type -chol<FloatMatrix>::downdate (const FloatColumnVector& u) -{ - octave_idx_type info = -1; + template <> + octave_idx_type + chol<FloatMatrix>::downdate (const FloatColumnVector& u) + { + octave_idx_type info = -1; - octave_idx_type n = chol_mat.rows (); + octave_idx_type n = chol_mat.rows (); - if (u.numel () != n) - (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); + if (u.numel () != n) + (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); - FloatColumnVector utmp = u; + FloatColumnVector utmp = u; - OCTAVE_LOCAL_BUFFER (float, w, n); + OCTAVE_LOCAL_BUFFER (float, w, n); - F77_XFCN (sch1dn, SCH1DN, (n, chol_mat.fortran_vec (), chol_mat.rows (), - utmp.fortran_vec (), w, info)); + F77_XFCN (sch1dn, SCH1DN, (n, chol_mat.fortran_vec (), chol_mat.rows (), + utmp.fortran_vec (), w, info)); - return info; -} + return info; + } -template <> -octave_idx_type -chol<FloatMatrix>::insert_sym (const FloatColumnVector& u, octave_idx_type j) -{ - octave_idx_type info = -1; + template <> + octave_idx_type + chol<FloatMatrix>::insert_sym (const FloatColumnVector& u, octave_idx_type j) + { + octave_idx_type info = -1; - octave_idx_type n = chol_mat.rows (); + octave_idx_type n = chol_mat.rows (); - if (u.numel () != n + 1) - (*current_liboctave_error_handler) ("cholinsert: dimension mismatch"); - if (j < 0 || j > n) - (*current_liboctave_error_handler) ("cholinsert: index out of range"); + if (u.numel () != n + 1) + (*current_liboctave_error_handler) ("cholinsert: dimension mismatch"); + if (j < 0 || j > n) + (*current_liboctave_error_handler) ("cholinsert: index out of range"); - FloatColumnVector utmp = u; + FloatColumnVector utmp = u; - OCTAVE_LOCAL_BUFFER (float, w, n); + OCTAVE_LOCAL_BUFFER (float, w, n); - chol_mat.resize (n+1, n+1); + chol_mat.resize (n+1, n+1); - F77_XFCN (schinx, SCHINX, (n, chol_mat.fortran_vec (), chol_mat.rows (), - j + 1, utmp.fortran_vec (), w, info)); + F77_XFCN (schinx, SCHINX, (n, chol_mat.fortran_vec (), chol_mat.rows (), + j + 1, utmp.fortran_vec (), w, info)); - return info; -} + return info; + } -template <> -void -chol<FloatMatrix>::delete_sym (octave_idx_type j) -{ - octave_idx_type n = chol_mat.rows (); + template <> + void + chol<FloatMatrix>::delete_sym (octave_idx_type j) + { + octave_idx_type n = chol_mat.rows (); - if (j < 0 || j > n-1) - (*current_liboctave_error_handler) ("choldelete: index out of range"); + if (j < 0 || j > n-1) + (*current_liboctave_error_handler) ("choldelete: index out of range"); - OCTAVE_LOCAL_BUFFER (float, w, n); + OCTAVE_LOCAL_BUFFER (float, w, n); - F77_XFCN (schdex, SCHDEX, (n, chol_mat.fortran_vec (), chol_mat.rows (), - j + 1, w)); + F77_XFCN (schdex, SCHDEX, (n, chol_mat.fortran_vec (), chol_mat.rows (), + j + 1, w)); - chol_mat.resize (n-1, n-1); -} + chol_mat.resize (n-1, n-1); + } -template <> -void -chol<FloatMatrix>::shift_sym (octave_idx_type i, octave_idx_type j) -{ - octave_idx_type n = chol_mat.rows (); + template <> + void + chol<FloatMatrix>::shift_sym (octave_idx_type i, octave_idx_type j) + { + octave_idx_type n = chol_mat.rows (); - if (i < 0 || i > n-1 || j < 0 || j > n-1) - (*current_liboctave_error_handler) ("cholshift: index out of range"); + if (i < 0 || i > n-1 || j < 0 || j > n-1) + (*current_liboctave_error_handler) ("cholshift: index out of range"); - OCTAVE_LOCAL_BUFFER (float, w, 2*n); + OCTAVE_LOCAL_BUFFER (float, w, 2*n); - F77_XFCN (schshx, SCHSHX, (n, chol_mat.fortran_vec (), chol_mat.rows (), - i + 1, j + 1, w)); -} + F77_XFCN (schshx, SCHSHX, (n, chol_mat.fortran_vec (), chol_mat.rows (), + i + 1, j + 1, w)); + } #endif -template <> -octave_idx_type -chol<ComplexMatrix>::init (const ComplexMatrix& a, bool upper, bool calc_cond) -{ - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); + template <> + octave_idx_type + chol<ComplexMatrix>::init (const ComplexMatrix& a, bool upper, bool calc_cond) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); - if (a_nr != a_nc) - (*current_liboctave_error_handler) ("chol: requires square matrix"); + if (a_nr != a_nc) + (*current_liboctave_error_handler) ("chol: requires square matrix"); - octave_idx_type n = a_nc; - octave_idx_type info; + octave_idx_type n = a_nc; + octave_idx_type info; - is_upper = upper; + is_upper = upper; - chol_mat.clear (n, n); - if (is_upper) - for (octave_idx_type j = 0; j < n; j++) - { - for (octave_idx_type i = 0; i <= j; i++) - chol_mat.xelem (i, j) = a(i, j); - for (octave_idx_type i = j+1; i < n; i++) - chol_mat.xelem (i, j) = 0.0; - } - else - for (octave_idx_type j = 0; j < n; j++) - { - for (octave_idx_type i = 0; i < j; i++) - chol_mat.xelem (i, j) = 0.0; - for (octave_idx_type i = j; i < n; i++) - chol_mat.xelem (i, j) = a(i, j); - } - Complex *h = chol_mat.fortran_vec (); + chol_mat.clear (n, n); + if (is_upper) + for (octave_idx_type j = 0; j < n; j++) + { + for (octave_idx_type i = 0; i <= j; i++) + chol_mat.xelem (i, j) = a(i, j); + for (octave_idx_type i = j+1; i < n; i++) + chol_mat.xelem (i, j) = 0.0; + } + else + for (octave_idx_type j = 0; j < n; j++) + { + for (octave_idx_type i = 0; i < j; i++) + chol_mat.xelem (i, j) = 0.0; + for (octave_idx_type i = j; i < n; i++) + chol_mat.xelem (i, j) = a(i, j); + } + Complex *h = chol_mat.fortran_vec (); - // Calculate the norm of the matrix, for later use. - double anorm = 0; - if (calc_cond) - anorm = xnorm (a, 1); + // Calculate the norm of the matrix, for later use. + double anorm = 0; + if (calc_cond) + anorm = xnorm (a, 1); - if (is_upper) - F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 ("U", 1), n, F77_DBLE_CMPLX_ARG (h), n, info - F77_CHAR_ARG_LEN (1))); - else - F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 ("L", 1), n, F77_DBLE_CMPLX_ARG (h), n, info - F77_CHAR_ARG_LEN (1))); + if (is_upper) + F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 ("U", 1), n, F77_DBLE_CMPLX_ARG (h), n, info + F77_CHAR_ARG_LEN (1))); + else + F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 ("L", 1), n, F77_DBLE_CMPLX_ARG (h), n, info + F77_CHAR_ARG_LEN (1))); - xrcond = 0.0; - if (info > 0) - chol_mat.resize (info - 1, info - 1); - else if (calc_cond) - { - octave_idx_type zpocon_info = 0; + xrcond = 0.0; + if (info > 0) + chol_mat.resize (info - 1, info - 1); + else if (calc_cond) + { + octave_idx_type zpocon_info = 0; - // Now calculate the condition number for non-singular matrix. - Array<Complex> z (dim_vector (2*n, 1)); - Complex *pz = z.fortran_vec (); - Array<double> rz (dim_vector (n, 1)); - double *prz = rz.fortran_vec (); - F77_XFCN (zpocon, ZPOCON, (F77_CONST_CHAR_ARG2 ("U", 1), n, F77_DBLE_CMPLX_ARG (h), - n, anorm, xrcond, F77_DBLE_CMPLX_ARG (pz), prz, zpocon_info - F77_CHAR_ARG_LEN (1))); + // Now calculate the condition number for non-singular matrix. + Array<Complex> z (dim_vector (2*n, 1)); + Complex *pz = z.fortran_vec (); + Array<double> rz (dim_vector (n, 1)); + double *prz = rz.fortran_vec (); + F77_XFCN (zpocon, ZPOCON, (F77_CONST_CHAR_ARG2 ("U", 1), n, F77_DBLE_CMPLX_ARG (h), + n, anorm, xrcond, F77_DBLE_CMPLX_ARG (pz), prz, zpocon_info + F77_CHAR_ARG_LEN (1))); - if (zpocon_info != 0) - info = -1; + if (zpocon_info != 0) + info = -1; + } + + return info; } - return info; -} - #if defined (HAVE_QRUPDATE) -template <> -void -chol<ComplexMatrix>::update (const ComplexColumnVector& u) -{ - octave_idx_type n = chol_mat.rows (); + template <> + void + chol<ComplexMatrix>::update (const ComplexColumnVector& u) + { + octave_idx_type n = chol_mat.rows (); - if (u.numel () != n) - (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); + if (u.numel () != n) + (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); - ComplexColumnVector utmp = u; + ComplexColumnVector utmp = u; - OCTAVE_LOCAL_BUFFER (double, rw, n); + OCTAVE_LOCAL_BUFFER (double, rw, n); - F77_XFCN (zch1up, ZCH1UP, (n, F77_DBLE_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), - F77_DBLE_CMPLX_ARG (utmp.fortran_vec ()), rw)); -} + F77_XFCN (zch1up, ZCH1UP, (n, F77_DBLE_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), + F77_DBLE_CMPLX_ARG (utmp.fortran_vec ()), rw)); + } -template <> -octave_idx_type -chol<ComplexMatrix>::downdate (const ComplexColumnVector& u) -{ - octave_idx_type info = -1; + template <> + octave_idx_type + chol<ComplexMatrix>::downdate (const ComplexColumnVector& u) + { + octave_idx_type info = -1; - octave_idx_type n = chol_mat.rows (); + octave_idx_type n = chol_mat.rows (); - if (u.numel () != n) - (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); + if (u.numel () != n) + (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); - ComplexColumnVector utmp = u; + ComplexColumnVector utmp = u; - OCTAVE_LOCAL_BUFFER (double, rw, n); + OCTAVE_LOCAL_BUFFER (double, rw, n); - F77_XFCN (zch1dn, ZCH1DN, (n, F77_DBLE_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), - F77_DBLE_CMPLX_ARG (utmp.fortran_vec ()), rw, info)); + F77_XFCN (zch1dn, ZCH1DN, (n, F77_DBLE_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), + F77_DBLE_CMPLX_ARG (utmp.fortran_vec ()), rw, info)); - return info; -} + return info; + } -template <> -octave_idx_type -chol<ComplexMatrix>::insert_sym (const ComplexColumnVector& u, - octave_idx_type j) -{ - octave_idx_type info = -1; + template <> + octave_idx_type + chol<ComplexMatrix>::insert_sym (const ComplexColumnVector& u, + octave_idx_type j) + { + octave_idx_type info = -1; - octave_idx_type n = chol_mat.rows (); + octave_idx_type n = chol_mat.rows (); - if (u.numel () != n + 1) - (*current_liboctave_error_handler) ("cholinsert: dimension mismatch"); - if (j < 0 || j > n) - (*current_liboctave_error_handler) ("cholinsert: index out of range"); + if (u.numel () != n + 1) + (*current_liboctave_error_handler) ("cholinsert: dimension mismatch"); + if (j < 0 || j > n) + (*current_liboctave_error_handler) ("cholinsert: index out of range"); - ComplexColumnVector utmp = u; + ComplexColumnVector utmp = u; - OCTAVE_LOCAL_BUFFER (double, rw, n); + OCTAVE_LOCAL_BUFFER (double, rw, n); - chol_mat.resize (n+1, n+1); + chol_mat.resize (n+1, n+1); - F77_XFCN (zchinx, ZCHINX, (n, F77_DBLE_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), - j + 1, F77_DBLE_CMPLX_ARG (utmp.fortran_vec ()), rw, info)); + F77_XFCN (zchinx, ZCHINX, (n, F77_DBLE_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), + j + 1, F77_DBLE_CMPLX_ARG (utmp.fortran_vec ()), rw, info)); - return info; -} + return info; + } -template <> -void -chol<ComplexMatrix>::delete_sym (octave_idx_type j) -{ - octave_idx_type n = chol_mat.rows (); + template <> + void + chol<ComplexMatrix>::delete_sym (octave_idx_type j) + { + octave_idx_type n = chol_mat.rows (); - if (j < 0 || j > n-1) - (*current_liboctave_error_handler) ("choldelete: index out of range"); + if (j < 0 || j > n-1) + (*current_liboctave_error_handler) ("choldelete: index out of range"); - OCTAVE_LOCAL_BUFFER (double, rw, n); + OCTAVE_LOCAL_BUFFER (double, rw, n); - F77_XFCN (zchdex, ZCHDEX, (n, F77_DBLE_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), - j + 1, rw)); + F77_XFCN (zchdex, ZCHDEX, (n, F77_DBLE_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), + j + 1, rw)); - chol_mat.resize (n-1, n-1); -} + chol_mat.resize (n-1, n-1); + } -template <> -void -chol<ComplexMatrix>::shift_sym (octave_idx_type i, octave_idx_type j) -{ - octave_idx_type n = chol_mat.rows (); + template <> + void + chol<ComplexMatrix>::shift_sym (octave_idx_type i, octave_idx_type j) + { + octave_idx_type n = chol_mat.rows (); - if (i < 0 || i > n-1 || j < 0 || j > n-1) - (*current_liboctave_error_handler) ("cholshift: index out of range"); + if (i < 0 || i > n-1 || j < 0 || j > n-1) + (*current_liboctave_error_handler) ("cholshift: index out of range"); - OCTAVE_LOCAL_BUFFER (Complex, w, n); - OCTAVE_LOCAL_BUFFER (double, rw, n); + OCTAVE_LOCAL_BUFFER (Complex, w, n); + OCTAVE_LOCAL_BUFFER (double, rw, n); - F77_XFCN (zchshx, ZCHSHX, (n, F77_DBLE_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), - i + 1, j + 1, F77_DBLE_CMPLX_ARG (w), rw)); -} + F77_XFCN (zchshx, ZCHSHX, (n, F77_DBLE_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), + i + 1, j + 1, F77_DBLE_CMPLX_ARG (w), rw)); + } #endif -template <> -octave_idx_type -chol<FloatComplexMatrix>::init (const FloatComplexMatrix& a, bool upper, - bool calc_cond) -{ - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); + template <> + octave_idx_type + chol<FloatComplexMatrix>::init (const FloatComplexMatrix& a, bool upper, + bool calc_cond) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); - if (a_nr != a_nc) - (*current_liboctave_error_handler) ("chol: requires square matrix"); + if (a_nr != a_nc) + (*current_liboctave_error_handler) ("chol: requires square matrix"); - octave_idx_type n = a_nc; - octave_idx_type info; + octave_idx_type n = a_nc; + octave_idx_type info; - is_upper = upper; + is_upper = upper; - chol_mat.clear (n, n); - if (is_upper) - for (octave_idx_type j = 0; j < n; j++) - { - for (octave_idx_type i = 0; i <= j; i++) - chol_mat.xelem (i, j) = a(i, j); - for (octave_idx_type i = j+1; i < n; i++) - chol_mat.xelem (i, j) = 0.0f; - } - else - for (octave_idx_type j = 0; j < n; j++) - { - for (octave_idx_type i = 0; i < j; i++) - chol_mat.xelem (i, j) = 0.0f; - for (octave_idx_type i = j; i < n; i++) - chol_mat.xelem (i, j) = a(i, j); - } - FloatComplex *h = chol_mat.fortran_vec (); + chol_mat.clear (n, n); + if (is_upper) + for (octave_idx_type j = 0; j < n; j++) + { + for (octave_idx_type i = 0; i <= j; i++) + chol_mat.xelem (i, j) = a(i, j); + for (octave_idx_type i = j+1; i < n; i++) + chol_mat.xelem (i, j) = 0.0f; + } + else + for (octave_idx_type j = 0; j < n; j++) + { + for (octave_idx_type i = 0; i < j; i++) + chol_mat.xelem (i, j) = 0.0f; + for (octave_idx_type i = j; i < n; i++) + chol_mat.xelem (i, j) = a(i, j); + } + FloatComplex *h = chol_mat.fortran_vec (); - // Calculate the norm of the matrix, for later use. - float anorm = 0; - if (calc_cond) - anorm = xnorm (a, 1); + // Calculate the norm of the matrix, for later use. + float anorm = 0; + if (calc_cond) + anorm = xnorm (a, 1); - if (is_upper) - F77_XFCN (cpotrf, CPOTRF, (F77_CONST_CHAR_ARG2 ("U", 1), n, F77_CMPLX_ARG (h), n, info - F77_CHAR_ARG_LEN (1))); - else - F77_XFCN (cpotrf, CPOTRF, (F77_CONST_CHAR_ARG2 ("L", 1), n, F77_CMPLX_ARG (h), n, info - F77_CHAR_ARG_LEN (1))); + if (is_upper) + F77_XFCN (cpotrf, CPOTRF, (F77_CONST_CHAR_ARG2 ("U", 1), n, F77_CMPLX_ARG (h), n, info + F77_CHAR_ARG_LEN (1))); + else + F77_XFCN (cpotrf, CPOTRF, (F77_CONST_CHAR_ARG2 ("L", 1), n, F77_CMPLX_ARG (h), n, info + F77_CHAR_ARG_LEN (1))); - xrcond = 0.0; - if (info > 0) - chol_mat.resize (info - 1, info - 1); - else if (calc_cond) - { - octave_idx_type cpocon_info = 0; + xrcond = 0.0; + if (info > 0) + chol_mat.resize (info - 1, info - 1); + else if (calc_cond) + { + octave_idx_type cpocon_info = 0; - // Now calculate the condition number for non-singular matrix. - Array<FloatComplex> z (dim_vector (2*n, 1)); - FloatComplex *pz = z.fortran_vec (); - Array<float> rz (dim_vector (n, 1)); - float *prz = rz.fortran_vec (); - F77_XFCN (cpocon, CPOCON, (F77_CONST_CHAR_ARG2 ("U", 1), n, F77_CMPLX_ARG (h), - n, anorm, xrcond, F77_CMPLX_ARG (pz), prz, cpocon_info - F77_CHAR_ARG_LEN (1))); + // Now calculate the condition number for non-singular matrix. + Array<FloatComplex> z (dim_vector (2*n, 1)); + FloatComplex *pz = z.fortran_vec (); + Array<float> rz (dim_vector (n, 1)); + float *prz = rz.fortran_vec (); + F77_XFCN (cpocon, CPOCON, (F77_CONST_CHAR_ARG2 ("U", 1), n, F77_CMPLX_ARG (h), + n, anorm, xrcond, F77_CMPLX_ARG (pz), prz, cpocon_info + F77_CHAR_ARG_LEN (1))); - if (cpocon_info != 0) - info = -1; + if (cpocon_info != 0) + info = -1; + } + + return info; } - return info; -} - #if defined (HAVE_QRUPDATE) -template <> -void -chol<FloatComplexMatrix>::update (const FloatComplexColumnVector& u) -{ - octave_idx_type n = chol_mat.rows (); + template <> + void + chol<FloatComplexMatrix>::update (const FloatComplexColumnVector& u) + { + octave_idx_type n = chol_mat.rows (); - if (u.numel () != n) - (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); + if (u.numel () != n) + (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); - FloatComplexColumnVector utmp = u; + FloatComplexColumnVector utmp = u; - OCTAVE_LOCAL_BUFFER (float, rw, n); + OCTAVE_LOCAL_BUFFER (float, rw, n); - F77_XFCN (cch1up, CCH1UP, (n, F77_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), - F77_CMPLX_ARG (utmp.fortran_vec ()), rw)); -} + F77_XFCN (cch1up, CCH1UP, (n, F77_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), + F77_CMPLX_ARG (utmp.fortran_vec ()), rw)); + } -template <> -octave_idx_type -chol<FloatComplexMatrix>::downdate (const FloatComplexColumnVector& u) -{ - octave_idx_type info = -1; + template <> + octave_idx_type + chol<FloatComplexMatrix>::downdate (const FloatComplexColumnVector& u) + { + octave_idx_type info = -1; - octave_idx_type n = chol_mat.rows (); + octave_idx_type n = chol_mat.rows (); - if (u.numel () != n) - (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); + if (u.numel () != n) + (*current_liboctave_error_handler) ("cholupdate: dimension mismatch"); - FloatComplexColumnVector utmp = u; + FloatComplexColumnVector utmp = u; - OCTAVE_LOCAL_BUFFER (float, rw, n); + OCTAVE_LOCAL_BUFFER (float, rw, n); - F77_XFCN (cch1dn, CCH1DN, (n, F77_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), - F77_CMPLX_ARG (utmp.fortran_vec ()), rw, info)); + F77_XFCN (cch1dn, CCH1DN, (n, F77_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), + F77_CMPLX_ARG (utmp.fortran_vec ()), rw, info)); - return info; -} + return info; + } -template <> -octave_idx_type -chol<FloatComplexMatrix>::insert_sym (const FloatComplexColumnVector& u, - octave_idx_type j) -{ - octave_idx_type info = -1; + template <> + octave_idx_type + chol<FloatComplexMatrix>::insert_sym (const FloatComplexColumnVector& u, + octave_idx_type j) + { + octave_idx_type info = -1; - octave_idx_type n = chol_mat.rows (); + octave_idx_type n = chol_mat.rows (); - if (u.numel () != n + 1) - (*current_liboctave_error_handler) ("cholinsert: dimension mismatch"); - if (j < 0 || j > n) - (*current_liboctave_error_handler) ("cholinsert: index out of range"); + if (u.numel () != n + 1) + (*current_liboctave_error_handler) ("cholinsert: dimension mismatch"); + if (j < 0 || j > n) + (*current_liboctave_error_handler) ("cholinsert: index out of range"); - FloatComplexColumnVector utmp = u; + FloatComplexColumnVector utmp = u; - OCTAVE_LOCAL_BUFFER (float, rw, n); + OCTAVE_LOCAL_BUFFER (float, rw, n); - chol_mat.resize (n+1, n+1); + chol_mat.resize (n+1, n+1); - F77_XFCN (cchinx, CCHINX, (n, F77_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), - j + 1, F77_CMPLX_ARG (utmp.fortran_vec ()), rw, info)); + F77_XFCN (cchinx, CCHINX, (n, F77_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), + j + 1, F77_CMPLX_ARG (utmp.fortran_vec ()), rw, info)); - return info; -} + return info; + } -template <> -void -chol<FloatComplexMatrix>::delete_sym (octave_idx_type j) -{ - octave_idx_type n = chol_mat.rows (); + template <> + void + chol<FloatComplexMatrix>::delete_sym (octave_idx_type j) + { + octave_idx_type n = chol_mat.rows (); - if (j < 0 || j > n-1) - (*current_liboctave_error_handler) ("choldelete: index out of range"); + if (j < 0 || j > n-1) + (*current_liboctave_error_handler) ("choldelete: index out of range"); - OCTAVE_LOCAL_BUFFER (float, rw, n); + OCTAVE_LOCAL_BUFFER (float, rw, n); - F77_XFCN (cchdex, CCHDEX, (n, F77_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), - j + 1, rw)); + F77_XFCN (cchdex, CCHDEX, (n, F77_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), + j + 1, rw)); - chol_mat.resize (n-1, n-1); -} + chol_mat.resize (n-1, n-1); + } -template <> -void -chol<FloatComplexMatrix>::shift_sym (octave_idx_type i, octave_idx_type j) -{ - octave_idx_type n = chol_mat.rows (); + template <> + void + chol<FloatComplexMatrix>::shift_sym (octave_idx_type i, octave_idx_type j) + { + octave_idx_type n = chol_mat.rows (); - if (i < 0 || i > n-1 || j < 0 || j > n-1) - (*current_liboctave_error_handler) ("cholshift: index out of range"); + if (i < 0 || i > n-1 || j < 0 || j > n-1) + (*current_liboctave_error_handler) ("cholshift: index out of range"); - OCTAVE_LOCAL_BUFFER (FloatComplex, w, n); - OCTAVE_LOCAL_BUFFER (float, rw, n); + OCTAVE_LOCAL_BUFFER (FloatComplex, w, n); + OCTAVE_LOCAL_BUFFER (float, rw, n); - F77_XFCN (cchshx, CCHSHX, (n, F77_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), - i + 1, j + 1, F77_CMPLX_ARG (w), rw)); -} + F77_XFCN (cchshx, CCHSHX, (n, F77_CMPLX_ARG (chol_mat.fortran_vec ()), chol_mat.rows (), + i + 1, j + 1, F77_CMPLX_ARG (w), rw)); + } #endif -// Instantiations we need. + // Instantiations we need. -template class chol<Matrix>; + template class chol<Matrix>; -template class chol<FloatMatrix>; + template class chol<FloatMatrix>; -template class chol<ComplexMatrix>; + template class chol<ComplexMatrix>; -template class chol<FloatComplexMatrix>; + template class chol<FloatComplexMatrix>; -template Matrix -chol2inv<Matrix> (const Matrix& r); + template Matrix + chol2inv<Matrix> (const Matrix& r); -template ComplexMatrix -chol2inv<ComplexMatrix> (const ComplexMatrix& r); + template ComplexMatrix + chol2inv<ComplexMatrix> (const ComplexMatrix& r); -template FloatMatrix -chol2inv<FloatMatrix> (const FloatMatrix& r); + template FloatMatrix + chol2inv<FloatMatrix> (const FloatMatrix& r); -template FloatComplexMatrix -chol2inv<FloatComplexMatrix> (const FloatComplexMatrix& r); - + template FloatComplexMatrix + chol2inv<FloatComplexMatrix> (const FloatComplexMatrix& r); + } } -}
--- a/liboctave/numeric/chol.h Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/chol.h Wed Aug 17 10:55:38 2016 -0400 @@ -28,82 +28,80 @@ namespace octave { -namespace math -{ - -template <typename T> -class -chol -{ -public: - - typedef typename T::column_vector_type VT; - typedef typename T::real_elt_type COND_T; - - chol (void) : chol_mat (), xrcond (0) { } - - chol (const T& a, bool upper = true, bool calc_cond = false) - : chol_mat (), xrcond (0) + namespace math { - init (a, upper, calc_cond); - } + template <typename T> + class + chol + { + public: - chol (const T& a, octave_idx_type& info, bool upper = true, - bool calc_cond = false) - : chol_mat (), xrcond (0) - { - info = init (a, upper, calc_cond); - } + typedef typename T::column_vector_type VT; + typedef typename T::real_elt_type COND_T; + + chol (void) : chol_mat (), xrcond (0) { } - chol (const chol& a) - : chol_mat (a.chol_mat), xrcond (a.xrcond) { } + chol (const T& a, bool upper = true, bool calc_cond = false) + : chol_mat (), xrcond (0) + { + init (a, upper, calc_cond); + } - chol& operator = (const chol& a) - { - if (this != &a) + chol (const T& a, octave_idx_type& info, bool upper = true, + bool calc_cond = false) + : chol_mat (), xrcond (0) { - chol_mat = a.chol_mat; - xrcond = a.xrcond; + info = init (a, upper, calc_cond); } - return *this; - } + chol (const chol& a) + : chol_mat (a.chol_mat), xrcond (a.xrcond) { } - T chol_matrix (void) const { return chol_mat; } - - COND_T rcond (void) const { return xrcond; } + chol& operator = (const chol& a) + { + if (this != &a) + { + chol_mat = a.chol_mat; + xrcond = a.xrcond; + } - // Compute the inverse of a matrix using the Cholesky factorization. - T inverse (void) const; + return *this; + } - void set (const T& R); + T chol_matrix (void) const { return chol_mat; } - void update (const VT& u); + COND_T rcond (void) const { return xrcond; } - octave_idx_type downdate (const VT& u); + // Compute the inverse of a matrix using the Cholesky factorization. + T inverse (void) const; - octave_idx_type insert_sym (const VT& u, octave_idx_type j); + void set (const T& R); - void delete_sym (octave_idx_type j); + void update (const VT& u); - void shift_sym (octave_idx_type i, octave_idx_type j); + octave_idx_type downdate (const VT& u); + + octave_idx_type insert_sym (const VT& u, octave_idx_type j); -private: + void delete_sym (octave_idx_type j); - T chol_mat; + void shift_sym (octave_idx_type i, octave_idx_type j); - COND_T xrcond; + private: - bool is_upper; + T chol_mat; - octave_idx_type init (const T& a, bool upper, bool calc_cond); -}; + COND_T xrcond; + + bool is_upper; -template <typename T> -T -chol2inv (const T& r); + octave_idx_type init (const T& a, bool upper, bool calc_cond); + }; -} + template <typename T> + T + chol2inv (const T& r); + } } #endif
--- a/liboctave/numeric/gepbalance.cc Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/gepbalance.cc Wed Aug 17 10:55:38 2016 -0400 @@ -38,282 +38,280 @@ namespace octave { -namespace math -{ + namespace math + { + template <> + octave_idx_type + gepbalance<Matrix>::init (const Matrix& a, const Matrix& b, + const std::string& balance_job) + { + octave_idx_type n = a.cols (); -template <> -octave_idx_type -gepbalance<Matrix>::init (const Matrix& a, const Matrix& b, - const std::string& balance_job) -{ - octave_idx_type n = a.cols (); + if (a.rows () != n) + (*current_liboctave_error_handler) ("GEPBALANCE requires square matrix"); + + if (a.dims () != b.dims ()) + octave::err_nonconformant ("GEPBALANCE", n, n, b.rows(), b.cols()); - if (a.rows () != n) - (*current_liboctave_error_handler) ("GEPBALANCE requires square matrix"); + octave_idx_type info; + octave_idx_type ilo; + octave_idx_type ihi; - if (a.dims () != b.dims ()) - octave::err_nonconformant ("GEPBALANCE", n, n, b.rows(), b.cols()); + OCTAVE_LOCAL_BUFFER (double, plscale, n); + OCTAVE_LOCAL_BUFFER (double, prscale, n); + OCTAVE_LOCAL_BUFFER (double, pwork, 6 * n); - octave_idx_type info; - octave_idx_type ilo; - octave_idx_type ihi; + balanced_mat = a; + double *p_balanced_mat = balanced_mat.fortran_vec (); + balanced_mat2 = b; + double *p_balanced_mat2 = balanced_mat2.fortran_vec (); + + char job = balance_job[0]; - OCTAVE_LOCAL_BUFFER (double, plscale, n); - OCTAVE_LOCAL_BUFFER (double, prscale, n); - OCTAVE_LOCAL_BUFFER (double, pwork, 6 * n); + F77_XFCN (dggbal, DGGBAL, (F77_CONST_CHAR_ARG2 (&job, 1), + n, p_balanced_mat, n, p_balanced_mat2, + n, ilo, ihi, plscale, prscale, pwork, info + F77_CHAR_ARG_LEN (1))); - balanced_mat = a; - double *p_balanced_mat = balanced_mat.fortran_vec (); - balanced_mat2 = b; - double *p_balanced_mat2 = balanced_mat2.fortran_vec (); + balancing_mat = Matrix (n, n, 0.0); + balancing_mat2 = Matrix (n, n, 0.0); + for (octave_idx_type i = 0; i < n; i++) + { + octave_quit (); + balancing_mat.elem (i ,i) = 1.0; + balancing_mat2.elem (i ,i) = 1.0; + } - char job = balance_job[0]; + double *p_balancing_mat = balancing_mat.fortran_vec (); + double *p_balancing_mat2 = balancing_mat2.fortran_vec (); - F77_XFCN (dggbal, DGGBAL, (F77_CONST_CHAR_ARG2 (&job, 1), - n, p_balanced_mat, n, p_balanced_mat2, - n, ilo, ihi, plscale, prscale, pwork, info - F77_CHAR_ARG_LEN (1))); + // first left + F77_XFCN (dggbak, DGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 ("L", 1), + n, ilo, ihi, plscale, prscale, + n, p_balancing_mat, n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); - balancing_mat = Matrix (n, n, 0.0); - balancing_mat2 = Matrix (n, n, 0.0); - for (octave_idx_type i = 0; i < n; i++) - { - octave_quit (); - balancing_mat.elem (i ,i) = 1.0; - balancing_mat2.elem (i ,i) = 1.0; + // then right + F77_XFCN (dggbak, DGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 ("R", 1), + n, ilo, ihi, plscale, prscale, + n, p_balancing_mat2, n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + return info; } - double *p_balancing_mat = balancing_mat.fortran_vec (); - double *p_balancing_mat2 = balancing_mat2.fortran_vec (); + template <> + octave_idx_type + gepbalance<FloatMatrix>::init (const FloatMatrix& a, const FloatMatrix& b, + const std::string& balance_job) + { + octave_idx_type n = a.cols (); - // first left - F77_XFCN (dggbak, DGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 ("L", 1), - n, ilo, ihi, plscale, prscale, - n, p_balancing_mat, n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + if (a.rows () != n) + (*current_liboctave_error_handler) + ("FloatGEPBALANCE requires square matrix"); + + if (a.dims () != b.dims ()) + octave::err_nonconformant ("FloatGEPBALANCE", n, n, b.rows(), b.cols()); - // then right - F77_XFCN (dggbak, DGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 ("R", 1), - n, ilo, ihi, plscale, prscale, - n, p_balancing_mat2, n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + octave_idx_type info; + octave_idx_type ilo; + octave_idx_type ihi; - return info; -} + OCTAVE_LOCAL_BUFFER (float, plscale, n); + OCTAVE_LOCAL_BUFFER (float, prscale, n); + OCTAVE_LOCAL_BUFFER (float, pwork, 6 * n); -template <> -octave_idx_type -gepbalance<FloatMatrix>::init (const FloatMatrix& a, const FloatMatrix& b, - const std::string& balance_job) -{ - octave_idx_type n = a.cols (); + balanced_mat = a; + float *p_balanced_mat = balanced_mat.fortran_vec (); + balanced_mat2 = b; + float *p_balanced_mat2 = balanced_mat2.fortran_vec (); + + char job = balance_job[0]; - if (a.rows () != n) - (*current_liboctave_error_handler) - ("FloatGEPBALANCE requires square matrix"); - - if (a.dims () != b.dims ()) - octave::err_nonconformant ("FloatGEPBALANCE", n, n, b.rows(), b.cols()); + F77_XFCN (sggbal, SGGBAL, (F77_CONST_CHAR_ARG2 (&job, 1), + n, p_balanced_mat, n, p_balanced_mat2, + n, ilo, ihi, plscale, prscale, pwork, info + F77_CHAR_ARG_LEN (1))); - octave_idx_type info; - octave_idx_type ilo; - octave_idx_type ihi; + balancing_mat = FloatMatrix (n, n, 0.0); + balancing_mat2 = FloatMatrix (n, n, 0.0); + for (octave_idx_type i = 0; i < n; i++) + { + octave_quit (); + balancing_mat.elem (i ,i) = 1.0; + balancing_mat2.elem (i ,i) = 1.0; + } - OCTAVE_LOCAL_BUFFER (float, plscale, n); - OCTAVE_LOCAL_BUFFER (float, prscale, n); - OCTAVE_LOCAL_BUFFER (float, pwork, 6 * n); + float *p_balancing_mat = balancing_mat.fortran_vec (); + float *p_balancing_mat2 = balancing_mat2.fortran_vec (); - balanced_mat = a; - float *p_balanced_mat = balanced_mat.fortran_vec (); - balanced_mat2 = b; - float *p_balanced_mat2 = balanced_mat2.fortran_vec (); - - char job = balance_job[0]; + // first left + F77_XFCN (sggbak, SGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 ("L", 1), + n, ilo, ihi, plscale, prscale, + n, p_balancing_mat, n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); - F77_XFCN (sggbal, SGGBAL, (F77_CONST_CHAR_ARG2 (&job, 1), - n, p_balanced_mat, n, p_balanced_mat2, - n, ilo, ihi, plscale, prscale, pwork, info - F77_CHAR_ARG_LEN (1))); + // then right + F77_XFCN (sggbak, SGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 ("R", 1), + n, ilo, ihi, plscale, prscale, + n, p_balancing_mat2, n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); - balancing_mat = FloatMatrix (n, n, 0.0); - balancing_mat2 = FloatMatrix (n, n, 0.0); - for (octave_idx_type i = 0; i < n; i++) - { - octave_quit (); - balancing_mat.elem (i ,i) = 1.0; - balancing_mat2.elem (i ,i) = 1.0; + return info; } - float *p_balancing_mat = balancing_mat.fortran_vec (); - float *p_balancing_mat2 = balancing_mat2.fortran_vec (); + template <> + octave_idx_type + gepbalance<ComplexMatrix>::init (const ComplexMatrix& a, + const ComplexMatrix& b, + const std::string& balance_job) + { + octave_idx_type n = a.cols (); - // first left - F77_XFCN (sggbak, SGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 ("L", 1), - n, ilo, ihi, plscale, prscale, - n, p_balancing_mat, n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + if (a.rows () != n) + (*current_liboctave_error_handler) + ("ComplexGEPBALANCE requires square matrix"); + + if (a.dims () != b.dims ()) + octave::err_nonconformant ("ComplexGEPBALANCE", n, n, b.rows(), b.cols()); - // then right - F77_XFCN (sggbak, SGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 ("R", 1), - n, ilo, ihi, plscale, prscale, - n, p_balancing_mat2, n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + octave_idx_type info; + octave_idx_type ilo; + octave_idx_type ihi; - return info; -} + OCTAVE_LOCAL_BUFFER (double, plscale, n); + OCTAVE_LOCAL_BUFFER (double, prscale, n); + OCTAVE_LOCAL_BUFFER (double, pwork, 6 * n); -template <> -octave_idx_type -gepbalance<ComplexMatrix>::init (const ComplexMatrix& a, - const ComplexMatrix& b, - const std::string& balance_job) -{ - octave_idx_type n = a.cols (); + balanced_mat = a; + Complex *p_balanced_mat = balanced_mat.fortran_vec (); + balanced_mat2 = b; + Complex *p_balanced_mat2 = balanced_mat2.fortran_vec (); + + char job = balance_job[0]; - if (a.rows () != n) - (*current_liboctave_error_handler) - ("ComplexGEPBALANCE requires square matrix"); - - if (a.dims () != b.dims ()) - octave::err_nonconformant ("ComplexGEPBALANCE", n, n, b.rows(), b.cols()); + F77_XFCN (zggbal, ZGGBAL, (F77_CONST_CHAR_ARG2 (&job, 1), + n, F77_DBLE_CMPLX_ARG (p_balanced_mat), n, F77_DBLE_CMPLX_ARG (p_balanced_mat2), + n, ilo, ihi, plscale, prscale, pwork, info + F77_CHAR_ARG_LEN (1))); - octave_idx_type info; - octave_idx_type ilo; - octave_idx_type ihi; + balancing_mat = Matrix (n, n, 0.0); + balancing_mat2 = Matrix (n, n, 0.0); + for (octave_idx_type i = 0; i < n; i++) + { + octave_quit (); + balancing_mat.elem (i ,i) = 1.0; + balancing_mat2.elem (i ,i) = 1.0; + } - OCTAVE_LOCAL_BUFFER (double, plscale, n); - OCTAVE_LOCAL_BUFFER (double, prscale, n); - OCTAVE_LOCAL_BUFFER (double, pwork, 6 * n); + double *p_balancing_mat = balancing_mat.fortran_vec (); + double *p_balancing_mat2 = balancing_mat2.fortran_vec (); - balanced_mat = a; - Complex *p_balanced_mat = balanced_mat.fortran_vec (); - balanced_mat2 = b; - Complex *p_balanced_mat2 = balanced_mat2.fortran_vec (); - - char job = balance_job[0]; + // first left + F77_XFCN (dggbak, DGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 ("L", 1), + n, ilo, ihi, plscale, prscale, + n, p_balancing_mat, n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); - F77_XFCN (zggbal, ZGGBAL, (F77_CONST_CHAR_ARG2 (&job, 1), - n, F77_DBLE_CMPLX_ARG (p_balanced_mat), n, F77_DBLE_CMPLX_ARG (p_balanced_mat2), - n, ilo, ihi, plscale, prscale, pwork, info - F77_CHAR_ARG_LEN (1))); + // then right + F77_XFCN (dggbak, DGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 ("R", 1), + n, ilo, ihi, plscale, prscale, + n, p_balancing_mat2, n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); - balancing_mat = Matrix (n, n, 0.0); - balancing_mat2 = Matrix (n, n, 0.0); - for (octave_idx_type i = 0; i < n; i++) - { - octave_quit (); - balancing_mat.elem (i ,i) = 1.0; - balancing_mat2.elem (i ,i) = 1.0; + return info; } - double *p_balancing_mat = balancing_mat.fortran_vec (); - double *p_balancing_mat2 = balancing_mat2.fortran_vec (); + template <> + octave_idx_type + gepbalance<FloatComplexMatrix>::init (const FloatComplexMatrix& a, + const FloatComplexMatrix& b, + const std::string& balance_job) + { + octave_idx_type n = a.cols (); + + if (a.rows () != n) + { + (*current_liboctave_error_handler) + ("FloatComplexGEPBALANCE requires square matrix"); + return -1; + } - // first left - F77_XFCN (dggbak, DGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 ("L", 1), - n, ilo, ihi, plscale, prscale, - n, p_balancing_mat, n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + if (a.dims () != b.dims ()) + octave::err_nonconformant ("FloatComplexGEPBALANCE", n, n, b.rows(), b.cols()); + + octave_idx_type info; + octave_idx_type ilo; + octave_idx_type ihi; + + OCTAVE_LOCAL_BUFFER (float, plscale, n); + OCTAVE_LOCAL_BUFFER (float, prscale, n); + OCTAVE_LOCAL_BUFFER (float, pwork, 6 * n); + + balanced_mat = a; + FloatComplex *p_balanced_mat = balanced_mat.fortran_vec (); + balanced_mat2 = b; + FloatComplex *p_balanced_mat2 = balanced_mat2.fortran_vec (); + + char job = balance_job[0]; - // then right - F77_XFCN (dggbak, DGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 ("R", 1), - n, ilo, ihi, plscale, prscale, - n, p_balancing_mat2, n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + F77_XFCN (cggbal, CGGBAL, (F77_CONST_CHAR_ARG2 (&job, 1), + n, F77_CMPLX_ARG (p_balanced_mat), n, F77_CMPLX_ARG (p_balanced_mat2), + n, ilo, ihi, plscale, prscale, pwork, info + F77_CHAR_ARG_LEN (1))); - return info; -} + balancing_mat = FloatMatrix (n, n, 0.0); + balancing_mat2 = FloatMatrix (n, n, 0.0); + for (octave_idx_type i = 0; i < n; i++) + { + octave_quit (); + balancing_mat.elem (i ,i) = 1.0; + balancing_mat2.elem (i ,i) = 1.0; + } + + float *p_balancing_mat = balancing_mat.fortran_vec (); + float *p_balancing_mat2 = balancing_mat2.fortran_vec (); -template <> -octave_idx_type -gepbalance<FloatComplexMatrix>::init (const FloatComplexMatrix& a, - const FloatComplexMatrix& b, - const std::string& balance_job) -{ - octave_idx_type n = a.cols (); + // first left + F77_XFCN (sggbak, SGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 ("L", 1), + n, ilo, ihi, plscale, prscale, + n, p_balancing_mat, n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); - if (a.rows () != n) - { - (*current_liboctave_error_handler) - ("FloatComplexGEPBALANCE requires square matrix"); - return -1; + // then right + F77_XFCN (sggbak, SGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 ("R", 1), + n, ilo, ihi, plscale, prscale, + n, p_balancing_mat2, n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + return info; } - if (a.dims () != b.dims ()) - octave::err_nonconformant ("FloatComplexGEPBALANCE", n, n, b.rows(), b.cols()); - - octave_idx_type info; - octave_idx_type ilo; - octave_idx_type ihi; - - OCTAVE_LOCAL_BUFFER (float, plscale, n); - OCTAVE_LOCAL_BUFFER (float, prscale, n); - OCTAVE_LOCAL_BUFFER (float, pwork, 6 * n); - - balanced_mat = a; - FloatComplex *p_balanced_mat = balanced_mat.fortran_vec (); - balanced_mat2 = b; - FloatComplex *p_balanced_mat2 = balanced_mat2.fortran_vec (); + // Instantiations we need. - char job = balance_job[0]; - - F77_XFCN (cggbal, CGGBAL, (F77_CONST_CHAR_ARG2 (&job, 1), - n, F77_CMPLX_ARG (p_balanced_mat), n, F77_CMPLX_ARG (p_balanced_mat2), - n, ilo, ihi, plscale, prscale, pwork, info - F77_CHAR_ARG_LEN (1))); + template class gepbalance<Matrix>; - balancing_mat = FloatMatrix (n, n, 0.0); - balancing_mat2 = FloatMatrix (n, n, 0.0); - for (octave_idx_type i = 0; i < n; i++) - { - octave_quit (); - balancing_mat.elem (i ,i) = 1.0; - balancing_mat2.elem (i ,i) = 1.0; - } + template class gepbalance<FloatMatrix>; - float *p_balancing_mat = balancing_mat.fortran_vec (); - float *p_balancing_mat2 = balancing_mat2.fortran_vec (); - - // first left - F77_XFCN (sggbak, SGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 ("L", 1), - n, ilo, ihi, plscale, prscale, - n, p_balancing_mat, n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + template class gepbalance<ComplexMatrix>; - // then right - F77_XFCN (sggbak, SGGBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 ("R", 1), - n, ilo, ihi, plscale, prscale, - n, p_balancing_mat2, n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - return info; + template class gepbalance<FloatComplexMatrix>; + } } - -// Instantiations we need. - -template class gepbalance<Matrix>; - -template class gepbalance<FloatMatrix>; - -template class gepbalance<ComplexMatrix>; - -template class gepbalance<FloatComplexMatrix>; - -} -}
--- a/liboctave/numeric/gepbalance.h Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/gepbalance.h Wed Aug 17 10:55:38 2016 -0400 @@ -29,66 +29,64 @@ namespace octave { -namespace math -{ - -template <typename T> -class -gepbalance -{ -public: - - typedef typename T::real_matrix_type RT; - - gepbalance (void) - : balanced_mat (), balanced_mat2 (), balancing_mat (), balancing_mat2 () - { } + namespace math + { + template <typename T> + class + gepbalance + { + public: - gepbalance (const T& a, const T& b, const std::string& job) - : balanced_mat (), balanced_mat2 (), balancing_mat (), balancing_mat2 () - { - init (a, b, job); - } + typedef typename T::real_matrix_type RT; - gepbalance (const gepbalance& a) - : balanced_mat (a.balanced_mat), balanced_mat2 (a.balanced_mat2), - balancing_mat (a.balancing_mat), balancing_mat2 (a.balancing_mat2) - { } + gepbalance (void) + : balanced_mat (), balanced_mat2 (), balancing_mat (), balancing_mat2 () + { } - gepbalance& operator = (const gepbalance& a) - { - if (this != &a) + gepbalance (const T& a, const T& b, const std::string& job) + : balanced_mat (), balanced_mat2 (), balancing_mat (), balancing_mat2 () { - balanced_mat = a.balanced_mat; - balanced_mat2 = a.balanced_mat2; - balancing_mat = a.balancing_mat; - balancing_mat2 = a.balancing_mat2; + init (a, b, job); } - return *this; - } - - ~gepbalance (void) { } + gepbalance (const gepbalance& a) + : balanced_mat (a.balanced_mat), balanced_mat2 (a.balanced_mat2), + balancing_mat (a.balancing_mat), balancing_mat2 (a.balancing_mat2) + { } - T balanced_matrix (void) const { return balanced_mat; } + gepbalance& operator = (const gepbalance& a) + { + if (this != &a) + { + balanced_mat = a.balanced_mat; + balanced_mat2 = a.balanced_mat2; + balancing_mat = a.balancing_mat; + balancing_mat2 = a.balancing_mat2; + } - T balanced_matrix2 (void) const { return balanced_mat2; } - - RT balancing_matrix (void) const { return balancing_mat; } + return *this; + } - RT balancing_matrix2 (void) const { return balancing_mat2; } + ~gepbalance (void) { } + + T balanced_matrix (void) const { return balanced_mat; } -private: + T balanced_matrix2 (void) const { return balanced_mat2; } + + RT balancing_matrix (void) const { return balancing_mat; } + + RT balancing_matrix2 (void) const { return balancing_mat2; } - T balanced_mat; - T balanced_mat2; - RT balancing_mat; - RT balancing_mat2; + private: - octave_idx_type init (const T& a, const T& b, const std::string& job); -}; + T balanced_mat; + T balanced_mat2; + RT balancing_mat; + RT balancing_mat2; -} + octave_idx_type init (const T& a, const T& b, const std::string& job); + }; + } } #endif
--- a/liboctave/numeric/hess.cc Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/hess.cc Wed Aug 17 10:55:38 2016 -0400 @@ -34,259 +34,257 @@ namespace octave { -namespace math -{ - -template <> -octave_idx_type -hess<Matrix>::init (const Matrix& a) -{ - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); - - if (a_nr != a_nc) - (*current_liboctave_error_handler) ("hess: requires square matrix"); - - char job = 'N'; - char side = 'R'; - - octave_idx_type n = a_nc; - octave_idx_type lwork = 32 * n; - octave_idx_type info; - octave_idx_type ilo; - octave_idx_type ihi; + namespace math + { + template <> + octave_idx_type + hess<Matrix>::init (const Matrix& a) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); - hess_mat = a; - double *h = hess_mat.fortran_vec (); - - Array<double> scale (dim_vector (n, 1)); - double *pscale = scale.fortran_vec (); - - F77_XFCN (dgebal, DGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), - n, h, n, ilo, ihi, pscale, info - F77_CHAR_ARG_LEN (1))); + if (a_nr != a_nc) + (*current_liboctave_error_handler) ("hess: requires square matrix"); - Array<double> tau (dim_vector (n-1, 1)); - double *ptau = tau.fortran_vec (); - - Array<double> work (dim_vector (lwork, 1)); - double *pwork = work.fortran_vec (); - - F77_XFCN (dgehrd, DGEHRD, (n, ilo, ihi, h, n, ptau, pwork, - lwork, info)); - - unitary_hess_mat = hess_mat; - double *z = unitary_hess_mat.fortran_vec (); - - F77_XFCN (dorghr, DORGHR, (n, ilo, ihi, z, n, ptau, pwork, - lwork, info)); + char job = 'N'; + char side = 'R'; - F77_XFCN (dgebak, DGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 (&side, 1), - n, ilo, ihi, pscale, n, z, - n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - // If someone thinks of a more graceful way of doing - // this (or faster for that matter :-)), please let - // me know! - - if (n > 2) - for (octave_idx_type j = 0; j < a_nc; j++) - for (octave_idx_type i = j+2; i < a_nr; i++) - hess_mat.elem (i, j) = 0; - - return info; -} - -template <> -octave_idx_type -hess<FloatMatrix>::init (const FloatMatrix& a) -{ - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); + octave_idx_type n = a_nc; + octave_idx_type lwork = 32 * n; + octave_idx_type info; + octave_idx_type ilo; + octave_idx_type ihi; - if (a_nr != a_nc) - (*current_liboctave_error_handler) ("hess: requires square matrix"); - - char job = 'N'; - char side = 'R'; - - octave_idx_type n = a_nc; - octave_idx_type lwork = 32 * n; - octave_idx_type info; - octave_idx_type ilo; - octave_idx_type ihi; + hess_mat = a; + double *h = hess_mat.fortran_vec (); - hess_mat = a; - float *h = hess_mat.fortran_vec (); - - Array<float> scale (dim_vector (n, 1)); - float *pscale = scale.fortran_vec (); + Array<double> scale (dim_vector (n, 1)); + double *pscale = scale.fortran_vec (); - F77_XFCN (sgebal, SGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), - n, h, n, ilo, ihi, pscale, info - F77_CHAR_ARG_LEN (1))); - - Array<float> tau (dim_vector (n-1, 1)); - float *ptau = tau.fortran_vec (); - - Array<float> work (dim_vector (lwork, 1)); - float *pwork = work.fortran_vec (); + F77_XFCN (dgebal, DGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), + n, h, n, ilo, ihi, pscale, info + F77_CHAR_ARG_LEN (1))); - F77_XFCN (sgehrd, SGEHRD, (n, ilo, ihi, h, n, ptau, pwork, - lwork, info)); - - unitary_hess_mat = hess_mat; - float *z = unitary_hess_mat.fortran_vec (); - - F77_XFCN (sorghr, SORGHR, (n, ilo, ihi, z, n, ptau, pwork, - lwork, info)); + Array<double> tau (dim_vector (n-1, 1)); + double *ptau = tau.fortran_vec (); - F77_XFCN (sgebak, SGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 (&side, 1), - n, ilo, ihi, pscale, n, z, - n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - // If someone thinks of a more graceful way of doing - // this (or faster for that matter :-)), please let - // me know! - - if (n > 2) - for (octave_idx_type j = 0; j < a_nc; j++) - for (octave_idx_type i = j+2; i < a_nr; i++) - hess_mat.elem (i, j) = 0; + Array<double> work (dim_vector (lwork, 1)); + double *pwork = work.fortran_vec (); - return info; -} - -template <> -octave_idx_type -hess<ComplexMatrix>::init (const ComplexMatrix& a) -{ - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); + F77_XFCN (dgehrd, DGEHRD, (n, ilo, ihi, h, n, ptau, pwork, + lwork, info)); - if (a_nr != a_nc) - (*current_liboctave_error_handler) ("hess: requires square matrix"); - - char job = 'N'; - char side = 'R'; + unitary_hess_mat = hess_mat; + double *z = unitary_hess_mat.fortran_vec (); - octave_idx_type n = a_nc; - octave_idx_type lwork = 32 * n; - octave_idx_type info; - octave_idx_type ilo; - octave_idx_type ihi; - - hess_mat = a; - Complex *h = hess_mat.fortran_vec (); + F77_XFCN (dorghr, DORGHR, (n, ilo, ihi, z, n, ptau, pwork, + lwork, info)); - Array<double> scale (dim_vector (n, 1)); - double *pscale = scale.fortran_vec (); - - F77_XFCN (zgebal, ZGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), - n, F77_DBLE_CMPLX_ARG (h), n, ilo, ihi, pscale, info - F77_CHAR_ARG_LEN (1))); - - Array<Complex> tau (dim_vector (n-1, 1)); - Complex *ptau = tau.fortran_vec (); - - Array<Complex> work (dim_vector (lwork, 1)); - Complex *pwork = work.fortran_vec (); - - F77_XFCN (zgehrd, ZGEHRD, (n, ilo, ihi, F77_DBLE_CMPLX_ARG (h), n, F77_DBLE_CMPLX_ARG (ptau), F77_DBLE_CMPLX_ARG (pwork), lwork, info)); - - unitary_hess_mat = hess_mat; - Complex *z = unitary_hess_mat.fortran_vec (); - - F77_XFCN (zunghr, ZUNGHR, (n, ilo, ihi, F77_DBLE_CMPLX_ARG (z), n, F77_DBLE_CMPLX_ARG (ptau), F77_DBLE_CMPLX_ARG (pwork), - lwork, info)); + F77_XFCN (dgebak, DGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 (&side, 1), + n, ilo, ihi, pscale, n, z, + n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); - F77_XFCN (zgebak, ZGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 (&side, 1), - n, ilo, ihi, pscale, n, F77_DBLE_CMPLX_ARG (z), n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - // If someone thinks of a more graceful way of - // doing this (or faster for that matter :-)), - // please let me know! - - if (n > 2) - for (octave_idx_type j = 0; j < a_nc; j++) - for (octave_idx_type i = j+2; i < a_nr; i++) - hess_mat.elem (i, j) = 0; + // If someone thinks of a more graceful way of doing + // this (or faster for that matter :-)), please let + // me know! - return info; -} + if (n > 2) + for (octave_idx_type j = 0; j < a_nc; j++) + for (octave_idx_type i = j+2; i < a_nr; i++) + hess_mat.elem (i, j) = 0; -template <> -octave_idx_type -hess<FloatComplexMatrix>::init (const FloatComplexMatrix& a) -{ - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); - - if (a_nr != a_nc) - { - (*current_liboctave_error_handler) ("hess: requires square matrix"); - return -1; + return info; } - char job = 'N'; - char side = 'R'; + template <> + octave_idx_type + hess<FloatMatrix>::init (const FloatMatrix& a) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); + + if (a_nr != a_nc) + (*current_liboctave_error_handler) ("hess: requires square matrix"); + + char job = 'N'; + char side = 'R'; + + octave_idx_type n = a_nc; + octave_idx_type lwork = 32 * n; + octave_idx_type info; + octave_idx_type ilo; + octave_idx_type ihi; + + hess_mat = a; + float *h = hess_mat.fortran_vec (); - octave_idx_type n = a_nc; - octave_idx_type lwork = 32 * n; - octave_idx_type info; - octave_idx_type ilo; - octave_idx_type ihi; + Array<float> scale (dim_vector (n, 1)); + float *pscale = scale.fortran_vec (); + + F77_XFCN (sgebal, SGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), + n, h, n, ilo, ihi, pscale, info + F77_CHAR_ARG_LEN (1))); + + Array<float> tau (dim_vector (n-1, 1)); + float *ptau = tau.fortran_vec (); - hess_mat = a; - FloatComplex *h = hess_mat.fortran_vec (); + Array<float> work (dim_vector (lwork, 1)); + float *pwork = work.fortran_vec (); + + F77_XFCN (sgehrd, SGEHRD, (n, ilo, ihi, h, n, ptau, pwork, + lwork, info)); + + unitary_hess_mat = hess_mat; + float *z = unitary_hess_mat.fortran_vec (); + + F77_XFCN (sorghr, SORGHR, (n, ilo, ihi, z, n, ptau, pwork, + lwork, info)); - Array<float> scale (dim_vector (n, 1)); - float *pscale = scale.fortran_vec (); + F77_XFCN (sgebak, SGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 (&side, 1), + n, ilo, ihi, pscale, n, z, + n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); - F77_XFCN (cgebal, CGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), - n, F77_CMPLX_ARG (h), n, ilo, ihi, pscale, info - F77_CHAR_ARG_LEN (1))); + // If someone thinks of a more graceful way of doing + // this (or faster for that matter :-)), please let + // me know! + + if (n > 2) + for (octave_idx_type j = 0; j < a_nc; j++) + for (octave_idx_type i = j+2; i < a_nr; i++) + hess_mat.elem (i, j) = 0; + + return info; + } - Array<FloatComplex> tau (dim_vector (n-1, 1)); - FloatComplex *ptau = tau.fortran_vec (); + template <> + octave_idx_type + hess<ComplexMatrix>::init (const ComplexMatrix& a) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); + + if (a_nr != a_nc) + (*current_liboctave_error_handler) ("hess: requires square matrix"); + + char job = 'N'; + char side = 'R'; - Array<FloatComplex> work (dim_vector (lwork, 1)); - FloatComplex *pwork = work.fortran_vec (); + octave_idx_type n = a_nc; + octave_idx_type lwork = 32 * n; + octave_idx_type info; + octave_idx_type ilo; + octave_idx_type ihi; + + hess_mat = a; + Complex *h = hess_mat.fortran_vec (); - F77_XFCN (cgehrd, CGEHRD, (n, ilo, ihi, F77_CMPLX_ARG (h), n, F77_CMPLX_ARG (ptau), F77_CMPLX_ARG (pwork), lwork, info)); + Array<double> scale (dim_vector (n, 1)); + double *pscale = scale.fortran_vec (); + + F77_XFCN (zgebal, ZGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), + n, F77_DBLE_CMPLX_ARG (h), n, ilo, ihi, pscale, info + F77_CHAR_ARG_LEN (1))); + + Array<Complex> tau (dim_vector (n-1, 1)); + Complex *ptau = tau.fortran_vec (); - unitary_hess_mat = hess_mat; - FloatComplex *z = unitary_hess_mat.fortran_vec (); + Array<Complex> work (dim_vector (lwork, 1)); + Complex *pwork = work.fortran_vec (); + + F77_XFCN (zgehrd, ZGEHRD, (n, ilo, ihi, F77_DBLE_CMPLX_ARG (h), n, F77_DBLE_CMPLX_ARG (ptau), F77_DBLE_CMPLX_ARG (pwork), lwork, info)); + + unitary_hess_mat = hess_mat; + Complex *z = unitary_hess_mat.fortran_vec (); - F77_XFCN (cunghr, CUNGHR, (n, ilo, ihi, F77_CMPLX_ARG (z), n, F77_CMPLX_ARG (ptau), F77_CMPLX_ARG (pwork), - lwork, info)); + F77_XFCN (zunghr, ZUNGHR, (n, ilo, ihi, F77_DBLE_CMPLX_ARG (z), n, F77_DBLE_CMPLX_ARG (ptau), F77_DBLE_CMPLX_ARG (pwork), + lwork, info)); + + F77_XFCN (zgebak, ZGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 (&side, 1), + n, ilo, ihi, pscale, n, F77_DBLE_CMPLX_ARG (z), n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); + + // If someone thinks of a more graceful way of + // doing this (or faster for that matter :-)), + // please let me know! - F77_XFCN (cgebak, CGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), - F77_CONST_CHAR_ARG2 (&side, 1), - n, ilo, ihi, pscale, n, F77_CMPLX_ARG (z), n, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + if (n > 2) + for (octave_idx_type j = 0; j < a_nc; j++) + for (octave_idx_type i = j+2; i < a_nr; i++) + hess_mat.elem (i, j) = 0; + + return info; + } + + template <> + octave_idx_type + hess<FloatComplexMatrix>::init (const FloatComplexMatrix& a) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); + + if (a_nr != a_nc) + { + (*current_liboctave_error_handler) ("hess: requires square matrix"); + return -1; + } + + char job = 'N'; + char side = 'R'; - // If someone thinks of a more graceful way of - // doing this (or faster for that matter :-)), - // please let me know! + octave_idx_type n = a_nc; + octave_idx_type lwork = 32 * n; + octave_idx_type info; + octave_idx_type ilo; + octave_idx_type ihi; + + hess_mat = a; + FloatComplex *h = hess_mat.fortran_vec (); + + Array<float> scale (dim_vector (n, 1)); + float *pscale = scale.fortran_vec (); + + F77_XFCN (cgebal, CGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), + n, F77_CMPLX_ARG (h), n, ilo, ihi, pscale, info + F77_CHAR_ARG_LEN (1))); + + Array<FloatComplex> tau (dim_vector (n-1, 1)); + FloatComplex *ptau = tau.fortran_vec (); + + Array<FloatComplex> work (dim_vector (lwork, 1)); + FloatComplex *pwork = work.fortran_vec (); + + F77_XFCN (cgehrd, CGEHRD, (n, ilo, ihi, F77_CMPLX_ARG (h), n, F77_CMPLX_ARG (ptau), F77_CMPLX_ARG (pwork), lwork, info)); - if (n > 2) - for (octave_idx_type j = 0; j < a_nc; j++) - for (octave_idx_type i = j+2; i < a_nr; i++) - hess_mat.elem (i, j) = 0; + unitary_hess_mat = hess_mat; + FloatComplex *z = unitary_hess_mat.fortran_vec (); + + F77_XFCN (cunghr, CUNGHR, (n, ilo, ihi, F77_CMPLX_ARG (z), n, F77_CMPLX_ARG (ptau), F77_CMPLX_ARG (pwork), + lwork, info)); + + F77_XFCN (cgebak, CGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 (&side, 1), + n, ilo, ihi, pscale, n, F77_CMPLX_ARG (z), n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); - return info; -} + // If someone thinks of a more graceful way of + // doing this (or faster for that matter :-)), + // please let me know! + if (n > 2) + for (octave_idx_type j = 0; j < a_nc; j++) + for (octave_idx_type i = j+2; i < a_nr; i++) + hess_mat.elem (i, j) = 0; + + return info; + } + } } -}
--- a/liboctave/numeric/hess.h Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/hess.h Wed Aug 17 10:55:38 2016 -0400 @@ -29,65 +29,63 @@ namespace octave { -namespace math -{ - -template <typename T> -class -hess -{ -public: - - hess (void) - : hess_mat (), unitary_hess_mat () - { } - - hess (const T& a) - : hess_mat (), unitary_hess_mat () + namespace math { - init (a); - } + template <typename T> + class + hess + { + public: - hess (const T& a, octave_idx_type& info) - : hess_mat (), unitary_hess_mat () - { - info = init (a); - } + hess (void) + : hess_mat (), unitary_hess_mat () + { } - hess (const hess& a) - : hess_mat (a.hess_mat), unitary_hess_mat (a.unitary_hess_mat) - { } + hess (const T& a) + : hess_mat (), unitary_hess_mat () + { + init (a); + } - hess& operator = (const hess& a) - { - if (this != &a) + hess (const T& a, octave_idx_type& info) + : hess_mat (), unitary_hess_mat () { - hess_mat = a.hess_mat; - unitary_hess_mat = a.unitary_hess_mat; + info = init (a); } - return *this; - } - - ~hess (void) { } + hess (const hess& a) + : hess_mat (a.hess_mat), unitary_hess_mat (a.unitary_hess_mat) + { } - T hess_matrix (void) const { return hess_mat; } + hess& operator = (const hess& a) + { + if (this != &a) + { + hess_mat = a.hess_mat; + unitary_hess_mat = a.unitary_hess_mat; + } - T unitary_hess_matrix (void) const { return unitary_hess_mat; } + return *this; + } -private: + ~hess (void) { } - T hess_mat; - T unitary_hess_mat; + T hess_matrix (void) const { return hess_mat; } - octave_idx_type init (const T& a); -}; + T unitary_hess_matrix (void) const { return unitary_hess_mat; } + + private: -template <typename T> -extern std::ostream& -operator << (std::ostream& os, const hess<T>& a); + T hess_mat; + T unitary_hess_mat; -} + octave_idx_type init (const T& a); + }; + + template <typename T> + extern std::ostream& + operator << (std::ostream& os, const hess<T>& a); + } } #endif
--- a/liboctave/numeric/lu.cc Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/lu.cc Wed Aug 17 10:55:38 2016 -0400 @@ -41,770 +41,768 @@ namespace octave { -namespace math -{ - -template <typename T> -lu<T>::lu (const T& l, const T& u, - const PermMatrix& p) - : a_fact (u), l_fact (l), ipvt (p.transpose ().col_perm_vec ()) -{ - if (l.columns () != u.rows ()) - (*current_liboctave_error_handler) ("lu: dimension mismatch"); -} - -template <typename T> -bool -lu<T>::packed (void) const -{ - return l_fact.dims () == dim_vector (); -} - -template <typename T> -void -lu<T>::unpack (void) -{ - if (packed ()) - { - l_fact = L (); - a_fact = U (); // FIXME: sub-optimal - ipvt = getp (); - } -} - -template <typename T> -T -lu<T>::L (void) const -{ - if (packed ()) + namespace math + { + template <typename T> + lu<T>::lu (const T& l, const T& u, + const PermMatrix& p) + : a_fact (u), l_fact (l), ipvt (p.transpose ().col_perm_vec ()) { - octave_idx_type a_nr = a_fact.rows (); - octave_idx_type a_nc = a_fact.cols (); - octave_idx_type mn = (a_nr < a_nc ? a_nr : a_nc); - - T l (a_nr, mn, ELT_T (0.0)); - - for (octave_idx_type i = 0; i < a_nr; i++) - { - if (i < a_nc) - l.xelem (i, i) = 1.0; - - for (octave_idx_type j = 0; j < (i < a_nc ? i : a_nc); j++) - l.xelem (i, j) = a_fact.xelem (i, j); - } - - return l; - } - else - return l_fact; -} - -template <typename T> -T -lu<T>::U (void) const -{ - if (packed ()) - { - octave_idx_type a_nr = a_fact.rows (); - octave_idx_type a_nc = a_fact.cols (); - octave_idx_type mn = (a_nr < a_nc ? a_nr : a_nc); - - T u (mn, a_nc, ELT_T (0.0)); - - for (octave_idx_type i = 0; i < mn; i++) - { - for (octave_idx_type j = i; j < a_nc; j++) - u.xelem (i, j) = a_fact.xelem (i, j); - } - - return u; + if (l.columns () != u.rows ()) + (*current_liboctave_error_handler) ("lu: dimension mismatch"); } - else - return a_fact; -} -template <typename T> -T -lu<T>::Y (void) const -{ - if (! packed ()) - (*current_liboctave_error_handler) - ("lu: Y () not implemented for unpacked form"); - - return a_fact; -} - -template <typename T> -Array<octave_idx_type> -lu<T>::getp (void) const -{ - if (packed ()) + template <typename T> + bool + lu<T>::packed (void) const { - octave_idx_type a_nr = a_fact.rows (); - - Array<octave_idx_type> pvt (dim_vector (a_nr, 1)); - - for (octave_idx_type i = 0; i < a_nr; i++) - pvt.xelem (i) = i; - - for (octave_idx_type i = 0; i < ipvt.numel (); i++) - { - octave_idx_type k = ipvt.xelem (i); - - if (k != i) - { - octave_idx_type tmp = pvt.xelem (k); - pvt.xelem (k) = pvt.xelem (i); - pvt.xelem (i) = tmp; - } - } - - return pvt; + return l_fact.dims () == dim_vector (); } - else - return ipvt; -} -template <typename T> -PermMatrix -lu<T>::P (void) const -{ - return PermMatrix (getp (), false); -} - -template <typename T> -ColumnVector -lu<T>::P_vec (void) const -{ - octave_idx_type a_nr = a_fact.rows (); - - ColumnVector p (a_nr); - - Array<octave_idx_type> pvt = getp (); - - for (octave_idx_type i = 0; i < a_nr; i++) - p.xelem (i) = static_cast<double> (pvt.xelem (i) + 1); - - return p; -} - -template <typename T> -bool -lu<T>::regular (void) const -{ - bool retval = true; - - octave_idx_type k = std::min (a_fact.rows (), a_fact.columns ()); - - for (octave_idx_type i = 0; i < k; i++) + template <typename T> + void + lu<T>::unpack (void) { - if (a_fact(i, i) == ELT_T ()) + if (packed ()) { - retval = false; - break; + l_fact = L (); + a_fact = U (); // FIXME: sub-optimal + ipvt = getp (); } } - return retval; -} + template <typename T> + T + lu<T>::L (void) const + { + if (packed ()) + { + octave_idx_type a_nr = a_fact.rows (); + octave_idx_type a_nc = a_fact.cols (); + octave_idx_type mn = (a_nr < a_nc ? a_nr : a_nc); + + T l (a_nr, mn, ELT_T (0.0)); + + for (octave_idx_type i = 0; i < a_nr; i++) + { + if (i < a_nc) + l.xelem (i, i) = 1.0; + + for (octave_idx_type j = 0; j < (i < a_nc ? i : a_nc); j++) + l.xelem (i, j) = a_fact.xelem (i, j); + } + + return l; + } + else + return l_fact; + } + + template <typename T> + T + lu<T>::U (void) const + { + if (packed ()) + { + octave_idx_type a_nr = a_fact.rows (); + octave_idx_type a_nc = a_fact.cols (); + octave_idx_type mn = (a_nr < a_nc ? a_nr : a_nc); + + T u (mn, a_nc, ELT_T (0.0)); + + for (octave_idx_type i = 0; i < mn; i++) + { + for (octave_idx_type j = i; j < a_nc; j++) + u.xelem (i, j) = a_fact.xelem (i, j); + } + + return u; + } + else + return a_fact; + } + + template <typename T> + T + lu<T>::Y (void) const + { + if (! packed ()) + (*current_liboctave_error_handler) + ("lu: Y () not implemented for unpacked form"); + + return a_fact; + } + + template <typename T> + Array<octave_idx_type> + lu<T>::getp (void) const + { + if (packed ()) + { + octave_idx_type a_nr = a_fact.rows (); + + Array<octave_idx_type> pvt (dim_vector (a_nr, 1)); + + for (octave_idx_type i = 0; i < a_nr; i++) + pvt.xelem (i) = i; + + for (octave_idx_type i = 0; i < ipvt.numel (); i++) + { + octave_idx_type k = ipvt.xelem (i); + + if (k != i) + { + octave_idx_type tmp = pvt.xelem (k); + pvt.xelem (k) = pvt.xelem (i); + pvt.xelem (i) = tmp; + } + } + + return pvt; + } + else + return ipvt; + } + + template <typename T> + PermMatrix + lu<T>::P (void) const + { + return PermMatrix (getp (), false); + } + + template <typename T> + ColumnVector + lu<T>::P_vec (void) const + { + octave_idx_type a_nr = a_fact.rows (); + + ColumnVector p (a_nr); + + Array<octave_idx_type> pvt = getp (); + + for (octave_idx_type i = 0; i < a_nr; i++) + p.xelem (i) = static_cast<double> (pvt.xelem (i) + 1); + + return p; + } + + template <typename T> + bool + lu<T>::regular (void) const + { + bool retval = true; + + octave_idx_type k = std::min (a_fact.rows (), a_fact.columns ()); + + for (octave_idx_type i = 0; i < k; i++) + { + if (a_fact(i, i) == ELT_T ()) + { + retval = false; + break; + } + } + + return retval; + } #if ! defined (HAVE_QRUPDATE_LUU) -template <typename T> -void -lu<T>::update (const VT&, const VT&) -{ - (*current_liboctave_error_handler) - ("luupdate: support for qrupdate with LU updates " - "was unavailable or disabled when liboctave was built"); -} + template <typename T> + void + lu<T>::update (const VT&, const VT&) + { + (*current_liboctave_error_handler) + ("luupdate: support for qrupdate with LU updates " + "was unavailable or disabled when liboctave was built"); + } -template <typename T> -void -lu<T>::update (const T&, const T&) -{ - (*current_liboctave_error_handler) - ("luupdate: support for qrupdate with LU updates " - "was unavailable or disabled when liboctave was built"); -} + template <typename T> + void + lu<T>::update (const T&, const T&) + { + (*current_liboctave_error_handler) + ("luupdate: support for qrupdate with LU updates " + "was unavailable or disabled when liboctave was built"); + } -template <typename T> -void -lu<T>::update_piv (const VT&, const VT&) -{ - (*current_liboctave_error_handler) - ("luupdate: support for qrupdate with LU updates " - "was unavailable or disabled when liboctave was built"); -} + template <typename T> + void + lu<T>::update_piv (const VT&, const VT&) + { + (*current_liboctave_error_handler) + ("luupdate: support for qrupdate with LU updates " + "was unavailable or disabled when liboctave was built"); + } -template <typename T> -void -lu<T>::update_piv (const T&, const T&) -{ - (*current_liboctave_error_handler) - ("luupdate: support for qrupdate with LU updates " - "was unavailable or disabled when liboctave was built"); -} + template <typename T> + void + lu<T>::update_piv (const T&, const T&) + { + (*current_liboctave_error_handler) + ("luupdate: support for qrupdate with LU updates " + "was unavailable or disabled when liboctave was built"); + } #endif -// Specializations. + // Specializations. -template <> -lu<Matrix>::lu (const Matrix& a) -{ - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); - octave_idx_type mn = (a_nr < a_nc ? a_nr : a_nc); + template <> + lu<Matrix>::lu (const Matrix& a) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); + octave_idx_type mn = (a_nr < a_nc ? a_nr : a_nc); - ipvt.resize (dim_vector (mn, 1)); - octave_idx_type *pipvt = ipvt.fortran_vec (); + ipvt.resize (dim_vector (mn, 1)); + octave_idx_type *pipvt = ipvt.fortran_vec (); - a_fact = a; - double *tmp_data = a_fact.fortran_vec (); + a_fact = a; + double *tmp_data = a_fact.fortran_vec (); - octave_idx_type info = 0; + octave_idx_type info = 0; - F77_XFCN (dgetrf, DGETRF, (a_nr, a_nc, tmp_data, a_nr, pipvt, info)); + F77_XFCN (dgetrf, DGETRF, (a_nr, a_nc, tmp_data, a_nr, pipvt, info)); - for (octave_idx_type i = 0; i < mn; i++) - pipvt[i] -= 1; -} + for (octave_idx_type i = 0; i < mn; i++) + pipvt[i] -= 1; + } #if defined (HAVE_QRUPDATE_LUU) -template <> -void -lu<Matrix>::update (const ColumnVector& u, const ColumnVector& v) -{ - if (packed ()) - unpack (); - - Matrix& l = l_fact; - Matrix& r = a_fact; + template <> + void + lu<Matrix>::update (const ColumnVector& u, const ColumnVector& v) + { + if (packed ()) + unpack (); - octave_idx_type m = l.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = l.columns (); - - if (u.numel () != m || v.numel () != n) - (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); - - ColumnVector utmp = u; - ColumnVector vtmp = v; - F77_XFCN (dlu1up, DLU1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (), k, - utmp.fortran_vec (), vtmp.fortran_vec ())); -} + Matrix& l = l_fact; + Matrix& r = a_fact; -template <> -void -lu<Matrix>::update (const Matrix& u, const Matrix& v) -{ - if (packed ()) - unpack (); - - Matrix& l = l_fact; - Matrix& r = a_fact; + octave_idx_type m = l.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = l.columns (); - octave_idx_type m = l.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = l.columns (); - - if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) - (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + if (u.numel () != m || v.numel () != n) + (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); - for (volatile octave_idx_type i = 0; i < u.cols (); i++) - { - ColumnVector utmp = u.column (i); - ColumnVector vtmp = v.column (i); - F77_XFCN (dlu1up, DLU1UP, (m, n, l.fortran_vec (), - m, r.fortran_vec (), k, + ColumnVector utmp = u; + ColumnVector vtmp = v; + F77_XFCN (dlu1up, DLU1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (), k, utmp.fortran_vec (), vtmp.fortran_vec ())); } -} -template <> -void -lu<Matrix>::update_piv (const ColumnVector& u, const ColumnVector& v) -{ - if (packed ()) - unpack (); + template <> + void + lu<Matrix>::update (const Matrix& u, const Matrix& v) + { + if (packed ()) + unpack (); - Matrix& l = l_fact; - Matrix& r = a_fact; + Matrix& l = l_fact; + Matrix& r = a_fact; - octave_idx_type m = l.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = l.columns (); + octave_idx_type m = l.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = l.columns (); - if (u.numel () != m || v.numel () != n) - (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) + (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); - ColumnVector utmp = u; - ColumnVector vtmp = v; - OCTAVE_LOCAL_BUFFER (double, w, m); - for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1; // increment - F77_XFCN (dlup1up, DLUP1UP, (m, n, l.fortran_vec (), - m, r.fortran_vec (), k, - ipvt.fortran_vec (), - utmp.data (), vtmp.data (), w)); - for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1; // decrement -} + for (volatile octave_idx_type i = 0; i < u.cols (); i++) + { + ColumnVector utmp = u.column (i); + ColumnVector vtmp = v.column (i); + F77_XFCN (dlu1up, DLU1UP, (m, n, l.fortran_vec (), + m, r.fortran_vec (), k, + utmp.fortran_vec (), vtmp.fortran_vec ())); + } + } -template <> -void -lu<Matrix>::update_piv (const Matrix& u, const Matrix& v) -{ - if (packed ()) - unpack (); + template <> + void + lu<Matrix>::update_piv (const ColumnVector& u, const ColumnVector& v) + { + if (packed ()) + unpack (); - Matrix& l = l_fact; - Matrix& r = a_fact; + Matrix& l = l_fact; + Matrix& r = a_fact; - octave_idx_type m = l.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = l.columns (); - - if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) - (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + octave_idx_type m = l.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = l.columns (); - OCTAVE_LOCAL_BUFFER (double, w, m); - for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1; // increment - for (volatile octave_idx_type i = 0; i < u.cols (); i++) - { - ColumnVector utmp = u.column (i); - ColumnVector vtmp = v.column (i); + if (u.numel () != m || v.numel () != n) + (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + + ColumnVector utmp = u; + ColumnVector vtmp = v; + OCTAVE_LOCAL_BUFFER (double, w, m); + for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1; // increment F77_XFCN (dlup1up, DLUP1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (), k, ipvt.fortran_vec (), utmp.data (), vtmp.data (), w)); + for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1; // decrement } - for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1; // decrement -} + + template <> + void + lu<Matrix>::update_piv (const Matrix& u, const Matrix& v) + { + if (packed ()) + unpack (); + + Matrix& l = l_fact; + Matrix& r = a_fact; + + octave_idx_type m = l.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = l.columns (); + + if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) + (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + + OCTAVE_LOCAL_BUFFER (double, w, m); + for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1; // increment + for (volatile octave_idx_type i = 0; i < u.cols (); i++) + { + ColumnVector utmp = u.column (i); + ColumnVector vtmp = v.column (i); + F77_XFCN (dlup1up, DLUP1UP, (m, n, l.fortran_vec (), + m, r.fortran_vec (), k, + ipvt.fortran_vec (), + utmp.data (), vtmp.data (), w)); + } + for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1; // decrement + } #endif -template <> -lu<FloatMatrix>::lu (const FloatMatrix& a) -{ - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); - octave_idx_type mn = (a_nr < a_nc ? a_nr : a_nc); + template <> + lu<FloatMatrix>::lu (const FloatMatrix& a) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); + octave_idx_type mn = (a_nr < a_nc ? a_nr : a_nc); - ipvt.resize (dim_vector (mn, 1)); - octave_idx_type *pipvt = ipvt.fortran_vec (); + ipvt.resize (dim_vector (mn, 1)); + octave_idx_type *pipvt = ipvt.fortran_vec (); - a_fact = a; - float *tmp_data = a_fact.fortran_vec (); + a_fact = a; + float *tmp_data = a_fact.fortran_vec (); - octave_idx_type info = 0; + octave_idx_type info = 0; - F77_XFCN (sgetrf, SGETRF, (a_nr, a_nc, tmp_data, a_nr, pipvt, info)); + F77_XFCN (sgetrf, SGETRF, (a_nr, a_nc, tmp_data, a_nr, pipvt, info)); - for (octave_idx_type i = 0; i < mn; i++) - pipvt[i] -= 1; -} + for (octave_idx_type i = 0; i < mn; i++) + pipvt[i] -= 1; + } #if defined (HAVE_QRUPDATE_LUU) -template <> -void -lu<FloatMatrix>::update (const FloatColumnVector& u, const FloatColumnVector& v) -{ - if (packed ()) - unpack (); + template <> + void + lu<FloatMatrix>::update (const FloatColumnVector& u, const FloatColumnVector& v) + { + if (packed ()) + unpack (); - FloatMatrix& l = l_fact; - FloatMatrix& r = a_fact; - - octave_idx_type m = l.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = l.columns (); - - if (u.numel () != m || v.numel () != n) - (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + FloatMatrix& l = l_fact; + FloatMatrix& r = a_fact; - FloatColumnVector utmp = u; - FloatColumnVector vtmp = v; - F77_XFCN (slu1up, SLU1UP, (m, n, l.fortran_vec (), - m, r.fortran_vec (), k, - utmp.fortran_vec (), vtmp.fortran_vec ())); -} - -template <> -void -lu<FloatMatrix>::update (const FloatMatrix& u, const FloatMatrix& v) -{ - if (packed ()) - unpack (); + octave_idx_type m = l.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = l.columns (); - FloatMatrix& l = l_fact; - FloatMatrix& r = a_fact; - - octave_idx_type m = l.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = l.columns (); + if (u.numel () != m || v.numel () != n) + (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); - if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) - (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); - - for (volatile octave_idx_type i = 0; i < u.cols (); i++) - { - FloatColumnVector utmp = u.column (i); - FloatColumnVector vtmp = v.column (i); + FloatColumnVector utmp = u; + FloatColumnVector vtmp = v; F77_XFCN (slu1up, SLU1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (), k, utmp.fortran_vec (), vtmp.fortran_vec ())); } -} -template <> -void -lu<FloatMatrix>::update_piv (const FloatColumnVector& u, - const FloatColumnVector& v) -{ - if (packed ()) - unpack (); + template <> + void + lu<FloatMatrix>::update (const FloatMatrix& u, const FloatMatrix& v) + { + if (packed ()) + unpack (); - FloatMatrix& l = l_fact; - FloatMatrix& r = a_fact; + FloatMatrix& l = l_fact; + FloatMatrix& r = a_fact; - octave_idx_type m = l.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = l.columns (); + octave_idx_type m = l.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = l.columns (); - if (u.numel () != m || v.numel () != n) - (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) + (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); - FloatColumnVector utmp = u; - FloatColumnVector vtmp = v; - OCTAVE_LOCAL_BUFFER (float, w, m); - for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1; // increment - F77_XFCN (slup1up, SLUP1UP, (m, n, l.fortran_vec (), - m, r.fortran_vec (), k, - ipvt.fortran_vec (), - utmp.data (), vtmp.data (), w)); - for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1; // decrement -} + for (volatile octave_idx_type i = 0; i < u.cols (); i++) + { + FloatColumnVector utmp = u.column (i); + FloatColumnVector vtmp = v.column (i); + F77_XFCN (slu1up, SLU1UP, (m, n, l.fortran_vec (), + m, r.fortran_vec (), k, + utmp.fortran_vec (), vtmp.fortran_vec ())); + } + } -template <> -void -lu<FloatMatrix>::update_piv (const FloatMatrix& u, const FloatMatrix& v) -{ - if (packed ()) - unpack (); + template <> + void + lu<FloatMatrix>::update_piv (const FloatColumnVector& u, + const FloatColumnVector& v) + { + if (packed ()) + unpack (); - FloatMatrix& l = l_fact; - FloatMatrix& r = a_fact; + FloatMatrix& l = l_fact; + FloatMatrix& r = a_fact; - octave_idx_type m = l.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = l.columns (); - - if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) - (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + octave_idx_type m = l.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = l.columns (); - OCTAVE_LOCAL_BUFFER (float, w, m); - for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1; // increment - for (volatile octave_idx_type i = 0; i < u.cols (); i++) - { - FloatColumnVector utmp = u.column (i); - FloatColumnVector vtmp = v.column (i); + if (u.numel () != m || v.numel () != n) + (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + + FloatColumnVector utmp = u; + FloatColumnVector vtmp = v; + OCTAVE_LOCAL_BUFFER (float, w, m); + for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1; // increment F77_XFCN (slup1up, SLUP1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (), k, ipvt.fortran_vec (), utmp.data (), vtmp.data (), w)); + for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1; // decrement } - for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1; // decrement -} + + template <> + void + lu<FloatMatrix>::update_piv (const FloatMatrix& u, const FloatMatrix& v) + { + if (packed ()) + unpack (); + + FloatMatrix& l = l_fact; + FloatMatrix& r = a_fact; + + octave_idx_type m = l.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = l.columns (); + + if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) + (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + + OCTAVE_LOCAL_BUFFER (float, w, m); + for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1; // increment + for (volatile octave_idx_type i = 0; i < u.cols (); i++) + { + FloatColumnVector utmp = u.column (i); + FloatColumnVector vtmp = v.column (i); + F77_XFCN (slup1up, SLUP1UP, (m, n, l.fortran_vec (), + m, r.fortran_vec (), k, + ipvt.fortran_vec (), + utmp.data (), vtmp.data (), w)); + } + for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1; // decrement + } #endif -template <> -lu<ComplexMatrix>::lu (const ComplexMatrix& a) -{ - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); - octave_idx_type mn = (a_nr < a_nc ? a_nr : a_nc); + template <> + lu<ComplexMatrix>::lu (const ComplexMatrix& a) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); + octave_idx_type mn = (a_nr < a_nc ? a_nr : a_nc); - ipvt.resize (dim_vector (mn, 1)); - octave_idx_type *pipvt = ipvt.fortran_vec (); + ipvt.resize (dim_vector (mn, 1)); + octave_idx_type *pipvt = ipvt.fortran_vec (); - a_fact = a; - Complex *tmp_data = a_fact.fortran_vec (); + a_fact = a; + Complex *tmp_data = a_fact.fortran_vec (); - octave_idx_type info = 0; + octave_idx_type info = 0; - F77_XFCN (zgetrf, ZGETRF, (a_nr, a_nc, F77_DBLE_CMPLX_ARG (tmp_data), a_nr, pipvt, info)); + F77_XFCN (zgetrf, ZGETRF, (a_nr, a_nc, F77_DBLE_CMPLX_ARG (tmp_data), a_nr, pipvt, info)); - for (octave_idx_type i = 0; i < mn; i++) - pipvt[i] -= 1; -} + for (octave_idx_type i = 0; i < mn; i++) + pipvt[i] -= 1; + } #if defined (HAVE_QRUPDATE_LUU) -template <> -void -lu<ComplexMatrix>::update (const ComplexColumnVector& u, - const ComplexColumnVector& v) -{ - if (packed ()) - unpack (); - - ComplexMatrix& l = l_fact; - ComplexMatrix& r = a_fact; + template <> + void + lu<ComplexMatrix>::update (const ComplexColumnVector& u, + const ComplexColumnVector& v) + { + if (packed ()) + unpack (); - octave_idx_type m = l.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = l.columns (); - - if (u.numel () != m || v.numel () != n) - (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); - - ComplexColumnVector utmp = u; - ComplexColumnVector vtmp = v; - F77_XFCN (zlu1up, ZLU1UP, (m, n, F77_DBLE_CMPLX_ARG (l.fortran_vec ()), m, F77_DBLE_CMPLX_ARG (r.fortran_vec ()), k, - F77_DBLE_CMPLX_ARG (utmp.fortran_vec ()), F77_DBLE_CMPLX_ARG (vtmp.fortran_vec ()))); -} + ComplexMatrix& l = l_fact; + ComplexMatrix& r = a_fact; -template <> -void -lu<ComplexMatrix>::update (const ComplexMatrix& u, const ComplexMatrix& v) -{ - if (packed ()) - unpack (); - - ComplexMatrix& l = l_fact; - ComplexMatrix& r = a_fact; + octave_idx_type m = l.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = l.columns (); - octave_idx_type m = l.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = l.columns (); - - if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) - (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + if (u.numel () != m || v.numel () != n) + (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); - for (volatile octave_idx_type i = 0; i < u.cols (); i++) - { - ComplexColumnVector utmp = u.column (i); - ComplexColumnVector vtmp = v.column (i); - F77_XFCN (zlu1up, ZLU1UP, (m, n, F77_DBLE_CMPLX_ARG (l.fortran_vec ()), - m, F77_DBLE_CMPLX_ARG (r.fortran_vec ()), k, + ComplexColumnVector utmp = u; + ComplexColumnVector vtmp = v; + F77_XFCN (zlu1up, ZLU1UP, (m, n, F77_DBLE_CMPLX_ARG (l.fortran_vec ()), m, F77_DBLE_CMPLX_ARG (r.fortran_vec ()), k, F77_DBLE_CMPLX_ARG (utmp.fortran_vec ()), F77_DBLE_CMPLX_ARG (vtmp.fortran_vec ()))); } -} -template <> -void -lu<ComplexMatrix>::update_piv (const ComplexColumnVector& u, - const ComplexColumnVector& v) -{ - if (packed ()) - unpack (); + template <> + void + lu<ComplexMatrix>::update (const ComplexMatrix& u, const ComplexMatrix& v) + { + if (packed ()) + unpack (); - ComplexMatrix& l = l_fact; - ComplexMatrix& r = a_fact; + ComplexMatrix& l = l_fact; + ComplexMatrix& r = a_fact; - octave_idx_type m = l.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = l.columns (); + octave_idx_type m = l.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = l.columns (); - if (u.numel () != m || v.numel () != n) - (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) + (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); - ComplexColumnVector utmp = u; - ComplexColumnVector vtmp = v; - OCTAVE_LOCAL_BUFFER (Complex, w, m); - for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1; // increment - F77_XFCN (zlup1up, ZLUP1UP, (m, n, F77_DBLE_CMPLX_ARG (l.fortran_vec ()), - m, F77_DBLE_CMPLX_ARG (r.fortran_vec ()), k, - ipvt.fortran_vec (), - F77_CONST_DBLE_CMPLX_ARG (utmp.data ()), F77_CONST_DBLE_CMPLX_ARG (vtmp.data ()), F77_DBLE_CMPLX_ARG (w))); - for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1; // decrement -} + for (volatile octave_idx_type i = 0; i < u.cols (); i++) + { + ComplexColumnVector utmp = u.column (i); + ComplexColumnVector vtmp = v.column (i); + F77_XFCN (zlu1up, ZLU1UP, (m, n, F77_DBLE_CMPLX_ARG (l.fortran_vec ()), + m, F77_DBLE_CMPLX_ARG (r.fortran_vec ()), k, + F77_DBLE_CMPLX_ARG (utmp.fortran_vec ()), F77_DBLE_CMPLX_ARG (vtmp.fortran_vec ()))); + } + } -template <> -void -lu<ComplexMatrix>::update_piv (const ComplexMatrix& u, const ComplexMatrix& v) -{ - if (packed ()) - unpack (); + template <> + void + lu<ComplexMatrix>::update_piv (const ComplexColumnVector& u, + const ComplexColumnVector& v) + { + if (packed ()) + unpack (); - ComplexMatrix& l = l_fact; - ComplexMatrix& r = a_fact; + ComplexMatrix& l = l_fact; + ComplexMatrix& r = a_fact; - octave_idx_type m = l.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = l.columns (); - - if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) - (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + octave_idx_type m = l.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = l.columns (); - OCTAVE_LOCAL_BUFFER (Complex, w, m); - for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1; // increment - for (volatile octave_idx_type i = 0; i < u.cols (); i++) - { - ComplexColumnVector utmp = u.column (i); - ComplexColumnVector vtmp = v.column (i); + if (u.numel () != m || v.numel () != n) + (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + + ComplexColumnVector utmp = u; + ComplexColumnVector vtmp = v; + OCTAVE_LOCAL_BUFFER (Complex, w, m); + for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1; // increment F77_XFCN (zlup1up, ZLUP1UP, (m, n, F77_DBLE_CMPLX_ARG (l.fortran_vec ()), m, F77_DBLE_CMPLX_ARG (r.fortran_vec ()), k, ipvt.fortran_vec (), F77_CONST_DBLE_CMPLX_ARG (utmp.data ()), F77_CONST_DBLE_CMPLX_ARG (vtmp.data ()), F77_DBLE_CMPLX_ARG (w))); + for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1; // decrement } - for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1; // decrement -} + + template <> + void + lu<ComplexMatrix>::update_piv (const ComplexMatrix& u, const ComplexMatrix& v) + { + if (packed ()) + unpack (); + + ComplexMatrix& l = l_fact; + ComplexMatrix& r = a_fact; + + octave_idx_type m = l.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = l.columns (); + + if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) + (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + + OCTAVE_LOCAL_BUFFER (Complex, w, m); + for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1; // increment + for (volatile octave_idx_type i = 0; i < u.cols (); i++) + { + ComplexColumnVector utmp = u.column (i); + ComplexColumnVector vtmp = v.column (i); + F77_XFCN (zlup1up, ZLUP1UP, (m, n, F77_DBLE_CMPLX_ARG (l.fortran_vec ()), + m, F77_DBLE_CMPLX_ARG (r.fortran_vec ()), k, + ipvt.fortran_vec (), + F77_CONST_DBLE_CMPLX_ARG (utmp.data ()), F77_CONST_DBLE_CMPLX_ARG (vtmp.data ()), F77_DBLE_CMPLX_ARG (w))); + } + for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1; // decrement + } #endif -template <> -lu<FloatComplexMatrix>::lu (const FloatComplexMatrix& a) -{ - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); - octave_idx_type mn = (a_nr < a_nc ? a_nr : a_nc); + template <> + lu<FloatComplexMatrix>::lu (const FloatComplexMatrix& a) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); + octave_idx_type mn = (a_nr < a_nc ? a_nr : a_nc); - ipvt.resize (dim_vector (mn, 1)); - octave_idx_type *pipvt = ipvt.fortran_vec (); + ipvt.resize (dim_vector (mn, 1)); + octave_idx_type *pipvt = ipvt.fortran_vec (); - a_fact = a; - FloatComplex *tmp_data = a_fact.fortran_vec (); + a_fact = a; + FloatComplex *tmp_data = a_fact.fortran_vec (); - octave_idx_type info = 0; + octave_idx_type info = 0; - F77_XFCN (cgetrf, CGETRF, (a_nr, a_nc, F77_CMPLX_ARG (tmp_data), a_nr, pipvt, info)); + F77_XFCN (cgetrf, CGETRF, (a_nr, a_nc, F77_CMPLX_ARG (tmp_data), a_nr, pipvt, info)); - for (octave_idx_type i = 0; i < mn; i++) - pipvt[i] -= 1; -} + for (octave_idx_type i = 0; i < mn; i++) + pipvt[i] -= 1; + } #if defined (HAVE_QRUPDATE_LUU) -template <> -void -lu<FloatComplexMatrix>::update (const FloatComplexColumnVector& u, - const FloatComplexColumnVector& v) -{ - if (packed ()) - unpack (); + template <> + void + lu<FloatComplexMatrix>::update (const FloatComplexColumnVector& u, + const FloatComplexColumnVector& v) + { + if (packed ()) + unpack (); + + FloatComplexMatrix& l = l_fact; + FloatComplexMatrix& r = a_fact; + + octave_idx_type m = l.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = l.columns (); + + if (u.numel () == m && v.numel () == n) + { + FloatComplexColumnVector utmp = u; + FloatComplexColumnVector vtmp = v; + F77_XFCN (clu1up, CLU1UP, (m, n, F77_CMPLX_ARG (l.fortran_vec ()), m, F77_CMPLX_ARG (r.fortran_vec ()), k, + F77_CMPLX_ARG (utmp.fortran_vec ()), F77_CMPLX_ARG (vtmp.fortran_vec ()))); + } + else + (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + } + + template <> + void + lu<FloatComplexMatrix>::update (const FloatComplexMatrix& u, + const FloatComplexMatrix& v) + { + if (packed ()) + unpack (); - FloatComplexMatrix& l = l_fact; - FloatComplexMatrix& r = a_fact; + FloatComplexMatrix& l = l_fact; + FloatComplexMatrix& r = a_fact; + + octave_idx_type m = l.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = l.columns (); + + if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) + (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); - octave_idx_type m = l.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = l.columns (); + for (volatile octave_idx_type i = 0; i < u.cols (); i++) + { + FloatComplexColumnVector utmp = u.column (i); + FloatComplexColumnVector vtmp = v.column (i); + F77_XFCN (clu1up, CLU1UP, (m, n, F77_CMPLX_ARG (l.fortran_vec ()), + m, F77_CMPLX_ARG (r.fortran_vec ()), k, + F77_CMPLX_ARG (utmp.fortran_vec ()), F77_CMPLX_ARG (vtmp.fortran_vec ()))); + } + } - if (u.numel () == m && v.numel () == n) + template <> + void + lu<FloatComplexMatrix>::update_piv (const FloatComplexColumnVector& u, + const FloatComplexColumnVector& v) { + if (packed ()) + unpack (); + + FloatComplexMatrix& l = l_fact; + FloatComplexMatrix& r = a_fact; + + octave_idx_type m = l.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = l.columns (); + + if (u.numel () != m || v.numel () != n) + (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + FloatComplexColumnVector utmp = u; FloatComplexColumnVector vtmp = v; - F77_XFCN (clu1up, CLU1UP, (m, n, F77_CMPLX_ARG (l.fortran_vec ()), m, F77_CMPLX_ARG (r.fortran_vec ()), k, - F77_CMPLX_ARG (utmp.fortran_vec ()), F77_CMPLX_ARG (vtmp.fortran_vec ()))); - } - else - (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); -} - -template <> -void -lu<FloatComplexMatrix>::update (const FloatComplexMatrix& u, - const FloatComplexMatrix& v) -{ - if (packed ()) - unpack (); - - FloatComplexMatrix& l = l_fact; - FloatComplexMatrix& r = a_fact; - - octave_idx_type m = l.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = l.columns (); - - if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) - (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); - - for (volatile octave_idx_type i = 0; i < u.cols (); i++) - { - FloatComplexColumnVector utmp = u.column (i); - FloatComplexColumnVector vtmp = v.column (i); - F77_XFCN (clu1up, CLU1UP, (m, n, F77_CMPLX_ARG (l.fortran_vec ()), - m, F77_CMPLX_ARG (r.fortran_vec ()), k, - F77_CMPLX_ARG (utmp.fortran_vec ()), F77_CMPLX_ARG (vtmp.fortran_vec ()))); - } -} - -template <> -void -lu<FloatComplexMatrix>::update_piv (const FloatComplexColumnVector& u, - const FloatComplexColumnVector& v) -{ - if (packed ()) - unpack (); - - FloatComplexMatrix& l = l_fact; - FloatComplexMatrix& r = a_fact; - - octave_idx_type m = l.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = l.columns (); - - if (u.numel () != m || v.numel () != n) - (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); - - FloatComplexColumnVector utmp = u; - FloatComplexColumnVector vtmp = v; - OCTAVE_LOCAL_BUFFER (FloatComplex, w, m); - for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1; // increment - F77_XFCN (clup1up, CLUP1UP, (m, n, F77_CMPLX_ARG (l.fortran_vec ()), - m, F77_CMPLX_ARG (r.fortran_vec ()), k, - ipvt.fortran_vec (), - F77_CONST_CMPLX_ARG (utmp.data ()), F77_CONST_CMPLX_ARG (vtmp.data ()), F77_CMPLX_ARG (w))); - for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1; // decrement -} - -template <> -void -lu<FloatComplexMatrix>::update_piv (const FloatComplexMatrix& u, - const FloatComplexMatrix& v) -{ - if (packed ()) - unpack (); - - FloatComplexMatrix& l = l_fact; - FloatComplexMatrix& r = a_fact; - - octave_idx_type m = l.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = l.columns (); - - if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) - (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); - - OCTAVE_LOCAL_BUFFER (FloatComplex, w, m); - for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1; // increment - for (volatile octave_idx_type i = 0; i < u.cols (); i++) - { - FloatComplexColumnVector utmp = u.column (i); - FloatComplexColumnVector vtmp = v.column (i); + OCTAVE_LOCAL_BUFFER (FloatComplex, w, m); + for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1; // increment F77_XFCN (clup1up, CLUP1UP, (m, n, F77_CMPLX_ARG (l.fortran_vec ()), m, F77_CMPLX_ARG (r.fortran_vec ()), k, ipvt.fortran_vec (), F77_CONST_CMPLX_ARG (utmp.data ()), F77_CONST_CMPLX_ARG (vtmp.data ()), F77_CMPLX_ARG (w))); + for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1; // decrement } - for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1; // decrement -} + + template <> + void + lu<FloatComplexMatrix>::update_piv (const FloatComplexMatrix& u, + const FloatComplexMatrix& v) + { + if (packed ()) + unpack (); + + FloatComplexMatrix& l = l_fact; + FloatComplexMatrix& r = a_fact; + + octave_idx_type m = l.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = l.columns (); + + if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) + (*current_liboctave_error_handler) ("luupdate: dimensions mismatch"); + + OCTAVE_LOCAL_BUFFER (FloatComplex, w, m); + for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1; // increment + for (volatile octave_idx_type i = 0; i < u.cols (); i++) + { + FloatComplexColumnVector utmp = u.column (i); + FloatComplexColumnVector vtmp = v.column (i); + F77_XFCN (clup1up, CLUP1UP, (m, n, F77_CMPLX_ARG (l.fortran_vec ()), + m, F77_CMPLX_ARG (r.fortran_vec ()), k, + ipvt.fortran_vec (), + F77_CONST_CMPLX_ARG (utmp.data ()), F77_CONST_CMPLX_ARG (vtmp.data ()), F77_CMPLX_ARG (w))); + } + for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1; // decrement + } #endif -// Instantiations we need. + // Instantiations we need. -template class lu<Matrix>; + template class lu<Matrix>; -template class lu<FloatMatrix>; + template class lu<FloatMatrix>; -template class lu<ComplexMatrix>; + template class lu<ComplexMatrix>; -template class lu<FloatComplexMatrix>; - + template class lu<FloatComplexMatrix>; + } } -}
--- a/liboctave/numeric/lu.h Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/lu.h Wed Aug 17 10:55:38 2016 -0400 @@ -30,77 +30,75 @@ namespace octave { -namespace math -{ + namespace math + { + template <typename T> + class + lu + { + public: -template <typename T> -class -lu -{ -public: + typedef typename T::column_vector_type VT; + typedef typename T::element_type ELT_T; - typedef typename T::column_vector_type VT; - typedef typename T::element_type ELT_T; + lu (void) + : a_fact (), l_fact (), ipvt () { } - lu (void) - : a_fact (), l_fact (), ipvt () { } + lu (const T& a); - lu (const T& a); + lu (const lu& a) + : a_fact (a.a_fact), l_fact (a.l_fact), ipvt (a.ipvt) { } - lu (const lu& a) - : a_fact (a.a_fact), l_fact (a.l_fact), ipvt (a.ipvt) { } - - lu (const T& l, const T& u, const PermMatrix& p); + lu (const T& l, const T& u, const PermMatrix& p); - lu& operator = (const lu& a) - { - if (this != &a) + lu& operator = (const lu& a) { - a_fact = a.a_fact; - l_fact = a.l_fact; - ipvt = a.ipvt; + if (this != &a) + { + a_fact = a.a_fact; + l_fact = a.l_fact; + ipvt = a.ipvt; + } + + return *this; } - return *this; - } + virtual ~lu (void) { } + + bool packed (void) const; - virtual ~lu (void) { } + void unpack (void); - bool packed (void) const; - - void unpack (void); + T L (void) const; - T L (void) const; + T U (void) const; - T U (void) const; + T Y (void) const; - T Y (void) const; + PermMatrix P (void) const; - PermMatrix P (void) const; + ColumnVector P_vec (void) const; - ColumnVector P_vec (void) const; + bool regular (void) const; - bool regular (void) const; + void update (const VT& u, const VT& v); - void update (const VT& u, const VT& v); + void update (const T& u, const T& v); - void update (const T& u, const T& v); + void update_piv (const VT& u, const VT& v); - void update_piv (const VT& u, const VT& v); - - void update_piv (const T& u, const T& v); + void update_piv (const T& u, const T& v); -protected: + protected: - Array<octave_idx_type> getp (void) const; + Array<octave_idx_type> getp (void) const; - T a_fact; - T l_fact; + T a_fact; + T l_fact; - Array<octave_idx_type> ipvt; -}; - -} + Array<octave_idx_type> ipvt; + }; + } } #endif
--- a/liboctave/numeric/qr.cc Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/qr.cc Wed Aug 17 10:55:38 2016 -0400 @@ -48,1779 +48,1777 @@ namespace octave { -namespace math -{ - -template <typename T> -qr<T>::qr (const T& q_arg, const T& r_arg) - : q (q_arg), r (r_arg) -{ - octave_idx_type q_nr = q.rows (); - octave_idx_type q_nc = q.columns (); - - octave_idx_type r_nr = r.rows (); - octave_idx_type r_nc = r.columns (); - - if (! (q_nc == r_nr && (q_nr == q_nc || (q_nr > q_nc && r_nr == r_nc)))) - (*current_liboctave_error_handler) ("QR dimensions mismatch"); -} - -template <typename T> -typename qr<T>::type -qr<T>::get_type (void) const -{ - type retval; + namespace math + { + template <typename T> + qr<T>::qr (const T& q_arg, const T& r_arg) + : q (q_arg), r (r_arg) + { + octave_idx_type q_nr = q.rows (); + octave_idx_type q_nc = q.columns (); - if (! q.is_empty () && q.is_square ()) - retval = qr<T>::std; - else if (q.rows () > q.columns () && r.is_square ()) - retval = qr<T>::economy; - else - retval = qr<T>::raw; - - return retval; -} + octave_idx_type r_nr = r.rows (); + octave_idx_type r_nc = r.columns (); -template <typename T> -bool -qr<T>::regular (void) const -{ - bool retval = true; - - octave_idx_type k = std::min (r.rows (), r.columns ()); - - for (octave_idx_type i = 0; i < k; i++) - { - if (r(i, i) == ELT_T ()) - { - retval = false; - break; - } + if (! (q_nc == r_nr && (q_nr == q_nc || (q_nr > q_nc && r_nr == r_nc)))) + (*current_liboctave_error_handler) ("QR dimensions mismatch"); } - return retval; -} + template <typename T> + typename qr<T>::type + qr<T>::get_type (void) const + { + type retval; + + if (! q.is_empty () && q.is_square ()) + retval = qr<T>::std; + else if (q.rows () > q.columns () && r.is_square ()) + retval = qr<T>::economy; + else + retval = qr<T>::raw; + + return retval; + } + + template <typename T> + bool + qr<T>::regular (void) const + { + bool retval = true; + + octave_idx_type k = std::min (r.rows (), r.columns ()); + + for (octave_idx_type i = 0; i < k; i++) + { + if (r(i, i) == ELT_T ()) + { + retval = false; + break; + } + } + + return retval; + } #if ! defined (HAVE_QRUPDATE) -// Replacement update methods. + // Replacement update methods. -void -warn_qrupdate_once (void) -{ - static bool warned = false; - - if (! warned) + void + warn_qrupdate_once (void) { - (*current_liboctave_warning_with_id_handler) - ("Octave:missing-dependency", - "In this version of Octave, QR & Cholesky updating routines " - "simply update the matrix and recalculate factorizations. " - "To use fast algorithms, link Octave with the qrupdate library. " - "See <http://sourceforge.net/projects/qrupdate>."); + static bool warned = false; - warned = true; + if (! warned) + { + (*current_liboctave_warning_with_id_handler) + ("Octave:missing-dependency", + "In this version of Octave, QR & Cholesky updating routines " + "simply update the matrix and recalculate factorizations. " + "To use fast algorithms, link Octave with the qrupdate library. " + "See <http://sourceforge.net/projects/qrupdate>."); + + warned = true; + } } -} -template <typename T> -void -qr<T>::update (const CV_T& u, const CV_T& v) -{ - warn_qrupdate_once (); + template <typename T> + void + qr<T>::update (const CV_T& u, const CV_T& v) + { + warn_qrupdate_once (); - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); - if (u.numel () != m || v.numel () != n) - (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); + if (u.numel () != m || v.numel () != n) + (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); - init (q*r + T (u) * T (v).hermitian (), get_type ()); -} + init (q*r + T (u) * T (v).hermitian (), get_type ()); + } -template <typename T> -void -qr<T>::update (const T& u, const T& v) -{ - warn_qrupdate_once (); + template <typename T> + void + qr<T>::update (const T& u, const T& v) + { + warn_qrupdate_once (); - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); - if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) - (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); + if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) + (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); - init (q*r + u * v.hermitian (), get_type ()); -} + init (q*r + u * v.hermitian (), get_type ()); + } -template <typename T, typename CV_T> -static -T -insert_col (const T& a, octave_idx_type i, const CV_T& x) -{ - T retval (a.rows (), a.columns () + 1); - retval.assign (idx_vector::colon, idx_vector (0, i), - a.index (idx_vector::colon, idx_vector (0, i))); - retval.assign (idx_vector::colon, idx_vector (i), x); - retval.assign (idx_vector::colon, idx_vector (i+1, retval.columns ()), - a.index (idx_vector::colon, idx_vector (i, a.columns ()))); - return retval; -} + template <typename T, typename CV_T> + static + T + insert_col (const T& a, octave_idx_type i, const CV_T& x) + { + T retval (a.rows (), a.columns () + 1); + retval.assign (idx_vector::colon, idx_vector (0, i), + a.index (idx_vector::colon, idx_vector (0, i))); + retval.assign (idx_vector::colon, idx_vector (i), x); + retval.assign (idx_vector::colon, idx_vector (i+1, retval.columns ()), + a.index (idx_vector::colon, idx_vector (i, a.columns ()))); + return retval; + } -template <typename T, typename RV_T> -static -T -insert_row (const T& a, octave_idx_type i, const RV_T& x) -{ - T retval (a.rows () + 1, a.columns ()); - retval.assign (idx_vector (0, i), idx_vector::colon, - a.index (idx_vector (0, i), idx_vector::colon)); - retval.assign (idx_vector (i), idx_vector::colon, x); - retval.assign (idx_vector (i+1, retval.rows ()), idx_vector::colon, - a.index (idx_vector (i, a.rows ()), idx_vector::colon)); - return retval; -} + template <typename T, typename RV_T> + static + T + insert_row (const T& a, octave_idx_type i, const RV_T& x) + { + T retval (a.rows () + 1, a.columns ()); + retval.assign (idx_vector (0, i), idx_vector::colon, + a.index (idx_vector (0, i), idx_vector::colon)); + retval.assign (idx_vector (i), idx_vector::colon, x); + retval.assign (idx_vector (i+1, retval.rows ()), idx_vector::colon, + a.index (idx_vector (i, a.rows ()), idx_vector::colon)); + return retval; + } -template <typename T> -static -T -delete_col (const T& a, octave_idx_type i) -{ - T retval = a; - retval.delete_elements (1, idx_vector (i)); - return retval; -} + template <typename T> + static + T + delete_col (const T& a, octave_idx_type i) + { + T retval = a; + retval.delete_elements (1, idx_vector (i)); + return retval; + } + + template <typename T> + static + T + delete_row (const T& a, octave_idx_type i) + { + T retval = a; + retval.delete_elements (0, idx_vector (i)); + return retval; + } -template <typename T> -static -T -delete_row (const T& a, octave_idx_type i) -{ - T retval = a; - retval.delete_elements (0, idx_vector (i)); - return retval; -} + template <typename T> + static + T + shift_cols (const T& a, octave_idx_type i, octave_idx_type j) + { + octave_idx_type n = a.columns (); + Array<octave_idx_type> p (dim_vector (n, 1)); + for (octave_idx_type k = 0; k < n; k++) p(k) = k; + if (i < j) + { + for (octave_idx_type k = i; k < j; k++) p(k) = k+1; + p(j) = i; + } + else if (j < i) + { + p(j) = i; + for (octave_idx_type k = j+1; k < i+1; k++) p(k) = k-1; + } -template <typename T> -static -T -shift_cols (const T& a, octave_idx_type i, octave_idx_type j) -{ - octave_idx_type n = a.columns (); - Array<octave_idx_type> p (dim_vector (n, 1)); - for (octave_idx_type k = 0; k < n; k++) p(k) = k; - if (i < j) - { - for (octave_idx_type k = i; k < j; k++) p(k) = k+1; - p(j) = i; - } - else if (j < i) - { - p(j) = i; - for (octave_idx_type k = j+1; k < i+1; k++) p(k) = k-1; + return a.index (idx_vector::colon, idx_vector (p)); } - return a.index (idx_vector::colon, idx_vector (p)); -} + template <typename T> + void + qr<T>::insert_col (const CV_T& u, octave_idx_type j) + { + warn_qrupdate_once (); -template <typename T> -void -qr<T>::insert_col (const CV_T& u, octave_idx_type j) -{ - warn_qrupdate_once (); + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); + if (u.numel () != m) + (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); + if (j < 0 || j > n) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); - if (u.numel () != m) - (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); - if (j < 0 || j > n) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); + init (::insert_col (q*r, j, u), get_type ()); + } - init (::insert_col (q*r, j, u), get_type ()); -} + template <typename T> + void + qr<T>::insert_col (const T& u, const Array<octave_idx_type>& j) + { + warn_qrupdate_once (); -template <typename T> -void -qr<T>::insert_col (const T& u, const Array<octave_idx_type>& j) -{ - warn_qrupdate_once (); + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); + Array<octave_idx_type> jsi; + Array<octave_idx_type> js = j.sort (jsi, 0, ASCENDING); + octave_idx_type nj = js.numel (); + bool dups = false; + for (octave_idx_type i = 0; i < nj - 1; i++) + dups = dups && js(i) == js(i+1); - Array<octave_idx_type> jsi; - Array<octave_idx_type> js = j.sort (jsi, 0, ASCENDING); - octave_idx_type nj = js.numel (); - bool dups = false; - for (octave_idx_type i = 0; i < nj - 1; i++) - dups = dups && js(i) == js(i+1); + if (dups) + (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); + if (u.numel () != m || u.columns () != nj) + (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); + if (nj > 0 && (js(0) < 0 || js(nj-1) > n)) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); - if (dups) - (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); - if (u.numel () != m || u.columns () != nj) - (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); - if (nj > 0 && (js(0) < 0 || js(nj-1) > n)) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); + if (nj > 0) + { + T a = q*r; + for (octave_idx_type i = 0; i < js.numel (); i++) + a = ::insert_col (a, js(i), u.column (i)); + init (a, get_type ()); + } + } - if (nj > 0) + template <typename T> + void + qr<T>::delete_col (octave_idx_type j) { - T a = q*r; - for (octave_idx_type i = 0; i < js.numel (); i++) - a = ::insert_col (a, js(i), u.column (i)); - init (a, get_type ()); - } -} + warn_qrupdate_once (); + + octave_idx_type n = r.columns (); + + if (j < 0 || j > n-1) + (*current_liboctave_error_handler) ("qrdelete: index out of range"); -template <typename T> -void -qr<T>::delete_col (octave_idx_type j) -{ - warn_qrupdate_once (); + init (::delete_col (q*r, j), get_type ()); + } - octave_idx_type n = r.columns (); - - if (j < 0 || j > n-1) - (*current_liboctave_error_handler) ("qrdelete: index out of range"); - - init (::delete_col (q*r, j), get_type ()); -} + template <typename T> + void + qr<T>::delete_col (const Array<octave_idx_type>& j) + { + warn_qrupdate_once (); -template <typename T> -void -qr<T>::delete_col (const Array<octave_idx_type>& j) -{ - warn_qrupdate_once (); + octave_idx_type n = r.columns (); - octave_idx_type n = r.columns (); + Array<octave_idx_type> jsi; + Array<octave_idx_type> js = j.sort (jsi, 0, DESCENDING); + octave_idx_type nj = js.numel (); + bool dups = false; + for (octave_idx_type i = 0; i < nj - 1; i++) + dups = dups && js(i) == js(i+1); - Array<octave_idx_type> jsi; - Array<octave_idx_type> js = j.sort (jsi, 0, DESCENDING); - octave_idx_type nj = js.numel (); - bool dups = false; - for (octave_idx_type i = 0; i < nj - 1; i++) - dups = dups && js(i) == js(i+1); + if (dups) + (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); + if (nj > 0 && (js(0) > n-1 || js(nj-1) < 0)) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); - if (dups) - (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); - if (nj > 0 && (js(0) > n-1 || js(nj-1) < 0)) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); + if (nj > 0) + { + T a = q*r; + for (octave_idx_type i = 0; i < js.numel (); i++) + a = ::delete_col (a, js(i)); + init (a, get_type ()); + } + } - if (nj > 0) + template <typename T> + void + qr<T>::insert_row (const RV_T& u, octave_idx_type j) { - T a = q*r; - for (octave_idx_type i = 0; i < js.numel (); i++) - a = ::delete_col (a, js(i)); - init (a, get_type ()); - } -} + warn_qrupdate_once (); -template <typename T> -void -qr<T>::insert_row (const RV_T& u, octave_idx_type j) -{ - warn_qrupdate_once (); - - octave_idx_type m = r.rows (); - octave_idx_type n = r.columns (); + octave_idx_type m = r.rows (); + octave_idx_type n = r.columns (); - if (! q.is_square () || u.numel () != n) - (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); - if (j < 0 || j > m) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); + if (! q.is_square () || u.numel () != n) + (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); + if (j < 0 || j > m) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); - init (::insert_row (q*r, j, u), get_type ()); -} + init (::insert_row (q*r, j, u), get_type ()); + } -template <typename T> -void -qr<T>::delete_row (octave_idx_type j) -{ - warn_qrupdate_once (); + template <typename T> + void + qr<T>::delete_row (octave_idx_type j) + { + warn_qrupdate_once (); - octave_idx_type m = r.rows (); + octave_idx_type m = r.rows (); - if (! q.is_square ()) - (*current_liboctave_error_handler) ("qrdelete: dimensions mismatch"); - if (j < 0 || j > m-1) - (*current_liboctave_error_handler) ("qrdelete: index out of range"); + if (! q.is_square ()) + (*current_liboctave_error_handler) ("qrdelete: dimensions mismatch"); + if (j < 0 || j > m-1) + (*current_liboctave_error_handler) ("qrdelete: index out of range"); - init (::delete_row (q*r, j), get_type ()); -} + init (::delete_row (q*r, j), get_type ()); + } -template <typename T> -void -qr<T>::shift_cols (octave_idx_type i, octave_idx_type j) -{ - warn_qrupdate_once (); + template <typename T> + void + qr<T>::shift_cols (octave_idx_type i, octave_idx_type j) + { + warn_qrupdate_once (); - octave_idx_type n = r.columns (); + octave_idx_type n = r.columns (); - if (i < 0 || i > n-1 || j < 0 || j > n-1) - (*current_liboctave_error_handler) ("qrshift: index out of range"); + if (i < 0 || i > n-1 || j < 0 || j > n-1) + (*current_liboctave_error_handler) ("qrshift: index out of range"); - init (::shift_cols (q*r, i, j), get_type ()); -} + init (::shift_cols (q*r, i, j), get_type ()); + } #endif -// Specializations. + // Specializations. -template <> -void -qr<Matrix>::form (octave_idx_type n, Matrix& afact, double *tau, type qr_type) -{ - octave_idx_type m = afact.rows (); - octave_idx_type min_mn = std::min (m, n); - octave_idx_type info; - - if (qr_type == qr<Matrix>::raw) + template <> + void + qr<Matrix>::form (octave_idx_type n, Matrix& afact, double *tau, type qr_type) { - for (octave_idx_type j = 0; j < min_mn; j++) - { - octave_idx_type limit = j < min_mn - 1 ? j : min_mn - 1; - for (octave_idx_type i = limit + 1; i < m; i++) - afact.elem (i, j) *= tau[j]; - } + octave_idx_type m = afact.rows (); + octave_idx_type min_mn = std::min (m, n); + octave_idx_type info; - r = afact; - } - else - { - // Attempt to minimize copying. - if (m >= n) + if (qr_type == qr<Matrix>::raw) { - // afact will become q. - q = afact; - octave_idx_type k = qr_type == qr<Matrix>::economy ? n : m; - r = Matrix (k, n); - for (octave_idx_type j = 0; j < n; j++) + for (octave_idx_type j = 0; j < min_mn; j++) { - octave_idx_type i = 0; - for (; i <= j; i++) - r.xelem (i, j) = afact.xelem (i, j); - for (; i < k; i++) - r.xelem (i, j) = 0; + octave_idx_type limit = j < min_mn - 1 ? j : min_mn - 1; + for (octave_idx_type i = limit + 1; i < m; i++) + afact.elem (i, j) *= tau[j]; } - afact = Matrix (); // optimize memory + + r = afact; } else { - // afact will become r. - q = Matrix (m, m); - for (octave_idx_type j = 0; j < m; j++) - for (octave_idx_type i = j + 1; i < m; i++) - { - q.xelem (i, j) = afact.xelem (i, j); - afact.xelem (i, j) = 0; - } - r = afact; + // Attempt to minimize copying. + if (m >= n) + { + // afact will become q. + q = afact; + octave_idx_type k = qr_type == qr<Matrix>::economy ? n : m; + r = Matrix (k, n); + for (octave_idx_type j = 0; j < n; j++) + { + octave_idx_type i = 0; + for (; i <= j; i++) + r.xelem (i, j) = afact.xelem (i, j); + for (; i < k; i++) + r.xelem (i, j) = 0; + } + afact = Matrix (); // optimize memory + } + else + { + // afact will become r. + q = Matrix (m, m); + for (octave_idx_type j = 0; j < m; j++) + for (octave_idx_type i = j + 1; i < m; i++) + { + q.xelem (i, j) = afact.xelem (i, j); + afact.xelem (i, j) = 0; + } + r = afact; + } + + if (m > 0) + { + octave_idx_type k = q.columns (); + // workspace query. + double rlwork; + F77_XFCN (dorgqr, DORGQR, (m, k, min_mn, q.fortran_vec (), m, tau, + &rlwork, -1, info)); + + // allocate buffer and do the job. + octave_idx_type lwork = rlwork; + lwork = std::max (lwork, static_cast<octave_idx_type> (1)); + OCTAVE_LOCAL_BUFFER (double, work, lwork); + F77_XFCN (dorgqr, DORGQR, (m, k, min_mn, q.fortran_vec (), m, tau, + work, lwork, info)); + } } + } + + template <> + void + qr<Matrix>::init (const Matrix& a, type qr_type) + { + octave_idx_type m = a.rows (); + octave_idx_type n = a.cols (); + + octave_idx_type min_mn = m < n ? m : n; + OCTAVE_LOCAL_BUFFER (double, tau, min_mn); + + octave_idx_type info = 0; + + Matrix afact = a; + if (m > n && qr_type == qr<Matrix>::std) + afact.resize (m, m); if (m > 0) { - octave_idx_type k = q.columns (); // workspace query. double rlwork; - F77_XFCN (dorgqr, DORGQR, (m, k, min_mn, q.fortran_vec (), m, tau, + F77_XFCN (dgeqrf, DGEQRF, (m, n, afact.fortran_vec (), m, tau, &rlwork, -1, info)); // allocate buffer and do the job. octave_idx_type lwork = rlwork; lwork = std::max (lwork, static_cast<octave_idx_type> (1)); OCTAVE_LOCAL_BUFFER (double, work, lwork); - F77_XFCN (dorgqr, DORGQR, (m, k, min_mn, q.fortran_vec (), m, tau, + F77_XFCN (dgeqrf, DGEQRF, (m, n, afact.fortran_vec (), m, tau, work, lwork, info)); } + + form (n, afact, tau, qr_type); } -} - -template <> -void -qr<Matrix>::init (const Matrix& a, type qr_type) -{ - octave_idx_type m = a.rows (); - octave_idx_type n = a.cols (); - - octave_idx_type min_mn = m < n ? m : n; - OCTAVE_LOCAL_BUFFER (double, tau, min_mn); - - octave_idx_type info = 0; - - Matrix afact = a; - if (m > n && qr_type == qr<Matrix>::std) - afact.resize (m, m); - - if (m > 0) - { - // workspace query. - double rlwork; - F77_XFCN (dgeqrf, DGEQRF, (m, n, afact.fortran_vec (), m, tau, - &rlwork, -1, info)); - - // allocate buffer and do the job. - octave_idx_type lwork = rlwork; - lwork = std::max (lwork, static_cast<octave_idx_type> (1)); - OCTAVE_LOCAL_BUFFER (double, work, lwork); - F77_XFCN (dgeqrf, DGEQRF, (m, n, afact.fortran_vec (), m, tau, - work, lwork, info)); - } - - form (n, afact, tau, qr_type); -} #if defined (HAVE_QRUPDATE) -template <> -void -qr<Matrix>::update (const ColumnVector& u, const ColumnVector& v) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); - - if (u.numel () != m || v.numel () != n) - (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); + template <> + void + qr<Matrix>::update (const ColumnVector& u, const ColumnVector& v) + { + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); - ColumnVector utmp = u; - ColumnVector vtmp = v; - OCTAVE_LOCAL_BUFFER (double, w, 2*k); - F77_XFCN (dqr1up, DQR1UP, (m, n, k, q.fortran_vec (), - m, r.fortran_vec (), k, - utmp.fortran_vec (), vtmp.fortran_vec (), w)); -} + if (u.numel () != m || v.numel () != n) + (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); -template <> -void -qr<Matrix>::update (const Matrix& u, const Matrix& v) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); - - if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) - (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); - - OCTAVE_LOCAL_BUFFER (double, w, 2*k); - for (volatile octave_idx_type i = 0; i < u.cols (); i++) - { - ColumnVector utmp = u.column (i); - ColumnVector vtmp = v.column (i); + ColumnVector utmp = u; + ColumnVector vtmp = v; + OCTAVE_LOCAL_BUFFER (double, w, 2*k); F77_XFCN (dqr1up, DQR1UP, (m, n, k, q.fortran_vec (), m, r.fortran_vec (), k, - utmp.fortran_vec (), vtmp.fortran_vec (), - w)); + utmp.fortran_vec (), vtmp.fortran_vec (), w)); } -} + + template <> + void + qr<Matrix>::update (const Matrix& u, const Matrix& v) + { + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); -template <> -void -qr<Matrix>::insert_col (const ColumnVector& u, octave_idx_type j) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); + if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) + (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); + + OCTAVE_LOCAL_BUFFER (double, w, 2*k); + for (volatile octave_idx_type i = 0; i < u.cols (); i++) + { + ColumnVector utmp = u.column (i); + ColumnVector vtmp = v.column (i); + F77_XFCN (dqr1up, DQR1UP, (m, n, k, q.fortran_vec (), + m, r.fortran_vec (), k, + utmp.fortran_vec (), vtmp.fortran_vec (), + w)); + } + } - if (u.numel () != m) - (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); - if (j < 0 || j > n) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); - - if (k < m) + template <> + void + qr<Matrix>::insert_col (const ColumnVector& u, octave_idx_type j) { - q.resize (m, k+1); - r.resize (k+1, n+1); - } - else - { - r.resize (k, n+1); + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); + + if (u.numel () != m) + (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); + if (j < 0 || j > n) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); + + if (k < m) + { + q.resize (m, k+1); + r.resize (k+1, n+1); + } + else + { + r.resize (k, n+1); + } + + ColumnVector utmp = u; + OCTAVE_LOCAL_BUFFER (double, w, k); + F77_XFCN (dqrinc, DQRINC, (m, n, k, q.fortran_vec (), q.rows (), + r.fortran_vec (), r.rows (), j + 1, + utmp.data (), w)); } - ColumnVector utmp = u; - OCTAVE_LOCAL_BUFFER (double, w, k); - F77_XFCN (dqrinc, DQRINC, (m, n, k, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), j + 1, - utmp.data (), w)); -} + template <> + void + qr<Matrix>::insert_col (const Matrix& u, const Array<octave_idx_type>& j) + { + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); -template <> -void -qr<Matrix>::insert_col (const Matrix& u, const Array<octave_idx_type>& j) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); + Array<octave_idx_type> jsi; + Array<octave_idx_type> js = j.sort (jsi, 0, ASCENDING); + octave_idx_type nj = js.numel (); + bool dups = false; + for (octave_idx_type i = 0; i < nj - 1; i++) + dups = dups && js(i) == js(i+1); + + if (dups) + (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); + if (u.numel () != m || u.columns () != nj) + (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); + if (nj > 0 && (js(0) < 0 || js(nj-1) > n)) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); - Array<octave_idx_type> jsi; - Array<octave_idx_type> js = j.sort (jsi, 0, ASCENDING); - octave_idx_type nj = js.numel (); - bool dups = false; - for (octave_idx_type i = 0; i < nj - 1; i++) - dups = dups && js(i) == js(i+1); + if (nj > 0) + { + octave_idx_type kmax = std::min (k + nj, m); + if (k < m) + { + q.resize (m, kmax); + r.resize (kmax, n + nj); + } + else + { + r.resize (k, n + nj); + } - if (dups) - (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); - if (u.numel () != m || u.columns () != nj) - (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); - if (nj > 0 && (js(0) < 0 || js(nj-1) > n)) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); + OCTAVE_LOCAL_BUFFER (double, w, kmax); + for (volatile octave_idx_type i = 0; i < js.numel (); i++) + { + octave_idx_type ii = i; + ColumnVector utmp = u.column (jsi(i)); + F77_XFCN (dqrinc, DQRINC, (m, n + ii, std::min (kmax, k + ii), + q.fortran_vec (), q.rows (), + r.fortran_vec (), r.rows (), js(ii) + 1, + utmp.data (), w)); + } + } + } - if (nj > 0) + template <> + void + qr<Matrix>::delete_col (octave_idx_type j) { - octave_idx_type kmax = std::min (k + nj, m); + octave_idx_type m = q.rows (); + octave_idx_type k = r.rows (); + octave_idx_type n = r.columns (); + + if (j < 0 || j > n-1) + (*current_liboctave_error_handler) ("qrdelete: index out of range"); + + OCTAVE_LOCAL_BUFFER (double, w, k); + F77_XFCN (dqrdec, DQRDEC, (m, n, k, q.fortran_vec (), q.rows (), + r.fortran_vec (), r.rows (), j + 1, w)); + if (k < m) { - q.resize (m, kmax); - r.resize (kmax, n + nj); + q.resize (m, k-1); + r.resize (k-1, n-1); } else { - r.resize (k, n + nj); + r.resize (k, n-1); } + } + + template <> + void + qr<Matrix>::delete_col (const Array<octave_idx_type>& j) + { + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); - OCTAVE_LOCAL_BUFFER (double, w, kmax); - for (volatile octave_idx_type i = 0; i < js.numel (); i++) + Array<octave_idx_type> jsi; + Array<octave_idx_type> js = j.sort (jsi, 0, DESCENDING); + octave_idx_type nj = js.numel (); + bool dups = false; + for (octave_idx_type i = 0; i < nj - 1; i++) + dups = dups && js(i) == js(i+1); + + if (dups) + (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); + if (nj > 0 && (js(0) > n-1 || js(nj-1) < 0)) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); + + if (nj > 0) { - octave_idx_type ii = i; - ColumnVector utmp = u.column (jsi(i)); - F77_XFCN (dqrinc, DQRINC, (m, n + ii, std::min (kmax, k + ii), - q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), js(ii) + 1, - utmp.data (), w)); + OCTAVE_LOCAL_BUFFER (double, w, k); + for (volatile octave_idx_type i = 0; i < js.numel (); i++) + { + octave_idx_type ii = i; + F77_XFCN (dqrdec, DQRDEC, (m, n - ii, k == m ? k : k - ii, + q.fortran_vec (), q.rows (), + r.fortran_vec (), r.rows (), + js(ii) + 1, w)); + } + if (k < m) + { + q.resize (m, k - nj); + r.resize (k - nj, n - nj); + } + else + { + r.resize (k, n - nj); + } + } } -} -template <> -void -qr<Matrix>::delete_col (octave_idx_type j) -{ - octave_idx_type m = q.rows (); - octave_idx_type k = r.rows (); - octave_idx_type n = r.columns (); + template <> + void + qr<Matrix>::insert_row (const RowVector& u, octave_idx_type j) + { + octave_idx_type m = r.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = std::min (m, n); - if (j < 0 || j > n-1) - (*current_liboctave_error_handler) ("qrdelete: index out of range"); + if (! q.is_square () || u.numel () != n) + (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); + if (j < 0 || j > m) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); - OCTAVE_LOCAL_BUFFER (double, w, k); - F77_XFCN (dqrdec, DQRDEC, (m, n, k, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), j + 1, w)); + q.resize (m + 1, m + 1); + r.resize (m + 1, n); + RowVector utmp = u; + OCTAVE_LOCAL_BUFFER (double, w, k); + F77_XFCN (dqrinr, DQRINR, (m, n, q.fortran_vec (), q.rows (), + r.fortran_vec (), r.rows (), + j + 1, utmp.fortran_vec (), w)); - if (k < m) + } + + template <> + void + qr<Matrix>::delete_row (octave_idx_type j) { - q.resize (m, k-1); - r.resize (k-1, n-1); - } - else - { - r.resize (k, n-1); - } -} + octave_idx_type m = r.rows (); + octave_idx_type n = r.columns (); + + if (! q.is_square ()) + (*current_liboctave_error_handler) ("qrdelete: dimensions mismatch"); + if (j < 0 || j > m-1) + (*current_liboctave_error_handler) ("qrdelete: index out of range"); + + OCTAVE_LOCAL_BUFFER (double, w, 2*m); + F77_XFCN (dqrder, DQRDER, (m, n, q.fortran_vec (), q.rows (), + r.fortran_vec (), r.rows (), j + 1, + w)); -template <> -void -qr<Matrix>::delete_col (const Array<octave_idx_type>& j) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); + q.resize (m - 1, m - 1); + r.resize (m - 1, n); + } - Array<octave_idx_type> jsi; - Array<octave_idx_type> js = j.sort (jsi, 0, DESCENDING); - octave_idx_type nj = js.numel (); - bool dups = false; - for (octave_idx_type i = 0; i < nj - 1; i++) - dups = dups && js(i) == js(i+1); + template <> + void + qr<Matrix>::shift_cols (octave_idx_type i, octave_idx_type j) + { + octave_idx_type m = q.rows (); + octave_idx_type k = r.rows (); + octave_idx_type n = r.columns (); + + if (i < 0 || i > n-1 || j < 0 || j > n-1) + (*current_liboctave_error_handler) ("qrshift: index out of range"); - if (dups) - (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); - if (nj > 0 && (js(0) > n-1 || js(nj-1) < 0)) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); + OCTAVE_LOCAL_BUFFER (double, w, 2*k); + F77_XFCN (dqrshc, DQRSHC, (m, n, k, + q.fortran_vec (), q.rows (), + r.fortran_vec (), r.rows (), + i + 1, j + 1, w)); + } + +#endif - if (nj > 0) + template <> + void + qr<FloatMatrix>::form (octave_idx_type n, FloatMatrix& afact, float *tau, type qr_type) { - OCTAVE_LOCAL_BUFFER (double, w, k); - for (volatile octave_idx_type i = 0; i < js.numel (); i++) + octave_idx_type m = afact.rows (); + octave_idx_type min_mn = std::min (m, n); + octave_idx_type info; + + if (qr_type == qr<FloatMatrix>::raw) { - octave_idx_type ii = i; - F77_XFCN (dqrdec, DQRDEC, (m, n - ii, k == m ? k : k - ii, - q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), - js(ii) + 1, w)); - } - if (k < m) - { - q.resize (m, k - nj); - r.resize (k - nj, n - nj); + for (octave_idx_type j = 0; j < min_mn; j++) + { + octave_idx_type limit = j < min_mn - 1 ? j : min_mn - 1; + for (octave_idx_type i = limit + 1; i < m; i++) + afact.elem (i, j) *= tau[j]; + } + + r = afact; } else { - r.resize (k, n - nj); - } - - } -} - -template <> -void -qr<Matrix>::insert_row (const RowVector& u, octave_idx_type j) -{ - octave_idx_type m = r.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = std::min (m, n); - - if (! q.is_square () || u.numel () != n) - (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); - if (j < 0 || j > m) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); - - q.resize (m + 1, m + 1); - r.resize (m + 1, n); - RowVector utmp = u; - OCTAVE_LOCAL_BUFFER (double, w, k); - F77_XFCN (dqrinr, DQRINR, (m, n, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), - j + 1, utmp.fortran_vec (), w)); - -} - -template <> -void -qr<Matrix>::delete_row (octave_idx_type j) -{ - octave_idx_type m = r.rows (); - octave_idx_type n = r.columns (); - - if (! q.is_square ()) - (*current_liboctave_error_handler) ("qrdelete: dimensions mismatch"); - if (j < 0 || j > m-1) - (*current_liboctave_error_handler) ("qrdelete: index out of range"); - - OCTAVE_LOCAL_BUFFER (double, w, 2*m); - F77_XFCN (dqrder, DQRDER, (m, n, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), j + 1, - w)); - - q.resize (m - 1, m - 1); - r.resize (m - 1, n); -} - -template <> -void -qr<Matrix>::shift_cols (octave_idx_type i, octave_idx_type j) -{ - octave_idx_type m = q.rows (); - octave_idx_type k = r.rows (); - octave_idx_type n = r.columns (); + // Attempt to minimize copying. + if (m >= n) + { + // afact will become q. + q = afact; + octave_idx_type k = qr_type == qr<FloatMatrix>::economy ? n : m; + r = FloatMatrix (k, n); + for (octave_idx_type j = 0; j < n; j++) + { + octave_idx_type i = 0; + for (; i <= j; i++) + r.xelem (i, j) = afact.xelem (i, j); + for (; i < k; i++) + r.xelem (i, j) = 0; + } + afact = FloatMatrix (); // optimize memory + } + else + { + // afact will become r. + q = FloatMatrix (m, m); + for (octave_idx_type j = 0; j < m; j++) + for (octave_idx_type i = j + 1; i < m; i++) + { + q.xelem (i, j) = afact.xelem (i, j); + afact.xelem (i, j) = 0; + } + r = afact; + } - if (i < 0 || i > n-1 || j < 0 || j > n-1) - (*current_liboctave_error_handler) ("qrshift: index out of range"); - - OCTAVE_LOCAL_BUFFER (double, w, 2*k); - F77_XFCN (dqrshc, DQRSHC, (m, n, k, - q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), - i + 1, j + 1, w)); -} - -#endif + if (m > 0) + { + octave_idx_type k = q.columns (); + // workspace query. + float rlwork; + F77_XFCN (sorgqr, SORGQR, (m, k, min_mn, q.fortran_vec (), m, tau, + &rlwork, -1, info)); -template <> -void -qr<FloatMatrix>::form (octave_idx_type n, FloatMatrix& afact, float *tau, type qr_type) -{ - octave_idx_type m = afact.rows (); - octave_idx_type min_mn = std::min (m, n); - octave_idx_type info; - - if (qr_type == qr<FloatMatrix>::raw) - { - for (octave_idx_type j = 0; j < min_mn; j++) - { - octave_idx_type limit = j < min_mn - 1 ? j : min_mn - 1; - for (octave_idx_type i = limit + 1; i < m; i++) - afact.elem (i, j) *= tau[j]; + // allocate buffer and do the job. + octave_idx_type lwork = rlwork; + lwork = std::max (lwork, static_cast<octave_idx_type> (1)); + OCTAVE_LOCAL_BUFFER (float, work, lwork); + F77_XFCN (sorgqr, SORGQR, (m, k, min_mn, q.fortran_vec (), m, tau, + work, lwork, info)); + } } - - r = afact; } - else + + template <> + void + qr<FloatMatrix>::init (const FloatMatrix& a, type qr_type) { - // Attempt to minimize copying. - if (m >= n) - { - // afact will become q. - q = afact; - octave_idx_type k = qr_type == qr<FloatMatrix>::economy ? n : m; - r = FloatMatrix (k, n); - for (octave_idx_type j = 0; j < n; j++) - { - octave_idx_type i = 0; - for (; i <= j; i++) - r.xelem (i, j) = afact.xelem (i, j); - for (; i < k; i++) - r.xelem (i, j) = 0; - } - afact = FloatMatrix (); // optimize memory - } - else - { - // afact will become r. - q = FloatMatrix (m, m); - for (octave_idx_type j = 0; j < m; j++) - for (octave_idx_type i = j + 1; i < m; i++) - { - q.xelem (i, j) = afact.xelem (i, j); - afact.xelem (i, j) = 0; - } - r = afact; - } + octave_idx_type m = a.rows (); + octave_idx_type n = a.cols (); + + octave_idx_type min_mn = m < n ? m : n; + OCTAVE_LOCAL_BUFFER (float, tau, min_mn); + + octave_idx_type info = 0; + + FloatMatrix afact = a; + if (m > n && qr_type == qr<FloatMatrix>::std) + afact.resize (m, m); if (m > 0) { - octave_idx_type k = q.columns (); // workspace query. float rlwork; - F77_XFCN (sorgqr, SORGQR, (m, k, min_mn, q.fortran_vec (), m, tau, + F77_XFCN (sgeqrf, SGEQRF, (m, n, afact.fortran_vec (), m, tau, &rlwork, -1, info)); // allocate buffer and do the job. octave_idx_type lwork = rlwork; lwork = std::max (lwork, static_cast<octave_idx_type> (1)); OCTAVE_LOCAL_BUFFER (float, work, lwork); - F77_XFCN (sorgqr, SORGQR, (m, k, min_mn, q.fortran_vec (), m, tau, + F77_XFCN (sgeqrf, SGEQRF, (m, n, afact.fortran_vec (), m, tau, work, lwork, info)); } + + form (n, afact, tau, qr_type); } -} - -template <> -void -qr<FloatMatrix>::init (const FloatMatrix& a, type qr_type) -{ - octave_idx_type m = a.rows (); - octave_idx_type n = a.cols (); - - octave_idx_type min_mn = m < n ? m : n; - OCTAVE_LOCAL_BUFFER (float, tau, min_mn); - - octave_idx_type info = 0; - - FloatMatrix afact = a; - if (m > n && qr_type == qr<FloatMatrix>::std) - afact.resize (m, m); - - if (m > 0) - { - // workspace query. - float rlwork; - F77_XFCN (sgeqrf, SGEQRF, (m, n, afact.fortran_vec (), m, tau, - &rlwork, -1, info)); - - // allocate buffer and do the job. - octave_idx_type lwork = rlwork; - lwork = std::max (lwork, static_cast<octave_idx_type> (1)); - OCTAVE_LOCAL_BUFFER (float, work, lwork); - F77_XFCN (sgeqrf, SGEQRF, (m, n, afact.fortran_vec (), m, tau, - work, lwork, info)); - } - - form (n, afact, tau, qr_type); -} #if defined (HAVE_QRUPDATE) -template <> -void -qr<FloatMatrix>::update (const FloatColumnVector& u, const FloatColumnVector& v) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); - - if (u.numel () != m || v.numel () != n) - (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); + template <> + void + qr<FloatMatrix>::update (const FloatColumnVector& u, const FloatColumnVector& v) + { + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); - FloatColumnVector utmp = u; - FloatColumnVector vtmp = v; - OCTAVE_LOCAL_BUFFER (float, w, 2*k); - F77_XFCN (sqr1up, SQR1UP, (m, n, k, q.fortran_vec (), - m, r.fortran_vec (), k, - utmp.fortran_vec (), vtmp.fortran_vec (), w)); -} + if (u.numel () != m || v.numel () != n) + (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); -template <> -void -qr<FloatMatrix>::update (const FloatMatrix& u, const FloatMatrix& v) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); - - if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) - (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); - - OCTAVE_LOCAL_BUFFER (float, w, 2*k); - for (volatile octave_idx_type i = 0; i < u.cols (); i++) - { - FloatColumnVector utmp = u.column (i); - FloatColumnVector vtmp = v.column (i); + FloatColumnVector utmp = u; + FloatColumnVector vtmp = v; + OCTAVE_LOCAL_BUFFER (float, w, 2*k); F77_XFCN (sqr1up, SQR1UP, (m, n, k, q.fortran_vec (), m, r.fortran_vec (), k, - utmp.fortran_vec (), vtmp.fortran_vec (), - w)); + utmp.fortran_vec (), vtmp.fortran_vec (), w)); } -} + + template <> + void + qr<FloatMatrix>::update (const FloatMatrix& u, const FloatMatrix& v) + { + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); -template <> -void -qr<FloatMatrix>::insert_col (const FloatColumnVector& u, octave_idx_type j) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); + if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) + (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); + + OCTAVE_LOCAL_BUFFER (float, w, 2*k); + for (volatile octave_idx_type i = 0; i < u.cols (); i++) + { + FloatColumnVector utmp = u.column (i); + FloatColumnVector vtmp = v.column (i); + F77_XFCN (sqr1up, SQR1UP, (m, n, k, q.fortran_vec (), + m, r.fortran_vec (), k, + utmp.fortran_vec (), vtmp.fortran_vec (), + w)); + } + } - if (u.numel () != m) - (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); - if (j < 0 || j > n) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); - - if (k < m) + template <> + void + qr<FloatMatrix>::insert_col (const FloatColumnVector& u, octave_idx_type j) { - q.resize (m, k+1); - r.resize (k+1, n+1); - } - else - { - r.resize (k, n+1); + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); + + if (u.numel () != m) + (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); + if (j < 0 || j > n) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); + + if (k < m) + { + q.resize (m, k+1); + r.resize (k+1, n+1); + } + else + { + r.resize (k, n+1); + } + + FloatColumnVector utmp = u; + OCTAVE_LOCAL_BUFFER (float, w, k); + F77_XFCN (sqrinc, SQRINC, (m, n, k, q.fortran_vec (), q.rows (), + r.fortran_vec (), r.rows (), j + 1, + utmp.data (), w)); } - FloatColumnVector utmp = u; - OCTAVE_LOCAL_BUFFER (float, w, k); - F77_XFCN (sqrinc, SQRINC, (m, n, k, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), j + 1, - utmp.data (), w)); -} + template <> + void + qr<FloatMatrix>::insert_col (const FloatMatrix& u, const Array<octave_idx_type>& j) + { + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); -template <> -void -qr<FloatMatrix>::insert_col (const FloatMatrix& u, const Array<octave_idx_type>& j) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); + Array<octave_idx_type> jsi; + Array<octave_idx_type> js = j.sort (jsi, 0, ASCENDING); + octave_idx_type nj = js.numel (); + bool dups = false; + for (octave_idx_type i = 0; i < nj - 1; i++) + dups = dups && js(i) == js(i+1); + + if (dups) + (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); + if (u.numel () != m || u.columns () != nj) + (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); + if (nj > 0 && (js(0) < 0 || js(nj-1) > n)) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); - Array<octave_idx_type> jsi; - Array<octave_idx_type> js = j.sort (jsi, 0, ASCENDING); - octave_idx_type nj = js.numel (); - bool dups = false; - for (octave_idx_type i = 0; i < nj - 1; i++) - dups = dups && js(i) == js(i+1); + if (nj > 0) + { + octave_idx_type kmax = std::min (k + nj, m); + if (k < m) + { + q.resize (m, kmax); + r.resize (kmax, n + nj); + } + else + { + r.resize (k, n + nj); + } - if (dups) - (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); - if (u.numel () != m || u.columns () != nj) - (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); - if (nj > 0 && (js(0) < 0 || js(nj-1) > n)) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); + OCTAVE_LOCAL_BUFFER (float, w, kmax); + for (volatile octave_idx_type i = 0; i < js.numel (); i++) + { + octave_idx_type ii = i; + FloatColumnVector utmp = u.column (jsi(i)); + F77_XFCN (sqrinc, SQRINC, (m, n + ii, std::min (kmax, k + ii), + q.fortran_vec (), q.rows (), + r.fortran_vec (), r.rows (), js(ii) + 1, + utmp.data (), w)); + } + } + } - if (nj > 0) + template <> + void + qr<FloatMatrix>::delete_col (octave_idx_type j) { - octave_idx_type kmax = std::min (k + nj, m); + octave_idx_type m = q.rows (); + octave_idx_type k = r.rows (); + octave_idx_type n = r.columns (); + + if (j < 0 || j > n-1) + (*current_liboctave_error_handler) ("qrdelete: index out of range"); + + OCTAVE_LOCAL_BUFFER (float, w, k); + F77_XFCN (sqrdec, SQRDEC, (m, n, k, q.fortran_vec (), q.rows (), + r.fortran_vec (), r.rows (), j + 1, w)); + if (k < m) { - q.resize (m, kmax); - r.resize (kmax, n + nj); + q.resize (m, k-1); + r.resize (k-1, n-1); } else { - r.resize (k, n + nj); + r.resize (k, n-1); } + } + + template <> + void + qr<FloatMatrix>::delete_col (const Array<octave_idx_type>& j) + { + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); - OCTAVE_LOCAL_BUFFER (float, w, kmax); - for (volatile octave_idx_type i = 0; i < js.numel (); i++) + Array<octave_idx_type> jsi; + Array<octave_idx_type> js = j.sort (jsi, 0, DESCENDING); + octave_idx_type nj = js.numel (); + bool dups = false; + for (octave_idx_type i = 0; i < nj - 1; i++) + dups = dups && js(i) == js(i+1); + + if (dups) + (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); + if (nj > 0 && (js(0) > n-1 || js(nj-1) < 0)) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); + + if (nj > 0) { - octave_idx_type ii = i; - FloatColumnVector utmp = u.column (jsi(i)); - F77_XFCN (sqrinc, SQRINC, (m, n + ii, std::min (kmax, k + ii), - q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), js(ii) + 1, - utmp.data (), w)); + OCTAVE_LOCAL_BUFFER (float, w, k); + for (volatile octave_idx_type i = 0; i < js.numel (); i++) + { + octave_idx_type ii = i; + F77_XFCN (sqrdec, SQRDEC, (m, n - ii, k == m ? k : k - ii, + q.fortran_vec (), q.rows (), + r.fortran_vec (), r.rows (), + js(ii) + 1, w)); + } + if (k < m) + { + q.resize (m, k - nj); + r.resize (k - nj, n - nj); + } + else + { + r.resize (k, n - nj); + } + } } -} -template <> -void -qr<FloatMatrix>::delete_col (octave_idx_type j) -{ - octave_idx_type m = q.rows (); - octave_idx_type k = r.rows (); - octave_idx_type n = r.columns (); + template <> + void + qr<FloatMatrix>::insert_row (const FloatRowVector& u, octave_idx_type j) + { + octave_idx_type m = r.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = std::min (m, n); - if (j < 0 || j > n-1) - (*current_liboctave_error_handler) ("qrdelete: index out of range"); + if (! q.is_square () || u.numel () != n) + (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); + if (j < 0 || j > m) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); - OCTAVE_LOCAL_BUFFER (float, w, k); - F77_XFCN (sqrdec, SQRDEC, (m, n, k, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), j + 1, w)); + q.resize (m + 1, m + 1); + r.resize (m + 1, n); + FloatRowVector utmp = u; + OCTAVE_LOCAL_BUFFER (float, w, k); + F77_XFCN (sqrinr, SQRINR, (m, n, q.fortran_vec (), q.rows (), + r.fortran_vec (), r.rows (), + j + 1, utmp.fortran_vec (), w)); - if (k < m) + } + + template <> + void + qr<FloatMatrix>::delete_row (octave_idx_type j) { - q.resize (m, k-1); - r.resize (k-1, n-1); - } - else - { - r.resize (k, n-1); - } -} + octave_idx_type m = r.rows (); + octave_idx_type n = r.columns (); + + if (! q.is_square ()) + (*current_liboctave_error_handler) ("qrdelete: dimensions mismatch"); + if (j < 0 || j > m-1) + (*current_liboctave_error_handler) ("qrdelete: index out of range"); + + OCTAVE_LOCAL_BUFFER (float, w, 2*m); + F77_XFCN (sqrder, SQRDER, (m, n, q.fortran_vec (), q.rows (), + r.fortran_vec (), r.rows (), j + 1, + w)); -template <> -void -qr<FloatMatrix>::delete_col (const Array<octave_idx_type>& j) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); + q.resize (m - 1, m - 1); + r.resize (m - 1, n); + } - Array<octave_idx_type> jsi; - Array<octave_idx_type> js = j.sort (jsi, 0, DESCENDING); - octave_idx_type nj = js.numel (); - bool dups = false; - for (octave_idx_type i = 0; i < nj - 1; i++) - dups = dups && js(i) == js(i+1); + template <> + void + qr<FloatMatrix>::shift_cols (octave_idx_type i, octave_idx_type j) + { + octave_idx_type m = q.rows (); + octave_idx_type k = r.rows (); + octave_idx_type n = r.columns (); + + if (i < 0 || i > n-1 || j < 0 || j > n-1) + (*current_liboctave_error_handler) ("qrshift: index out of range"); + + OCTAVE_LOCAL_BUFFER (float, w, 2*k); + F77_XFCN (sqrshc, SQRSHC, (m, n, k, + q.fortran_vec (), q.rows (), + r.fortran_vec (), r.rows (), + i + 1, j + 1, w)); + } - if (dups) - (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); - if (nj > 0 && (js(0) > n-1 || js(nj-1) < 0)) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); +#endif - if (nj > 0) + template <> + void + qr<ComplexMatrix>::form (octave_idx_type n, ComplexMatrix& afact, + Complex *tau, type qr_type) { - OCTAVE_LOCAL_BUFFER (float, w, k); - for (volatile octave_idx_type i = 0; i < js.numel (); i++) + octave_idx_type m = afact.rows (); + octave_idx_type min_mn = std::min (m, n); + octave_idx_type info; + + if (qr_type == qr<ComplexMatrix>::raw) { - octave_idx_type ii = i; - F77_XFCN (sqrdec, SQRDEC, (m, n - ii, k == m ? k : k - ii, - q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), - js(ii) + 1, w)); - } - if (k < m) - { - q.resize (m, k - nj); - r.resize (k - nj, n - nj); + for (octave_idx_type j = 0; j < min_mn; j++) + { + octave_idx_type limit = j < min_mn - 1 ? j : min_mn - 1; + for (octave_idx_type i = limit + 1; i < m; i++) + afact.elem (i, j) *= tau[j]; + } + + r = afact; } else { - r.resize (k, n - nj); - } - - } -} - -template <> -void -qr<FloatMatrix>::insert_row (const FloatRowVector& u, octave_idx_type j) -{ - octave_idx_type m = r.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = std::min (m, n); - - if (! q.is_square () || u.numel () != n) - (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); - if (j < 0 || j > m) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); - - q.resize (m + 1, m + 1); - r.resize (m + 1, n); - FloatRowVector utmp = u; - OCTAVE_LOCAL_BUFFER (float, w, k); - F77_XFCN (sqrinr, SQRINR, (m, n, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), - j + 1, utmp.fortran_vec (), w)); - -} - -template <> -void -qr<FloatMatrix>::delete_row (octave_idx_type j) -{ - octave_idx_type m = r.rows (); - octave_idx_type n = r.columns (); - - if (! q.is_square ()) - (*current_liboctave_error_handler) ("qrdelete: dimensions mismatch"); - if (j < 0 || j > m-1) - (*current_liboctave_error_handler) ("qrdelete: index out of range"); - - OCTAVE_LOCAL_BUFFER (float, w, 2*m); - F77_XFCN (sqrder, SQRDER, (m, n, q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), j + 1, - w)); - - q.resize (m - 1, m - 1); - r.resize (m - 1, n); -} - -template <> -void -qr<FloatMatrix>::shift_cols (octave_idx_type i, octave_idx_type j) -{ - octave_idx_type m = q.rows (); - octave_idx_type k = r.rows (); - octave_idx_type n = r.columns (); - - if (i < 0 || i > n-1 || j < 0 || j > n-1) - (*current_liboctave_error_handler) ("qrshift: index out of range"); + // Attempt to minimize copying. + if (m >= n) + { + // afact will become q. + q = afact; + octave_idx_type k = qr_type == qr<ComplexMatrix>::economy ? n : m; + r = ComplexMatrix (k, n); + for (octave_idx_type j = 0; j < n; j++) + { + octave_idx_type i = 0; + for (; i <= j; i++) + r.xelem (i, j) = afact.xelem (i, j); + for (; i < k; i++) + r.xelem (i, j) = 0; + } + afact = ComplexMatrix (); // optimize memory + } + else + { + // afact will become r. + q = ComplexMatrix (m, m); + for (octave_idx_type j = 0; j < m; j++) + for (octave_idx_type i = j + 1; i < m; i++) + { + q.xelem (i, j) = afact.xelem (i, j); + afact.xelem (i, j) = 0; + } + r = afact; + } - OCTAVE_LOCAL_BUFFER (float, w, 2*k); - F77_XFCN (sqrshc, SQRSHC, (m, n, k, - q.fortran_vec (), q.rows (), - r.fortran_vec (), r.rows (), - i + 1, j + 1, w)); -} - -#endif + if (m > 0) + { + octave_idx_type k = q.columns (); + // workspace query. + Complex clwork; + F77_XFCN (zungqr, ZUNGQR, (m, k, min_mn, F77_DBLE_CMPLX_ARG (q.fortran_vec ()), m, F77_DBLE_CMPLX_ARG (tau), + F77_DBLE_CMPLX_ARG (&clwork), -1, info)); -template <> -void -qr<ComplexMatrix>::form (octave_idx_type n, ComplexMatrix& afact, - Complex *tau, type qr_type) -{ - octave_idx_type m = afact.rows (); - octave_idx_type min_mn = std::min (m, n); - octave_idx_type info; - - if (qr_type == qr<ComplexMatrix>::raw) - { - for (octave_idx_type j = 0; j < min_mn; j++) - { - octave_idx_type limit = j < min_mn - 1 ? j : min_mn - 1; - for (octave_idx_type i = limit + 1; i < m; i++) - afact.elem (i, j) *= tau[j]; + // allocate buffer and do the job. + octave_idx_type lwork = clwork.real (); + lwork = std::max (lwork, static_cast<octave_idx_type> (1)); + OCTAVE_LOCAL_BUFFER (Complex, work, lwork); + F77_XFCN (zungqr, ZUNGQR, (m, k, min_mn, F77_DBLE_CMPLX_ARG (q.fortran_vec ()), m, F77_DBLE_CMPLX_ARG (tau), + F77_DBLE_CMPLX_ARG (work), lwork, info)); + } } - - r = afact; } - else + + template <> + void + qr<ComplexMatrix>::init (const ComplexMatrix& a, type qr_type) { - // Attempt to minimize copying. - if (m >= n) - { - // afact will become q. - q = afact; - octave_idx_type k = qr_type == qr<ComplexMatrix>::economy ? n : m; - r = ComplexMatrix (k, n); - for (octave_idx_type j = 0; j < n; j++) - { - octave_idx_type i = 0; - for (; i <= j; i++) - r.xelem (i, j) = afact.xelem (i, j); - for (; i < k; i++) - r.xelem (i, j) = 0; - } - afact = ComplexMatrix (); // optimize memory - } - else - { - // afact will become r. - q = ComplexMatrix (m, m); - for (octave_idx_type j = 0; j < m; j++) - for (octave_idx_type i = j + 1; i < m; i++) - { - q.xelem (i, j) = afact.xelem (i, j); - afact.xelem (i, j) = 0; - } - r = afact; - } + octave_idx_type m = a.rows (); + octave_idx_type n = a.cols (); + + octave_idx_type min_mn = m < n ? m : n; + OCTAVE_LOCAL_BUFFER (Complex, tau, min_mn); + + octave_idx_type info = 0; + + ComplexMatrix afact = a; + if (m > n && qr_type == qr<ComplexMatrix>::std) + afact.resize (m, m); if (m > 0) { - octave_idx_type k = q.columns (); // workspace query. Complex clwork; - F77_XFCN (zungqr, ZUNGQR, (m, k, min_mn, F77_DBLE_CMPLX_ARG (q.fortran_vec ()), m, F77_DBLE_CMPLX_ARG (tau), + F77_XFCN (zgeqrf, ZGEQRF, (m, n, F77_DBLE_CMPLX_ARG (afact.fortran_vec ()), m, F77_DBLE_CMPLX_ARG (tau), F77_DBLE_CMPLX_ARG (&clwork), -1, info)); // allocate buffer and do the job. octave_idx_type lwork = clwork.real (); lwork = std::max (lwork, static_cast<octave_idx_type> (1)); OCTAVE_LOCAL_BUFFER (Complex, work, lwork); - F77_XFCN (zungqr, ZUNGQR, (m, k, min_mn, F77_DBLE_CMPLX_ARG (q.fortran_vec ()), m, F77_DBLE_CMPLX_ARG (tau), + F77_XFCN (zgeqrf, ZGEQRF, (m, n, F77_DBLE_CMPLX_ARG (afact.fortran_vec ()), m, F77_DBLE_CMPLX_ARG (tau), F77_DBLE_CMPLX_ARG (work), lwork, info)); } + + form (n, afact, tau, qr_type); } -} - -template <> -void -qr<ComplexMatrix>::init (const ComplexMatrix& a, type qr_type) -{ - octave_idx_type m = a.rows (); - octave_idx_type n = a.cols (); - - octave_idx_type min_mn = m < n ? m : n; - OCTAVE_LOCAL_BUFFER (Complex, tau, min_mn); - - octave_idx_type info = 0; - - ComplexMatrix afact = a; - if (m > n && qr_type == qr<ComplexMatrix>::std) - afact.resize (m, m); - - if (m > 0) - { - // workspace query. - Complex clwork; - F77_XFCN (zgeqrf, ZGEQRF, (m, n, F77_DBLE_CMPLX_ARG (afact.fortran_vec ()), m, F77_DBLE_CMPLX_ARG (tau), - F77_DBLE_CMPLX_ARG (&clwork), -1, info)); - - // allocate buffer and do the job. - octave_idx_type lwork = clwork.real (); - lwork = std::max (lwork, static_cast<octave_idx_type> (1)); - OCTAVE_LOCAL_BUFFER (Complex, work, lwork); - F77_XFCN (zgeqrf, ZGEQRF, (m, n, F77_DBLE_CMPLX_ARG (afact.fortran_vec ()), m, F77_DBLE_CMPLX_ARG (tau), - F77_DBLE_CMPLX_ARG (work), lwork, info)); - } - - form (n, afact, tau, qr_type); -} #if defined (HAVE_QRUPDATE) -template <> -void -qr<ComplexMatrix>::update (const ComplexColumnVector& u, const ComplexColumnVector& v) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); - - if (u.numel () != m || v.numel () != n) - (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); + template <> + void + qr<ComplexMatrix>::update (const ComplexColumnVector& u, const ComplexColumnVector& v) + { + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); - ComplexColumnVector utmp = u; - ComplexColumnVector vtmp = v; - OCTAVE_LOCAL_BUFFER (Complex, w, k); - OCTAVE_LOCAL_BUFFER (double, rw, k); - F77_XFCN (zqr1up, ZQR1UP, (m, n, k, F77_DBLE_CMPLX_ARG (q.fortran_vec ()), - m, F77_DBLE_CMPLX_ARG (r.fortran_vec ()), k, - F77_DBLE_CMPLX_ARG (utmp.fortran_vec ()), F77_DBLE_CMPLX_ARG (vtmp.fortran_vec ()), - F77_DBLE_CMPLX_ARG (w), rw)); -} + if (u.numel () != m || v.numel () != n) + (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); -template <> -void -qr<ComplexMatrix>::update (const ComplexMatrix& u, const ComplexMatrix& v) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); - - if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) - (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); - - OCTAVE_LOCAL_BUFFER (Complex, w, k); - OCTAVE_LOCAL_BUFFER (double, rw, k); - for (volatile octave_idx_type i = 0; i < u.cols (); i++) - { - ComplexColumnVector utmp = u.column (i); - ComplexColumnVector vtmp = v.column (i); + ComplexColumnVector utmp = u; + ComplexColumnVector vtmp = v; + OCTAVE_LOCAL_BUFFER (Complex, w, k); + OCTAVE_LOCAL_BUFFER (double, rw, k); F77_XFCN (zqr1up, ZQR1UP, (m, n, k, F77_DBLE_CMPLX_ARG (q.fortran_vec ()), m, F77_DBLE_CMPLX_ARG (r.fortran_vec ()), k, F77_DBLE_CMPLX_ARG (utmp.fortran_vec ()), F77_DBLE_CMPLX_ARG (vtmp.fortran_vec ()), F77_DBLE_CMPLX_ARG (w), rw)); } -} + + template <> + void + qr<ComplexMatrix>::update (const ComplexMatrix& u, const ComplexMatrix& v) + { + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); + + if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) + (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); -template <> -void -qr<ComplexMatrix>::insert_col (const ComplexColumnVector& u, octave_idx_type j) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); + OCTAVE_LOCAL_BUFFER (Complex, w, k); + OCTAVE_LOCAL_BUFFER (double, rw, k); + for (volatile octave_idx_type i = 0; i < u.cols (); i++) + { + ComplexColumnVector utmp = u.column (i); + ComplexColumnVector vtmp = v.column (i); + F77_XFCN (zqr1up, ZQR1UP, (m, n, k, F77_DBLE_CMPLX_ARG (q.fortran_vec ()), + m, F77_DBLE_CMPLX_ARG (r.fortran_vec ()), k, + F77_DBLE_CMPLX_ARG (utmp.fortran_vec ()), F77_DBLE_CMPLX_ARG (vtmp.fortran_vec ()), + F77_DBLE_CMPLX_ARG (w), rw)); + } + } - if (u.numel () != m) - (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); - if (j < 0 || j > n) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); - - if (k < m) + template <> + void + qr<ComplexMatrix>::insert_col (const ComplexColumnVector& u, octave_idx_type j) { - q.resize (m, k+1); - r.resize (k+1, n+1); - } - else - { - r.resize (k, n+1); + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); + + if (u.numel () != m) + (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); + if (j < 0 || j > n) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); + + if (k < m) + { + q.resize (m, k+1); + r.resize (k+1, n+1); + } + else + { + r.resize (k, n+1); + } + + ComplexColumnVector utmp = u; + OCTAVE_LOCAL_BUFFER (double, rw, k); + F77_XFCN (zqrinc, ZQRINC, (m, n, k, F77_DBLE_CMPLX_ARG (q.fortran_vec ()), q.rows (), + F77_DBLE_CMPLX_ARG (r.fortran_vec ()), r.rows (), j + 1, + F77_CONST_DBLE_CMPLX_ARG (utmp.data ()), rw)); } - ComplexColumnVector utmp = u; - OCTAVE_LOCAL_BUFFER (double, rw, k); - F77_XFCN (zqrinc, ZQRINC, (m, n, k, F77_DBLE_CMPLX_ARG (q.fortran_vec ()), q.rows (), - F77_DBLE_CMPLX_ARG (r.fortran_vec ()), r.rows (), j + 1, - F77_CONST_DBLE_CMPLX_ARG (utmp.data ()), rw)); -} + template <> + void + qr<ComplexMatrix>::insert_col (const ComplexMatrix& u, const Array<octave_idx_type>& j) + { + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); -template <> -void -qr<ComplexMatrix>::insert_col (const ComplexMatrix& u, const Array<octave_idx_type>& j) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); + Array<octave_idx_type> jsi; + Array<octave_idx_type> js = j.sort (jsi, 0, ASCENDING); + octave_idx_type nj = js.numel (); + bool dups = false; + for (octave_idx_type i = 0; i < nj - 1; i++) + dups = dups && js(i) == js(i+1); + + if (dups) + (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); + if (u.numel () != m || u.columns () != nj) + (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); + if (nj > 0 && (js(0) < 0 || js(nj-1) > n)) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); - Array<octave_idx_type> jsi; - Array<octave_idx_type> js = j.sort (jsi, 0, ASCENDING); - octave_idx_type nj = js.numel (); - bool dups = false; - for (octave_idx_type i = 0; i < nj - 1; i++) - dups = dups && js(i) == js(i+1); + if (nj > 0) + { + octave_idx_type kmax = std::min (k + nj, m); + if (k < m) + { + q.resize (m, kmax); + r.resize (kmax, n + nj); + } + else + { + r.resize (k, n + nj); + } - if (dups) - (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); - if (u.numel () != m || u.columns () != nj) - (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); - if (nj > 0 && (js(0) < 0 || js(nj-1) > n)) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); + OCTAVE_LOCAL_BUFFER (double, rw, kmax); + for (volatile octave_idx_type i = 0; i < js.numel (); i++) + { + octave_idx_type ii = i; + ComplexColumnVector utmp = u.column (jsi(i)); + F77_XFCN (zqrinc, ZQRINC, (m, n + ii, std::min (kmax, k + ii), + F77_DBLE_CMPLX_ARG (q.fortran_vec ()), q.rows (), + F77_DBLE_CMPLX_ARG (r.fortran_vec ()), r.rows (), js(ii) + 1, + F77_CONST_DBLE_CMPLX_ARG (utmp.data ()), rw)); + } + } + } - if (nj > 0) + template <> + void + qr<ComplexMatrix>::delete_col (octave_idx_type j) { - octave_idx_type kmax = std::min (k + nj, m); + octave_idx_type m = q.rows (); + octave_idx_type k = r.rows (); + octave_idx_type n = r.columns (); + + if (j < 0 || j > n-1) + (*current_liboctave_error_handler) ("qrdelete: index out of range"); + + OCTAVE_LOCAL_BUFFER (double, rw, k); + F77_XFCN (zqrdec, ZQRDEC, (m, n, k, F77_DBLE_CMPLX_ARG (q.fortran_vec ()), q.rows (), + F77_DBLE_CMPLX_ARG (r.fortran_vec ()), r.rows (), j + 1, rw)); + if (k < m) { - q.resize (m, kmax); - r.resize (kmax, n + nj); + q.resize (m, k-1); + r.resize (k-1, n-1); } else { - r.resize (k, n + nj); + r.resize (k, n-1); } + } + + template <> + void + qr<ComplexMatrix>::delete_col (const Array<octave_idx_type>& j) + { + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); - OCTAVE_LOCAL_BUFFER (double, rw, kmax); - for (volatile octave_idx_type i = 0; i < js.numel (); i++) + Array<octave_idx_type> jsi; + Array<octave_idx_type> js = j.sort (jsi, 0, DESCENDING); + octave_idx_type nj = js.numel (); + bool dups = false; + for (octave_idx_type i = 0; i < nj - 1; i++) + dups = dups && js(i) == js(i+1); + + if (dups) + (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); + if (nj > 0 && (js(0) > n-1 || js(nj-1) < 0)) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); + + if (nj > 0) { - octave_idx_type ii = i; - ComplexColumnVector utmp = u.column (jsi(i)); - F77_XFCN (zqrinc, ZQRINC, (m, n + ii, std::min (kmax, k + ii), - F77_DBLE_CMPLX_ARG (q.fortran_vec ()), q.rows (), - F77_DBLE_CMPLX_ARG (r.fortran_vec ()), r.rows (), js(ii) + 1, - F77_CONST_DBLE_CMPLX_ARG (utmp.data ()), rw)); + OCTAVE_LOCAL_BUFFER (double, rw, k); + for (volatile octave_idx_type i = 0; i < js.numel (); i++) + { + octave_idx_type ii = i; + F77_XFCN (zqrdec, ZQRDEC, (m, n - ii, k == m ? k : k - ii, + F77_DBLE_CMPLX_ARG (q.fortran_vec ()), q.rows (), + F77_DBLE_CMPLX_ARG (r.fortran_vec ()), r.rows (), + js(ii) + 1, rw)); + } + if (k < m) + { + q.resize (m, k - nj); + r.resize (k - nj, n - nj); + } + else + { + r.resize (k, n - nj); + } + } } -} -template <> -void -qr<ComplexMatrix>::delete_col (octave_idx_type j) -{ - octave_idx_type m = q.rows (); - octave_idx_type k = r.rows (); - octave_idx_type n = r.columns (); + template <> + void + qr<ComplexMatrix>::insert_row (const ComplexRowVector& u, octave_idx_type j) + { + octave_idx_type m = r.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = std::min (m, n); - if (j < 0 || j > n-1) - (*current_liboctave_error_handler) ("qrdelete: index out of range"); + if (! q.is_square () || u.numel () != n) + (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); + if (j < 0 || j > m) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); - OCTAVE_LOCAL_BUFFER (double, rw, k); - F77_XFCN (zqrdec, ZQRDEC, (m, n, k, F77_DBLE_CMPLX_ARG (q.fortran_vec ()), q.rows (), - F77_DBLE_CMPLX_ARG (r.fortran_vec ()), r.rows (), j + 1, rw)); + q.resize (m + 1, m + 1); + r.resize (m + 1, n); + ComplexRowVector utmp = u; + OCTAVE_LOCAL_BUFFER (double, rw, k); + F77_XFCN (zqrinr, ZQRINR, (m, n, F77_DBLE_CMPLX_ARG (q.fortran_vec ()), q.rows (), + F77_DBLE_CMPLX_ARG (r.fortran_vec ()), r.rows (), + j + 1, F77_DBLE_CMPLX_ARG (utmp.fortran_vec ()), rw)); - if (k < m) + } + + template <> + void + qr<ComplexMatrix>::delete_row (octave_idx_type j) { - q.resize (m, k-1); - r.resize (k-1, n-1); - } - else - { - r.resize (k, n-1); - } -} + octave_idx_type m = r.rows (); + octave_idx_type n = r.columns (); + + if (! q.is_square ()) + (*current_liboctave_error_handler) ("qrdelete: dimensions mismatch"); + if (j < 0 || j > m-1) + (*current_liboctave_error_handler) ("qrdelete: index out of range"); + + OCTAVE_LOCAL_BUFFER (Complex, w, m); + OCTAVE_LOCAL_BUFFER (double, rw, m); + F77_XFCN (zqrder, ZQRDER, (m, n, F77_DBLE_CMPLX_ARG (q.fortran_vec ()), q.rows (), + F77_DBLE_CMPLX_ARG (r.fortran_vec ()), r.rows (), j + 1, + F77_DBLE_CMPLX_ARG (w), rw)); -template <> -void -qr<ComplexMatrix>::delete_col (const Array<octave_idx_type>& j) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); + q.resize (m - 1, m - 1); + r.resize (m - 1, n); + } - Array<octave_idx_type> jsi; - Array<octave_idx_type> js = j.sort (jsi, 0, DESCENDING); - octave_idx_type nj = js.numel (); - bool dups = false; - for (octave_idx_type i = 0; i < nj - 1; i++) - dups = dups && js(i) == js(i+1); + template <> + void + qr<ComplexMatrix>::shift_cols (octave_idx_type i, octave_idx_type j) + { + octave_idx_type m = q.rows (); + octave_idx_type k = r.rows (); + octave_idx_type n = r.columns (); + + if (i < 0 || i > n-1 || j < 0 || j > n-1) + (*current_liboctave_error_handler) ("qrshift: index out of range"); - if (dups) - (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); - if (nj > 0 && (js(0) > n-1 || js(nj-1) < 0)) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); + OCTAVE_LOCAL_BUFFER (Complex, w, k); + OCTAVE_LOCAL_BUFFER (double, rw, k); + F77_XFCN (zqrshc, ZQRSHC, (m, n, k, + F77_DBLE_CMPLX_ARG (q.fortran_vec ()), q.rows (), + F77_DBLE_CMPLX_ARG (r.fortran_vec ()), r.rows (), + i + 1, j + 1, F77_DBLE_CMPLX_ARG (w), rw)); + } + +#endif - if (nj > 0) + template <> + void + qr<FloatComplexMatrix>::form (octave_idx_type n, FloatComplexMatrix& afact, FloatComplex *tau, type qr_type) { - OCTAVE_LOCAL_BUFFER (double, rw, k); - for (volatile octave_idx_type i = 0; i < js.numel (); i++) + octave_idx_type m = afact.rows (); + octave_idx_type min_mn = std::min (m, n); + octave_idx_type info; + + if (qr_type == qr<FloatComplexMatrix>::raw) { - octave_idx_type ii = i; - F77_XFCN (zqrdec, ZQRDEC, (m, n - ii, k == m ? k : k - ii, - F77_DBLE_CMPLX_ARG (q.fortran_vec ()), q.rows (), - F77_DBLE_CMPLX_ARG (r.fortran_vec ()), r.rows (), - js(ii) + 1, rw)); - } - if (k < m) - { - q.resize (m, k - nj); - r.resize (k - nj, n - nj); + for (octave_idx_type j = 0; j < min_mn; j++) + { + octave_idx_type limit = j < min_mn - 1 ? j : min_mn - 1; + for (octave_idx_type i = limit + 1; i < m; i++) + afact.elem (i, j) *= tau[j]; + } + + r = afact; } else { - r.resize (k, n - nj); - } - - } -} - -template <> -void -qr<ComplexMatrix>::insert_row (const ComplexRowVector& u, octave_idx_type j) -{ - octave_idx_type m = r.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = std::min (m, n); - - if (! q.is_square () || u.numel () != n) - (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); - if (j < 0 || j > m) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); - - q.resize (m + 1, m + 1); - r.resize (m + 1, n); - ComplexRowVector utmp = u; - OCTAVE_LOCAL_BUFFER (double, rw, k); - F77_XFCN (zqrinr, ZQRINR, (m, n, F77_DBLE_CMPLX_ARG (q.fortran_vec ()), q.rows (), - F77_DBLE_CMPLX_ARG (r.fortran_vec ()), r.rows (), - j + 1, F77_DBLE_CMPLX_ARG (utmp.fortran_vec ()), rw)); - -} - -template <> -void -qr<ComplexMatrix>::delete_row (octave_idx_type j) -{ - octave_idx_type m = r.rows (); - octave_idx_type n = r.columns (); - - if (! q.is_square ()) - (*current_liboctave_error_handler) ("qrdelete: dimensions mismatch"); - if (j < 0 || j > m-1) - (*current_liboctave_error_handler) ("qrdelete: index out of range"); - - OCTAVE_LOCAL_BUFFER (Complex, w, m); - OCTAVE_LOCAL_BUFFER (double, rw, m); - F77_XFCN (zqrder, ZQRDER, (m, n, F77_DBLE_CMPLX_ARG (q.fortran_vec ()), q.rows (), - F77_DBLE_CMPLX_ARG (r.fortran_vec ()), r.rows (), j + 1, - F77_DBLE_CMPLX_ARG (w), rw)); - - q.resize (m - 1, m - 1); - r.resize (m - 1, n); -} - -template <> -void -qr<ComplexMatrix>::shift_cols (octave_idx_type i, octave_idx_type j) -{ - octave_idx_type m = q.rows (); - octave_idx_type k = r.rows (); - octave_idx_type n = r.columns (); + // Attempt to minimize copying. + if (m >= n) + { + // afact will become q. + q = afact; + octave_idx_type k = qr_type == qr<FloatComplexMatrix>::economy ? n : m; + r = FloatComplexMatrix (k, n); + for (octave_idx_type j = 0; j < n; j++) + { + octave_idx_type i = 0; + for (; i <= j; i++) + r.xelem (i, j) = afact.xelem (i, j); + for (; i < k; i++) + r.xelem (i, j) = 0; + } + afact = FloatComplexMatrix (); // optimize memory + } + else + { + // afact will become r. + q = FloatComplexMatrix (m, m); + for (octave_idx_type j = 0; j < m; j++) + for (octave_idx_type i = j + 1; i < m; i++) + { + q.xelem (i, j) = afact.xelem (i, j); + afact.xelem (i, j) = 0; + } + r = afact; + } - if (i < 0 || i > n-1 || j < 0 || j > n-1) - (*current_liboctave_error_handler) ("qrshift: index out of range"); - - OCTAVE_LOCAL_BUFFER (Complex, w, k); - OCTAVE_LOCAL_BUFFER (double, rw, k); - F77_XFCN (zqrshc, ZQRSHC, (m, n, k, - F77_DBLE_CMPLX_ARG (q.fortran_vec ()), q.rows (), - F77_DBLE_CMPLX_ARG (r.fortran_vec ()), r.rows (), - i + 1, j + 1, F77_DBLE_CMPLX_ARG (w), rw)); -} - -#endif + if (m > 0) + { + octave_idx_type k = q.columns (); + // workspace query. + FloatComplex clwork; + F77_XFCN (cungqr, CUNGQR, (m, k, min_mn, F77_CMPLX_ARG (q.fortran_vec ()), m, F77_CMPLX_ARG (tau), + F77_CMPLX_ARG (&clwork), -1, info)); -template <> -void -qr<FloatComplexMatrix>::form (octave_idx_type n, FloatComplexMatrix& afact, FloatComplex *tau, type qr_type) -{ - octave_idx_type m = afact.rows (); - octave_idx_type min_mn = std::min (m, n); - octave_idx_type info; - - if (qr_type == qr<FloatComplexMatrix>::raw) - { - for (octave_idx_type j = 0; j < min_mn; j++) - { - octave_idx_type limit = j < min_mn - 1 ? j : min_mn - 1; - for (octave_idx_type i = limit + 1; i < m; i++) - afact.elem (i, j) *= tau[j]; + // allocate buffer and do the job. + octave_idx_type lwork = clwork.real (); + lwork = std::max (lwork, static_cast<octave_idx_type> (1)); + OCTAVE_LOCAL_BUFFER (FloatComplex, work, lwork); + F77_XFCN (cungqr, CUNGQR, (m, k, min_mn, F77_CMPLX_ARG (q.fortran_vec ()), m, F77_CMPLX_ARG (tau), + F77_CMPLX_ARG (work), lwork, info)); + } } - - r = afact; } - else + + template <> + void + qr<FloatComplexMatrix>::init (const FloatComplexMatrix& a, type qr_type) { - // Attempt to minimize copying. - if (m >= n) - { - // afact will become q. - q = afact; - octave_idx_type k = qr_type == qr<FloatComplexMatrix>::economy ? n : m; - r = FloatComplexMatrix (k, n); - for (octave_idx_type j = 0; j < n; j++) - { - octave_idx_type i = 0; - for (; i <= j; i++) - r.xelem (i, j) = afact.xelem (i, j); - for (; i < k; i++) - r.xelem (i, j) = 0; - } - afact = FloatComplexMatrix (); // optimize memory - } - else - { - // afact will become r. - q = FloatComplexMatrix (m, m); - for (octave_idx_type j = 0; j < m; j++) - for (octave_idx_type i = j + 1; i < m; i++) - { - q.xelem (i, j) = afact.xelem (i, j); - afact.xelem (i, j) = 0; - } - r = afact; - } + octave_idx_type m = a.rows (); + octave_idx_type n = a.cols (); + + octave_idx_type min_mn = m < n ? m : n; + OCTAVE_LOCAL_BUFFER (FloatComplex, tau, min_mn); + + octave_idx_type info = 0; + + FloatComplexMatrix afact = a; + if (m > n && qr_type == qr<FloatComplexMatrix>::std) + afact.resize (m, m); if (m > 0) { - octave_idx_type k = q.columns (); // workspace query. FloatComplex clwork; - F77_XFCN (cungqr, CUNGQR, (m, k, min_mn, F77_CMPLX_ARG (q.fortran_vec ()), m, F77_CMPLX_ARG (tau), + F77_XFCN (cgeqrf, CGEQRF, (m, n, F77_CMPLX_ARG (afact.fortran_vec ()), m, F77_CMPLX_ARG (tau), F77_CMPLX_ARG (&clwork), -1, info)); // allocate buffer and do the job. octave_idx_type lwork = clwork.real (); lwork = std::max (lwork, static_cast<octave_idx_type> (1)); OCTAVE_LOCAL_BUFFER (FloatComplex, work, lwork); - F77_XFCN (cungqr, CUNGQR, (m, k, min_mn, F77_CMPLX_ARG (q.fortran_vec ()), m, F77_CMPLX_ARG (tau), + F77_XFCN (cgeqrf, CGEQRF, (m, n, F77_CMPLX_ARG (afact.fortran_vec ()), m, F77_CMPLX_ARG (tau), F77_CMPLX_ARG (work), lwork, info)); } + + form (n, afact, tau, qr_type); } -} - -template <> -void -qr<FloatComplexMatrix>::init (const FloatComplexMatrix& a, type qr_type) -{ - octave_idx_type m = a.rows (); - octave_idx_type n = a.cols (); - - octave_idx_type min_mn = m < n ? m : n; - OCTAVE_LOCAL_BUFFER (FloatComplex, tau, min_mn); - - octave_idx_type info = 0; - - FloatComplexMatrix afact = a; - if (m > n && qr_type == qr<FloatComplexMatrix>::std) - afact.resize (m, m); - - if (m > 0) - { - // workspace query. - FloatComplex clwork; - F77_XFCN (cgeqrf, CGEQRF, (m, n, F77_CMPLX_ARG (afact.fortran_vec ()), m, F77_CMPLX_ARG (tau), - F77_CMPLX_ARG (&clwork), -1, info)); - - // allocate buffer and do the job. - octave_idx_type lwork = clwork.real (); - lwork = std::max (lwork, static_cast<octave_idx_type> (1)); - OCTAVE_LOCAL_BUFFER (FloatComplex, work, lwork); - F77_XFCN (cgeqrf, CGEQRF, (m, n, F77_CMPLX_ARG (afact.fortran_vec ()), m, F77_CMPLX_ARG (tau), - F77_CMPLX_ARG (work), lwork, info)); - } - - form (n, afact, tau, qr_type); -} #if defined (HAVE_QRUPDATE) -template <> -void -qr<FloatComplexMatrix>::update (const FloatComplexColumnVector& u, const FloatComplexColumnVector& v) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); - - if (u.numel () != m || v.numel () != n) - (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); + template <> + void + qr<FloatComplexMatrix>::update (const FloatComplexColumnVector& u, const FloatComplexColumnVector& v) + { + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); - FloatComplexColumnVector utmp = u; - FloatComplexColumnVector vtmp = v; - OCTAVE_LOCAL_BUFFER (FloatComplex, w, k); - OCTAVE_LOCAL_BUFFER (float, rw, k); - F77_XFCN (cqr1up, CQR1UP, (m, n, k, F77_CMPLX_ARG (q.fortran_vec ()), - m, F77_CMPLX_ARG (r.fortran_vec ()), k, - F77_CMPLX_ARG (utmp.fortran_vec ()), F77_CMPLX_ARG (vtmp.fortran_vec ()), - F77_CMPLX_ARG (w), rw)); -} + if (u.numel () != m || v.numel () != n) + (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); -template <> -void -qr<FloatComplexMatrix>::update (const FloatComplexMatrix& u, const FloatComplexMatrix& v) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); - - if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) - (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); - - OCTAVE_LOCAL_BUFFER (FloatComplex, w, k); - OCTAVE_LOCAL_BUFFER (float, rw, k); - for (volatile octave_idx_type i = 0; i < u.cols (); i++) - { - FloatComplexColumnVector utmp = u.column (i); - FloatComplexColumnVector vtmp = v.column (i); + FloatComplexColumnVector utmp = u; + FloatComplexColumnVector vtmp = v; + OCTAVE_LOCAL_BUFFER (FloatComplex, w, k); + OCTAVE_LOCAL_BUFFER (float, rw, k); F77_XFCN (cqr1up, CQR1UP, (m, n, k, F77_CMPLX_ARG (q.fortran_vec ()), m, F77_CMPLX_ARG (r.fortran_vec ()), k, F77_CMPLX_ARG (utmp.fortran_vec ()), F77_CMPLX_ARG (vtmp.fortran_vec ()), F77_CMPLX_ARG (w), rw)); } -} + + template <> + void + qr<FloatComplexMatrix>::update (const FloatComplexMatrix& u, const FloatComplexMatrix& v) + { + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); + + if (u.rows () != m || v.rows () != n || u.cols () != v.cols ()) + (*current_liboctave_error_handler) ("qrupdate: dimensions mismatch"); -template <> -void -qr<FloatComplexMatrix>::insert_col (const FloatComplexColumnVector& u, octave_idx_type j) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); + OCTAVE_LOCAL_BUFFER (FloatComplex, w, k); + OCTAVE_LOCAL_BUFFER (float, rw, k); + for (volatile octave_idx_type i = 0; i < u.cols (); i++) + { + FloatComplexColumnVector utmp = u.column (i); + FloatComplexColumnVector vtmp = v.column (i); + F77_XFCN (cqr1up, CQR1UP, (m, n, k, F77_CMPLX_ARG (q.fortran_vec ()), + m, F77_CMPLX_ARG (r.fortran_vec ()), k, + F77_CMPLX_ARG (utmp.fortran_vec ()), F77_CMPLX_ARG (vtmp.fortran_vec ()), + F77_CMPLX_ARG (w), rw)); + } + } - if (u.numel () != m) - (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); - if (j < 0 || j > n) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); - - if (k < m) + template <> + void + qr<FloatComplexMatrix>::insert_col (const FloatComplexColumnVector& u, octave_idx_type j) { - q.resize (m, k+1); - r.resize (k+1, n+1); - } - else - { - r.resize (k, n+1); + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); + + if (u.numel () != m) + (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); + if (j < 0 || j > n) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); + + if (k < m) + { + q.resize (m, k+1); + r.resize (k+1, n+1); + } + else + { + r.resize (k, n+1); + } + + FloatComplexColumnVector utmp = u; + OCTAVE_LOCAL_BUFFER (float, rw, k); + F77_XFCN (cqrinc, CQRINC, (m, n, k, F77_CMPLX_ARG (q.fortran_vec ()), q.rows (), + F77_CMPLX_ARG (r.fortran_vec ()), r.rows (), j + 1, + F77_CONST_CMPLX_ARG (utmp.data ()), rw)); } - FloatComplexColumnVector utmp = u; - OCTAVE_LOCAL_BUFFER (float, rw, k); - F77_XFCN (cqrinc, CQRINC, (m, n, k, F77_CMPLX_ARG (q.fortran_vec ()), q.rows (), - F77_CMPLX_ARG (r.fortran_vec ()), r.rows (), j + 1, - F77_CONST_CMPLX_ARG (utmp.data ()), rw)); -} + template <> + void + qr<FloatComplexMatrix>::insert_col (const FloatComplexMatrix& u, const Array<octave_idx_type>& j) + { + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); -template <> -void -qr<FloatComplexMatrix>::insert_col (const FloatComplexMatrix& u, const Array<octave_idx_type>& j) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); + Array<octave_idx_type> jsi; + Array<octave_idx_type> js = j.sort (jsi, 0, ASCENDING); + octave_idx_type nj = js.numel (); + bool dups = false; + for (octave_idx_type i = 0; i < nj - 1; i++) + dups = dups && js(i) == js(i+1); + + if (dups) + (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); + if (u.numel () != m || u.columns () != nj) + (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); + if (nj > 0 && (js(0) < 0 || js(nj-1) > n)) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); - Array<octave_idx_type> jsi; - Array<octave_idx_type> js = j.sort (jsi, 0, ASCENDING); - octave_idx_type nj = js.numel (); - bool dups = false; - for (octave_idx_type i = 0; i < nj - 1; i++) - dups = dups && js(i) == js(i+1); + if (nj > 0) + { + octave_idx_type kmax = std::min (k + nj, m); + if (k < m) + { + q.resize (m, kmax); + r.resize (kmax, n + nj); + } + else + { + r.resize (k, n + nj); + } - if (dups) - (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); - if (u.numel () != m || u.columns () != nj) - (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); - if (nj > 0 && (js(0) < 0 || js(nj-1) > n)) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); + OCTAVE_LOCAL_BUFFER (float, rw, kmax); + for (volatile octave_idx_type i = 0; i < js.numel (); i++) + { + octave_idx_type ii = i; + F77_XFCN (cqrinc, CQRINC, (m, n + ii, std::min (kmax, k + ii), + F77_CMPLX_ARG (q.fortran_vec ()), q.rows (), + F77_CMPLX_ARG (r.fortran_vec ()), r.rows (), js(ii) + 1, + F77_CONST_CMPLX_ARG (u.column (jsi(i)).data ()), rw)); + } + } + } - if (nj > 0) + template <> + void + qr<FloatComplexMatrix>::delete_col (octave_idx_type j) { - octave_idx_type kmax = std::min (k + nj, m); + octave_idx_type m = q.rows (); + octave_idx_type k = r.rows (); + octave_idx_type n = r.columns (); + + if (j < 0 || j > n-1) + (*current_liboctave_error_handler) ("qrdelete: index out of range"); + + OCTAVE_LOCAL_BUFFER (float, rw, k); + F77_XFCN (cqrdec, CQRDEC, (m, n, k, F77_CMPLX_ARG (q.fortran_vec ()), q.rows (), + F77_CMPLX_ARG (r.fortran_vec ()), r.rows (), j + 1, rw)); + if (k < m) { - q.resize (m, kmax); - r.resize (kmax, n + nj); + q.resize (m, k-1); + r.resize (k-1, n-1); } else { - r.resize (k, n + nj); + r.resize (k, n-1); } + } + + template <> + void + qr<FloatComplexMatrix>::delete_col (const Array<octave_idx_type>& j) + { + octave_idx_type m = q.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = q.columns (); - OCTAVE_LOCAL_BUFFER (float, rw, kmax); - for (volatile octave_idx_type i = 0; i < js.numel (); i++) + Array<octave_idx_type> jsi; + Array<octave_idx_type> js = j.sort (jsi, 0, DESCENDING); + octave_idx_type nj = js.numel (); + bool dups = false; + for (octave_idx_type i = 0; i < nj - 1; i++) + dups = dups && js(i) == js(i+1); + + if (dups) + (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); + if (nj > 0 && (js(0) > n-1 || js(nj-1) < 0)) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); + + if (nj > 0) { - octave_idx_type ii = i; - F77_XFCN (cqrinc, CQRINC, (m, n + ii, std::min (kmax, k + ii), - F77_CMPLX_ARG (q.fortran_vec ()), q.rows (), - F77_CMPLX_ARG (r.fortran_vec ()), r.rows (), js(ii) + 1, - F77_CONST_CMPLX_ARG (u.column (jsi(i)).data ()), rw)); + OCTAVE_LOCAL_BUFFER (float, rw, k); + for (volatile octave_idx_type i = 0; i < js.numel (); i++) + { + octave_idx_type ii = i; + F77_XFCN (cqrdec, CQRDEC, (m, n - ii, k == m ? k : k - ii, + F77_CMPLX_ARG (q.fortran_vec ()), q.rows (), + F77_CMPLX_ARG (r.fortran_vec ()), r.rows (), + js(ii) + 1, rw)); + } + if (k < m) + { + q.resize (m, k - nj); + r.resize (k - nj, n - nj); + } + else + { + r.resize (k, n - nj); + } + } } -} -template <> -void -qr<FloatComplexMatrix>::delete_col (octave_idx_type j) -{ - octave_idx_type m = q.rows (); - octave_idx_type k = r.rows (); - octave_idx_type n = r.columns (); - - if (j < 0 || j > n-1) - (*current_liboctave_error_handler) ("qrdelete: index out of range"); - - OCTAVE_LOCAL_BUFFER (float, rw, k); - F77_XFCN (cqrdec, CQRDEC, (m, n, k, F77_CMPLX_ARG (q.fortran_vec ()), q.rows (), - F77_CMPLX_ARG (r.fortran_vec ()), r.rows (), j + 1, rw)); - - if (k < m) + template <> + void + qr<FloatComplexMatrix>::insert_row (const FloatComplexRowVector& u, octave_idx_type j) { - q.resize (m, k-1); - r.resize (k-1, n-1); - } - else - { - r.resize (k, n-1); - } -} + octave_idx_type m = r.rows (); + octave_idx_type n = r.columns (); + octave_idx_type k = std::min (m, n); -template <> -void -qr<FloatComplexMatrix>::delete_col (const Array<octave_idx_type>& j) -{ - octave_idx_type m = q.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = q.columns (); - - Array<octave_idx_type> jsi; - Array<octave_idx_type> js = j.sort (jsi, 0, DESCENDING); - octave_idx_type nj = js.numel (); - bool dups = false; - for (octave_idx_type i = 0; i < nj - 1; i++) - dups = dups && js(i) == js(i+1); - - if (dups) - (*current_liboctave_error_handler) ("qrinsert: duplicate index detected"); - if (nj > 0 && (js(0) > n-1 || js(nj-1) < 0)) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); + if (! q.is_square () || u.numel () != n) + (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); + if (j < 0 || j > m) + (*current_liboctave_error_handler) ("qrinsert: index out of range"); - if (nj > 0) - { + q.resize (m + 1, m + 1); + r.resize (m + 1, n); + FloatComplexRowVector utmp = u; OCTAVE_LOCAL_BUFFER (float, rw, k); - for (volatile octave_idx_type i = 0; i < js.numel (); i++) - { - octave_idx_type ii = i; - F77_XFCN (cqrdec, CQRDEC, (m, n - ii, k == m ? k : k - ii, - F77_CMPLX_ARG (q.fortran_vec ()), q.rows (), - F77_CMPLX_ARG (r.fortran_vec ()), r.rows (), - js(ii) + 1, rw)); - } - if (k < m) - { - q.resize (m, k - nj); - r.resize (k - nj, n - nj); - } - else - { - r.resize (k, n - nj); - } + F77_XFCN (cqrinr, CQRINR, (m, n, F77_CMPLX_ARG (q.fortran_vec ()), q.rows (), + F77_CMPLX_ARG (r.fortran_vec ()), r.rows (), + j + 1, F77_CMPLX_ARG (utmp.fortran_vec ()), rw)); } -} -template <> -void -qr<FloatComplexMatrix>::insert_row (const FloatComplexRowVector& u, octave_idx_type j) -{ - octave_idx_type m = r.rows (); - octave_idx_type n = r.columns (); - octave_idx_type k = std::min (m, n); - - if (! q.is_square () || u.numel () != n) - (*current_liboctave_error_handler) ("qrinsert: dimensions mismatch"); - if (j < 0 || j > m) - (*current_liboctave_error_handler) ("qrinsert: index out of range"); + template <> + void + qr<FloatComplexMatrix>::delete_row (octave_idx_type j) + { + octave_idx_type m = r.rows (); + octave_idx_type n = r.columns (); - q.resize (m + 1, m + 1); - r.resize (m + 1, n); - FloatComplexRowVector utmp = u; - OCTAVE_LOCAL_BUFFER (float, rw, k); - F77_XFCN (cqrinr, CQRINR, (m, n, F77_CMPLX_ARG (q.fortran_vec ()), q.rows (), - F77_CMPLX_ARG (r.fortran_vec ()), r.rows (), - j + 1, F77_CMPLX_ARG (utmp.fortran_vec ()), rw)); + if (! q.is_square ()) + (*current_liboctave_error_handler) ("qrdelete: dimensions mismatch"); + if (j < 0 || j > m-1) + (*current_liboctave_error_handler) ("qrdelete: index out of range"); -} - -template <> -void -qr<FloatComplexMatrix>::delete_row (octave_idx_type j) -{ - octave_idx_type m = r.rows (); - octave_idx_type n = r.columns (); + OCTAVE_LOCAL_BUFFER (FloatComplex, w, m); + OCTAVE_LOCAL_BUFFER (float, rw, m); + F77_XFCN (cqrder, CQRDER, (m, n, F77_CMPLX_ARG (q.fortran_vec ()), q.rows (), + F77_CMPLX_ARG (r.fortran_vec ()), r.rows (), j + 1, + F77_CMPLX_ARG (w), rw)); - if (! q.is_square ()) - (*current_liboctave_error_handler) ("qrdelete: dimensions mismatch"); - if (j < 0 || j > m-1) - (*current_liboctave_error_handler) ("qrdelete: index out of range"); - - OCTAVE_LOCAL_BUFFER (FloatComplex, w, m); - OCTAVE_LOCAL_BUFFER (float, rw, m); - F77_XFCN (cqrder, CQRDER, (m, n, F77_CMPLX_ARG (q.fortran_vec ()), q.rows (), - F77_CMPLX_ARG (r.fortran_vec ()), r.rows (), j + 1, - F77_CMPLX_ARG (w), rw)); - - q.resize (m - 1, m - 1); - r.resize (m - 1, n); -} + q.resize (m - 1, m - 1); + r.resize (m - 1, n); + } -template <> -void -qr<FloatComplexMatrix>::shift_cols (octave_idx_type i, octave_idx_type j) -{ - octave_idx_type m = q.rows (); - octave_idx_type k = r.rows (); - octave_idx_type n = r.columns (); + template <> + void + qr<FloatComplexMatrix>::shift_cols (octave_idx_type i, octave_idx_type j) + { + octave_idx_type m = q.rows (); + octave_idx_type k = r.rows (); + octave_idx_type n = r.columns (); - if (i < 0 || i > n-1 || j < 0 || j > n-1) - (*current_liboctave_error_handler) ("qrshift: index out of range"); + if (i < 0 || i > n-1 || j < 0 || j > n-1) + (*current_liboctave_error_handler) ("qrshift: index out of range"); - OCTAVE_LOCAL_BUFFER (FloatComplex, w, k); - OCTAVE_LOCAL_BUFFER (float, rw, k); - F77_XFCN (cqrshc, CQRSHC, (m, n, k, - F77_CMPLX_ARG (q.fortran_vec ()), q.rows (), - F77_CMPLX_ARG (r.fortran_vec ()), r.rows (), - i + 1, j + 1, F77_CMPLX_ARG (w), rw)); -} + OCTAVE_LOCAL_BUFFER (FloatComplex, w, k); + OCTAVE_LOCAL_BUFFER (float, rw, k); + F77_XFCN (cqrshc, CQRSHC, (m, n, k, + F77_CMPLX_ARG (q.fortran_vec ()), q.rows (), + F77_CMPLX_ARG (r.fortran_vec ()), r.rows (), + i + 1, j + 1, F77_CMPLX_ARG (w), rw)); + } #endif -// Instantiations we need. + // Instantiations we need. -template class qr<Matrix>; + template class qr<Matrix>; -template class qr<FloatMatrix>; + template class qr<FloatMatrix>; -template class qr<ComplexMatrix>; + template class qr<ComplexMatrix>; -template class qr<FloatComplexMatrix>; - + template class qr<FloatComplexMatrix>; + } } -}
--- a/liboctave/numeric/qr.h Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/qr.h Wed Aug 17 10:55:38 2016 -0400 @@ -31,90 +31,88 @@ namespace octave { -namespace math -{ - -template <typename T> -class -qr -{ -public: - - typedef typename T::element_type ELT_T; - typedef typename T::row_vector_type RV_T; - typedef typename T::column_vector_type CV_T; - - enum type + namespace math { - std, - raw, - economy - }; + template <typename T> + class + qr + { + public: - qr (void) : q (), r () { } + typedef typename T::element_type ELT_T; + typedef typename T::row_vector_type RV_T; + typedef typename T::column_vector_type CV_T; - qr (const T& a, type qr_type = qr::std) - : q (), r () - { - init (a, qr_type); - } - - qr (const T& q, const T& r); + enum type + { + std, + raw, + economy + }; - qr (const qr& a) : q (a.q), r (a.r) { } + qr (void) : q (), r () { } - qr& operator = (const qr& a) - { - if (this != &a) + qr (const T& a, type qr_type = qr::std) + : q (), r () { - q = a.q; - r = a.r; + init (a, qr_type); } - return *this; - } + qr (const T& q, const T& r); + + qr (const qr& a) : q (a.q), r (a.r) { } - virtual ~qr (void) { } - - T Q (void) const { return q; } - - T R (void) const { return r; } + qr& operator = (const qr& a) + { + if (this != &a) + { + q = a.q; + r = a.r; + } - type get_type (void) const; + return *this; + } - bool regular (void) const; + virtual ~qr (void) { } - void init (const T& a, type qr_type); + T Q (void) const { return q; } - void update (const CV_T& u, const CV_T& v); + T R (void) const { return r; } + + type get_type (void) const; - void update (const T& u, const T& v); + bool regular (void) const; - void insert_col (const CV_T& u, octave_idx_type j); + void init (const T& a, type qr_type); - void insert_col (const T& u, const Array<octave_idx_type>& j); + void update (const CV_T& u, const CV_T& v); - void delete_col (octave_idx_type j); + void update (const T& u, const T& v); - void delete_col (const Array<octave_idx_type>& j); + void insert_col (const CV_T& u, octave_idx_type j); - void insert_row (const RV_T& u, octave_idx_type j); + void insert_col (const T& u, const Array<octave_idx_type>& j); + + void delete_col (octave_idx_type j); - void delete_row (octave_idx_type j); + void delete_col (const Array<octave_idx_type>& j); - void shift_cols (octave_idx_type i, octave_idx_type j); + void insert_row (const RV_T& u, octave_idx_type j); -protected: + void delete_row (octave_idx_type j); - T q; - T r; + void shift_cols (octave_idx_type i, octave_idx_type j); + + protected: - void form (octave_idx_type n, T& afact, ELT_T *tau, type qr_type); -}; + T q; + T r; -extern void warn_qrupdate_once (void); + void form (octave_idx_type n, T& afact, ELT_T *tau, type qr_type); + }; -} + extern void warn_qrupdate_once (void); + } } #endif
--- a/liboctave/numeric/qrp.cc Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/qrp.cc Wed Aug 17 10:55:38 2016 -0400 @@ -40,270 +40,268 @@ namespace octave { -namespace math -{ - -// Specialization. - -template <> -void -qrp<Matrix>::init (const Matrix& a, type qr_type) -{ - assert (qr_type != qr<Matrix>::raw); + namespace math + { + // Specialization. - octave_idx_type m = a.rows (); - octave_idx_type n = a.cols (); - - octave_idx_type min_mn = m < n ? m : n; - OCTAVE_LOCAL_BUFFER (double, tau, min_mn); - - octave_idx_type info = 0; - - Matrix afact = a; - if (m > n && qr_type == qr<Matrix>::std) - afact.resize (m, m); - - MArray<octave_idx_type> jpvt (dim_vector (n, 1), 0); - - if (m > 0) + template <> + void + qrp<Matrix>::init (const Matrix& a, type qr_type) { - // workspace query. - double rlwork; - F77_XFCN (dgeqp3, DGEQP3, (m, n, afact.fortran_vec (), - m, jpvt.fortran_vec (), tau, - &rlwork, -1, info)); + assert (qr_type != qr<Matrix>::raw); + + octave_idx_type m = a.rows (); + octave_idx_type n = a.cols (); + + octave_idx_type min_mn = m < n ? m : n; + OCTAVE_LOCAL_BUFFER (double, tau, min_mn); + + octave_idx_type info = 0; + + Matrix afact = a; + if (m > n && qr_type == qr<Matrix>::std) + afact.resize (m, m); + + MArray<octave_idx_type> jpvt (dim_vector (n, 1), 0); - // allocate buffer and do the job. - octave_idx_type lwork = rlwork; - lwork = std::max (lwork, static_cast<octave_idx_type> (1)); - OCTAVE_LOCAL_BUFFER (double, work, lwork); - F77_XFCN (dgeqp3, DGEQP3, (m, n, afact.fortran_vec (), - m, jpvt.fortran_vec (), tau, - work, lwork, info)); + if (m > 0) + { + // workspace query. + double rlwork; + F77_XFCN (dgeqp3, DGEQP3, (m, n, afact.fortran_vec (), + m, jpvt.fortran_vec (), tau, + &rlwork, -1, info)); + + // allocate buffer and do the job. + octave_idx_type lwork = rlwork; + lwork = std::max (lwork, static_cast<octave_idx_type> (1)); + OCTAVE_LOCAL_BUFFER (double, work, lwork); + F77_XFCN (dgeqp3, DGEQP3, (m, n, afact.fortran_vec (), + m, jpvt.fortran_vec (), tau, + work, lwork, info)); + } + else + for (octave_idx_type i = 0; i < n; i++) jpvt(i) = i+1; + + // Form Permutation matrix (if economy is requested, return the + // indices only!) + + jpvt -= static_cast<octave_idx_type> (1); + p = PermMatrix (jpvt, true); + + form (n, afact, tau, qr_type); } - else - for (octave_idx_type i = 0; i < n; i++) jpvt(i) = i+1; - // Form Permutation matrix (if economy is requested, return the - // indices only!) - - jpvt -= static_cast<octave_idx_type> (1); - p = PermMatrix (jpvt, true); - - form (n, afact, tau, qr_type); -} - -template <> -qrp<Matrix>::qrp (const Matrix& a, type qr_type) - : qr<Matrix> (), p () -{ - init (a, qr_type); -} + template <> + qrp<Matrix>::qrp (const Matrix& a, type qr_type) + : qr<Matrix> (), p () + { + init (a, qr_type); + } -template <> -RowVector -qrp<Matrix>::Pvec (void) const -{ - Array<double> pa (p.col_perm_vec ()); - RowVector pv (MArray<double> (pa) + 1.0); - return pv; -} - -template <> -void -qrp<FloatMatrix>::init (const FloatMatrix& a, type qr_type) -{ - assert (qr_type != qr<FloatMatrix>::raw); + template <> + RowVector + qrp<Matrix>::Pvec (void) const + { + Array<double> pa (p.col_perm_vec ()); + RowVector pv (MArray<double> (pa) + 1.0); + return pv; + } - octave_idx_type m = a.rows (); - octave_idx_type n = a.cols (); - - octave_idx_type min_mn = m < n ? m : n; - OCTAVE_LOCAL_BUFFER (float, tau, min_mn); - - octave_idx_type info = 0; - - FloatMatrix afact = a; - if (m > n && qr_type == qr<FloatMatrix>::std) - afact.resize (m, m); - - MArray<octave_idx_type> jpvt (dim_vector (n, 1), 0); - - if (m > 0) + template <> + void + qrp<FloatMatrix>::init (const FloatMatrix& a, type qr_type) { - // workspace query. - float rlwork; - F77_XFCN (sgeqp3, SGEQP3, (m, n, afact.fortran_vec (), - m, jpvt.fortran_vec (), tau, - &rlwork, -1, info)); + assert (qr_type != qr<FloatMatrix>::raw); + + octave_idx_type m = a.rows (); + octave_idx_type n = a.cols (); + + octave_idx_type min_mn = m < n ? m : n; + OCTAVE_LOCAL_BUFFER (float, tau, min_mn); + + octave_idx_type info = 0; - // allocate buffer and do the job. - octave_idx_type lwork = rlwork; - lwork = std::max (lwork, static_cast<octave_idx_type> (1)); - OCTAVE_LOCAL_BUFFER (float, work, lwork); - F77_XFCN (sgeqp3, SGEQP3, (m, n, afact.fortran_vec (), - m, jpvt.fortran_vec (), tau, - work, lwork, info)); - } - else - for (octave_idx_type i = 0; i < n; i++) jpvt(i) = i+1; + FloatMatrix afact = a; + if (m > n && qr_type == qr<FloatMatrix>::std) + afact.resize (m, m); + + MArray<octave_idx_type> jpvt (dim_vector (n, 1), 0); - // Form Permutation matrix (if economy is requested, return the - // indices only!) + if (m > 0) + { + // workspace query. + float rlwork; + F77_XFCN (sgeqp3, SGEQP3, (m, n, afact.fortran_vec (), + m, jpvt.fortran_vec (), tau, + &rlwork, -1, info)); - jpvt -= static_cast<octave_idx_type> (1); - p = PermMatrix (jpvt, true); + // allocate buffer and do the job. + octave_idx_type lwork = rlwork; + lwork = std::max (lwork, static_cast<octave_idx_type> (1)); + OCTAVE_LOCAL_BUFFER (float, work, lwork); + F77_XFCN (sgeqp3, SGEQP3, (m, n, afact.fortran_vec (), + m, jpvt.fortran_vec (), tau, + work, lwork, info)); + } + else + for (octave_idx_type i = 0; i < n; i++) jpvt(i) = i+1; - form (n, afact, tau, qr_type); -} + // Form Permutation matrix (if economy is requested, return the + // indices only!) + + jpvt -= static_cast<octave_idx_type> (1); + p = PermMatrix (jpvt, true); -template <> -qrp<FloatMatrix>::qrp (const FloatMatrix& a, type qr_type) - : qr<FloatMatrix> (), p () -{ - init (a, qr_type); -} + form (n, afact, tau, qr_type); + } -template <> -FloatRowVector -qrp<FloatMatrix>::Pvec (void) const -{ - Array<float> pa (p.col_perm_vec ()); - FloatRowVector pv (MArray<float> (pa) + 1.0f); - return pv; -} + template <> + qrp<FloatMatrix>::qrp (const FloatMatrix& a, type qr_type) + : qr<FloatMatrix> (), p () + { + init (a, qr_type); + } + + template <> + FloatRowVector + qrp<FloatMatrix>::Pvec (void) const + { + Array<float> pa (p.col_perm_vec ()); + FloatRowVector pv (MArray<float> (pa) + 1.0f); + return pv; + } -template <> -void -qrp<ComplexMatrix>::init (const ComplexMatrix& a, type qr_type) -{ - assert (qr_type != qr<ComplexMatrix>::raw); + template <> + void + qrp<ComplexMatrix>::init (const ComplexMatrix& a, type qr_type) + { + assert (qr_type != qr<ComplexMatrix>::raw); - octave_idx_type m = a.rows (); - octave_idx_type n = a.cols (); + octave_idx_type m = a.rows (); + octave_idx_type n = a.cols (); - octave_idx_type min_mn = m < n ? m : n; - OCTAVE_LOCAL_BUFFER (Complex, tau, min_mn); + octave_idx_type min_mn = m < n ? m : n; + OCTAVE_LOCAL_BUFFER (Complex, tau, min_mn); - octave_idx_type info = 0; + octave_idx_type info = 0; - ComplexMatrix afact = a; - if (m > n && qr_type == qr<ComplexMatrix>::std) - afact.resize (m, m); + ComplexMatrix afact = a; + if (m > n && qr_type == qr<ComplexMatrix>::std) + afact.resize (m, m); - MArray<octave_idx_type> jpvt (dim_vector (n, 1), 0); + MArray<octave_idx_type> jpvt (dim_vector (n, 1), 0); - if (m > 0) - { - OCTAVE_LOCAL_BUFFER (double, rwork, 2*n); + if (m > 0) + { + OCTAVE_LOCAL_BUFFER (double, rwork, 2*n); - // workspace query. - Complex clwork; - F77_XFCN (zgeqp3, ZGEQP3, (m, n, F77_DBLE_CMPLX_ARG (afact.fortran_vec ()), - m, jpvt.fortran_vec (), F77_DBLE_CMPLX_ARG (tau), - F77_DBLE_CMPLX_ARG (&clwork), -1, rwork, info)); + // workspace query. + Complex clwork; + F77_XFCN (zgeqp3, ZGEQP3, (m, n, F77_DBLE_CMPLX_ARG (afact.fortran_vec ()), + m, jpvt.fortran_vec (), F77_DBLE_CMPLX_ARG (tau), + F77_DBLE_CMPLX_ARG (&clwork), -1, rwork, info)); - // allocate buffer and do the job. - octave_idx_type lwork = clwork.real (); - lwork = std::max (lwork, static_cast<octave_idx_type> (1)); - OCTAVE_LOCAL_BUFFER (Complex, work, lwork); - F77_XFCN (zgeqp3, ZGEQP3, (m, n, F77_DBLE_CMPLX_ARG (afact.fortran_vec ()), - m, jpvt.fortran_vec (), F77_DBLE_CMPLX_ARG (tau), - F77_DBLE_CMPLX_ARG (work), lwork, rwork, info)); - } - else - for (octave_idx_type i = 0; i < n; i++) jpvt(i) = i+1; + // allocate buffer and do the job. + octave_idx_type lwork = clwork.real (); + lwork = std::max (lwork, static_cast<octave_idx_type> (1)); + OCTAVE_LOCAL_BUFFER (Complex, work, lwork); + F77_XFCN (zgeqp3, ZGEQP3, (m, n, F77_DBLE_CMPLX_ARG (afact.fortran_vec ()), + m, jpvt.fortran_vec (), F77_DBLE_CMPLX_ARG (tau), + F77_DBLE_CMPLX_ARG (work), lwork, rwork, info)); + } + else + for (octave_idx_type i = 0; i < n; i++) jpvt(i) = i+1; - // Form Permutation matrix (if economy is requested, return the - // indices only!) + // Form Permutation matrix (if economy is requested, return the + // indices only!) - jpvt -= static_cast<octave_idx_type> (1); - p = PermMatrix (jpvt, true); + jpvt -= static_cast<octave_idx_type> (1); + p = PermMatrix (jpvt, true); - form (n, afact, tau, qr_type); -} + form (n, afact, tau, qr_type); + } -template <> -qrp<ComplexMatrix>::qrp (const ComplexMatrix& a, type qr_type) - : qr<ComplexMatrix> (), p () -{ - init (a, qr_type); -} + template <> + qrp<ComplexMatrix>::qrp (const ComplexMatrix& a, type qr_type) + : qr<ComplexMatrix> (), p () + { + init (a, qr_type); + } -template <> -RowVector -qrp<ComplexMatrix>::Pvec (void) const -{ - Array<double> pa (p.col_perm_vec ()); - RowVector pv (MArray<double> (pa) + 1.0); - return pv; -} + template <> + RowVector + qrp<ComplexMatrix>::Pvec (void) const + { + Array<double> pa (p.col_perm_vec ()); + RowVector pv (MArray<double> (pa) + 1.0); + return pv; + } -template <> -void -qrp<FloatComplexMatrix>::init (const FloatComplexMatrix& a, type qr_type) -{ - assert (qr_type != qr<FloatComplexMatrix>::raw); + template <> + void + qrp<FloatComplexMatrix>::init (const FloatComplexMatrix& a, type qr_type) + { + assert (qr_type != qr<FloatComplexMatrix>::raw); - octave_idx_type m = a.rows (); - octave_idx_type n = a.cols (); + octave_idx_type m = a.rows (); + octave_idx_type n = a.cols (); - octave_idx_type min_mn = m < n ? m : n; - OCTAVE_LOCAL_BUFFER (FloatComplex, tau, min_mn); + octave_idx_type min_mn = m < n ? m : n; + OCTAVE_LOCAL_BUFFER (FloatComplex, tau, min_mn); - octave_idx_type info = 0; + octave_idx_type info = 0; - FloatComplexMatrix afact = a; - if (m > n && qr_type == qr<FloatComplexMatrix>::std) - afact.resize (m, m); + FloatComplexMatrix afact = a; + if (m > n && qr_type == qr<FloatComplexMatrix>::std) + afact.resize (m, m); - MArray<octave_idx_type> jpvt (dim_vector (n, 1), 0); + MArray<octave_idx_type> jpvt (dim_vector (n, 1), 0); - if (m > 0) - { - OCTAVE_LOCAL_BUFFER (float, rwork, 2*n); + if (m > 0) + { + OCTAVE_LOCAL_BUFFER (float, rwork, 2*n); - // workspace query. - FloatComplex clwork; - F77_XFCN (cgeqp3, CGEQP3, (m, n, F77_CMPLX_ARG (afact.fortran_vec ()), - m, jpvt.fortran_vec (), F77_CMPLX_ARG (tau), - F77_CMPLX_ARG (&clwork), -1, rwork, info)); + // workspace query. + FloatComplex clwork; + F77_XFCN (cgeqp3, CGEQP3, (m, n, F77_CMPLX_ARG (afact.fortran_vec ()), + m, jpvt.fortran_vec (), F77_CMPLX_ARG (tau), + F77_CMPLX_ARG (&clwork), -1, rwork, info)); - // allocate buffer and do the job. - octave_idx_type lwork = clwork.real (); - lwork = std::max (lwork, static_cast<octave_idx_type> (1)); - OCTAVE_LOCAL_BUFFER (FloatComplex, work, lwork); - F77_XFCN (cgeqp3, CGEQP3, (m, n, F77_CMPLX_ARG (afact.fortran_vec ()), - m, jpvt.fortran_vec (), F77_CMPLX_ARG (tau), - F77_CMPLX_ARG (work), lwork, rwork, info)); + // allocate buffer and do the job. + octave_idx_type lwork = clwork.real (); + lwork = std::max (lwork, static_cast<octave_idx_type> (1)); + OCTAVE_LOCAL_BUFFER (FloatComplex, work, lwork); + F77_XFCN (cgeqp3, CGEQP3, (m, n, F77_CMPLX_ARG (afact.fortran_vec ()), + m, jpvt.fortran_vec (), F77_CMPLX_ARG (tau), + F77_CMPLX_ARG (work), lwork, rwork, info)); + } + else + for (octave_idx_type i = 0; i < n; i++) jpvt(i) = i+1; + + // Form Permutation matrix (if economy is requested, return the + // indices only!) + + jpvt -= static_cast<octave_idx_type> (1); + p = PermMatrix (jpvt, true); + + form (n, afact, tau, qr_type); } - else - for (octave_idx_type i = 0; i < n; i++) jpvt(i) = i+1; + + template <> + qrp<FloatComplexMatrix>::qrp (const FloatComplexMatrix& a, type qr_type) + : qr<FloatComplexMatrix> (), p () + { + init (a, qr_type); + } - // Form Permutation matrix (if economy is requested, return the - // indices only!) - - jpvt -= static_cast<octave_idx_type> (1); - p = PermMatrix (jpvt, true); - - form (n, afact, tau, qr_type); + template <> + FloatRowVector + qrp<FloatComplexMatrix>::Pvec (void) const + { + Array<float> pa (p.col_perm_vec ()); + FloatRowVector pv (MArray<float> (pa) + 1.0f); + return pv; + } + } } - -template <> -qrp<FloatComplexMatrix>::qrp (const FloatComplexMatrix& a, type qr_type) - : qr<FloatComplexMatrix> (), p () -{ - init (a, qr_type); -} - -template <> -FloatRowVector -qrp<FloatComplexMatrix>::Pvec (void) const -{ - Array<float> pa (p.col_perm_vec ()); - FloatRowVector pv (MArray<float> (pa) + 1.0f); - return pv; -} - -} -}
--- a/liboctave/numeric/qrp.h Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/qrp.h Wed Aug 17 10:55:38 2016 -0400 @@ -31,50 +31,48 @@ namespace octave { -namespace math -{ + namespace math + { + template <typename T> + class + qrp : public qr<T> + { + public: -template <typename T> -class -qrp : public qr<T> -{ -public: + typedef typename T::real_row_vector_type RV_T; - typedef typename T::real_row_vector_type RV_T; + typedef typename qr<T>::type type; - typedef typename qr<T>::type type; + qrp (void) : qr<T> (), p () { } - qrp (void) : qr<T> (), p () { } + qrp (const T&, type = qr<T>::std); - qrp (const T&, type = qr<T>::std); - - qrp (const qrp& a) : qr<T> (a), p (a.p) { } + qrp (const qrp& a) : qr<T> (a), p (a.p) { } - qrp& operator = (const qrp& a) - { - if (this != &a) + qrp& operator = (const qrp& a) { - qr<T>::operator = (a); - p = a.p; + if (this != &a) + { + qr<T>::operator = (a); + p = a.p; + } + + return *this; } - return *this; - } + ~qrp (void) { } - ~qrp (void) { } + void init (const T&, type = qr<T>::std); - void init (const T&, type = qr<T>::std); - - PermMatrix P (void) const { return p; } + PermMatrix P (void) const { return p; } - RV_T Pvec (void) const; + RV_T Pvec (void) const; -private: + private: - PermMatrix p; -}; - -} + PermMatrix p; + }; + } } #endif
--- a/liboctave/numeric/schur.cc Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/schur.cc Wed Aug 17 10:55:38 2016 -0400 @@ -34,437 +34,435 @@ namespace octave { -namespace math -{ - -// For real types. + namespace math + { + // For real types. -template <typename T> -static octave_idx_type -select_ana (const T& a, const T&) -{ - return (a < 0.0); -} - -template <typename T> -static octave_idx_type -select_dig (const T& a, const T& b) -{ - return (hypot (a, b) < 1.0); -} - -// For complex types. + template <typename T> + static octave_idx_type + select_ana (const T& a, const T&) + { + return (a < 0.0); + } -template <typename T> -static octave_idx_type -select_ana (const T& a) -{ - return a.real () < 0.0; -} + template <typename T> + static octave_idx_type + select_dig (const T& a, const T& b) + { + return (hypot (a, b) < 1.0); + } -template <typename T> -static octave_idx_type -select_dig (const T& a) -{ - return (abs (a) < 1.0); -} + // For complex types. -template <> -octave_idx_type -schur<Matrix>::init (const Matrix& a, const std::string& ord, bool calc_unitary) -{ - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); + template <typename T> + static octave_idx_type + select_ana (const T& a) + { + return a.real () < 0.0; + } - if (a_nr != a_nc) - (*current_liboctave_error_handler) ("schur: requires square matrix"); - - if (a_nr == 0) + template <typename T> + static octave_idx_type + select_dig (const T& a) { - schur_mat.clear (); - unitary_mat.clear (); - return 0; + return (abs (a) < 1.0); } - // Workspace requirements may need to be fixed if any of the - // following change. + template <> + octave_idx_type + schur<Matrix>::init (const Matrix& a, const std::string& ord, bool calc_unitary) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); + + if (a_nr != a_nc) + (*current_liboctave_error_handler) ("schur: requires square matrix"); - char jobvs; - char sense = 'N'; - char sort = 'N'; + if (a_nr == 0) + { + schur_mat.clear (); + unitary_mat.clear (); + return 0; + } + + // Workspace requirements may need to be fixed if any of the + // following change. - if (calc_unitary) - jobvs = 'V'; - else - jobvs = 'N'; + char jobvs; + char sense = 'N'; + char sort = 'N'; + + if (calc_unitary) + jobvs = 'V'; + else + jobvs = 'N'; - char ord_char = ord.empty () ? 'U' : ord[0]; + char ord_char = ord.empty () ? 'U' : ord[0]; + + if (ord_char == 'A' || ord_char == 'D' || ord_char == 'a' || ord_char == 'd') + sort = 'S'; - if (ord_char == 'A' || ord_char == 'D' || ord_char == 'a' || ord_char == 'd') - sort = 'S'; + volatile double_selector selector = 0; + if (ord_char == 'A' || ord_char == 'a') + selector = select_ana<double>; + else if (ord_char == 'D' || ord_char == 'd') + selector = select_dig<double>; - volatile double_selector selector = 0; - if (ord_char == 'A' || ord_char == 'a') - selector = select_ana<double>; - else if (ord_char == 'D' || ord_char == 'd') - selector = select_dig<double>; + octave_idx_type n = a_nc; + octave_idx_type lwork = 8 * n; + octave_idx_type liwork = 1; + octave_idx_type info; + octave_idx_type sdim; + double rconde; + double rcondv; + + schur_mat = a; + + if (calc_unitary) + unitary_mat.clear (n, n); + + double *s = schur_mat.fortran_vec (); + double *q = unitary_mat.fortran_vec (); + + Array<double> wr (dim_vector (n, 1)); + double *pwr = wr.fortran_vec (); + + Array<double> wi (dim_vector (n, 1)); + double *pwi = wi.fortran_vec (); - octave_idx_type n = a_nc; - octave_idx_type lwork = 8 * n; - octave_idx_type liwork = 1; - octave_idx_type info; - octave_idx_type sdim; - double rconde; - double rcondv; + Array<double> work (dim_vector (lwork, 1)); + double *pwork = work.fortran_vec (); + + // BWORK is not referenced for the non-ordered Schur routine. + octave_idx_type ntmp = (ord_char == 'N' || ord_char == 'n') ? 0 : n; + Array<octave_idx_type> bwork (dim_vector (ntmp, 1)); + octave_idx_type *pbwork = bwork.fortran_vec (); + + Array<octave_idx_type> iwork (dim_vector (liwork, 1)); + octave_idx_type *piwork = iwork.fortran_vec (); - schur_mat = a; - - if (calc_unitary) - unitary_mat.clear (n, n); + F77_XFCN (dgeesx, DGEESX, (F77_CONST_CHAR_ARG2 (&jobvs, 1), + F77_CONST_CHAR_ARG2 (&sort, 1), + selector, + F77_CONST_CHAR_ARG2 (&sense, 1), + n, s, n, sdim, pwr, pwi, q, n, rconde, rcondv, + pwork, lwork, piwork, liwork, pbwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); - double *s = schur_mat.fortran_vec (); - double *q = unitary_mat.fortran_vec (); - - Array<double> wr (dim_vector (n, 1)); - double *pwr = wr.fortran_vec (); + return info; + } - Array<double> wi (dim_vector (n, 1)); - double *pwi = wi.fortran_vec (); + template <> + octave_idx_type + schur<FloatMatrix>::init (const FloatMatrix& a, const std::string& ord, + bool calc_unitary) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); - Array<double> work (dim_vector (lwork, 1)); - double *pwork = work.fortran_vec (); + if (a_nr != a_nc) + (*current_liboctave_error_handler) ("SCHUR requires square matrix"); + + if (a_nr == 0) + { + schur_mat.clear (); + unitary_mat.clear (); + return 0; + } - // BWORK is not referenced for the non-ordered Schur routine. - octave_idx_type ntmp = (ord_char == 'N' || ord_char == 'n') ? 0 : n; - Array<octave_idx_type> bwork (dim_vector (ntmp, 1)); - octave_idx_type *pbwork = bwork.fortran_vec (); + // Workspace requirements may need to be fixed if any of the + // following change. + + char jobvs; + char sense = 'N'; + char sort = 'N'; - Array<octave_idx_type> iwork (dim_vector (liwork, 1)); - octave_idx_type *piwork = iwork.fortran_vec (); + if (calc_unitary) + jobvs = 'V'; + else + jobvs = 'N'; + + char ord_char = ord.empty () ? 'U' : ord[0]; + + if (ord_char == 'A' || ord_char == 'D' || ord_char == 'a' || ord_char == 'd') + sort = 'S'; + + volatile float_selector selector = 0; + if (ord_char == 'A' || ord_char == 'a') + selector = select_ana<float>; + else if (ord_char == 'D' || ord_char == 'd') + selector = select_dig<float>; - F77_XFCN (dgeesx, DGEESX, (F77_CONST_CHAR_ARG2 (&jobvs, 1), - F77_CONST_CHAR_ARG2 (&sort, 1), - selector, - F77_CONST_CHAR_ARG2 (&sense, 1), - n, s, n, sdim, pwr, pwi, q, n, rconde, rcondv, - pwork, lwork, piwork, liwork, pbwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + octave_idx_type n = a_nc; + octave_idx_type lwork = 8 * n; + octave_idx_type liwork = 1; + octave_idx_type info; + octave_idx_type sdim; + float rconde; + float rcondv; + + schur_mat = a; - return info; -} + if (calc_unitary) + unitary_mat.clear (n, n); + + float *s = schur_mat.fortran_vec (); + float *q = unitary_mat.fortran_vec (); + + Array<float> wr (dim_vector (n, 1)); + float *pwr = wr.fortran_vec (); + + Array<float> wi (dim_vector (n, 1)); + float *pwi = wi.fortran_vec (); -template <> -octave_idx_type -schur<FloatMatrix>::init (const FloatMatrix& a, const std::string& ord, - bool calc_unitary) -{ - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); + Array<float> work (dim_vector (lwork, 1)); + float *pwork = work.fortran_vec (); + + // BWORK is not referenced for the non-ordered Schur routine. + octave_idx_type ntmp = (ord_char == 'N' || ord_char == 'n') ? 0 : n; + Array<octave_idx_type> bwork (dim_vector (ntmp, 1)); + octave_idx_type *pbwork = bwork.fortran_vec (); + + Array<octave_idx_type> iwork (dim_vector (liwork, 1)); + octave_idx_type *piwork = iwork.fortran_vec (); - if (a_nr != a_nc) - (*current_liboctave_error_handler) ("SCHUR requires square matrix"); + F77_XFCN (sgeesx, SGEESX, (F77_CONST_CHAR_ARG2 (&jobvs, 1), + F77_CONST_CHAR_ARG2 (&sort, 1), + selector, + F77_CONST_CHAR_ARG2 (&sense, 1), + n, s, n, sdim, pwr, pwi, q, n, rconde, rcondv, + pwork, lwork, piwork, liwork, pbwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); - if (a_nr == 0) - { - schur_mat.clear (); - unitary_mat.clear (); - return 0; + return info; } - // Workspace requirements may need to be fixed if any of the - // following change. + template <> + octave_idx_type + schur<ComplexMatrix>::init (const ComplexMatrix& a, const std::string& ord, + bool calc_unitary) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); - char jobvs; - char sense = 'N'; - char sort = 'N'; + if (a_nr != a_nc) + (*current_liboctave_error_handler) ("SCHUR requires square matrix"); - if (calc_unitary) - jobvs = 'V'; - else - jobvs = 'N'; + if (a_nr == 0) + { + schur_mat.clear (); + unitary_mat.clear (); + return 0; + } - char ord_char = ord.empty () ? 'U' : ord[0]; + // Workspace requirements may need to be fixed if any of the + // following change. - if (ord_char == 'A' || ord_char == 'D' || ord_char == 'a' || ord_char == 'd') - sort = 'S'; + char jobvs; + char sense = 'N'; + char sort = 'N'; - volatile float_selector selector = 0; - if (ord_char == 'A' || ord_char == 'a') - selector = select_ana<float>; - else if (ord_char == 'D' || ord_char == 'd') - selector = select_dig<float>; + if (calc_unitary) + jobvs = 'V'; + else + jobvs = 'N'; + + char ord_char = ord.empty () ? 'U' : ord[0]; + + if (ord_char == 'A' || ord_char == 'D' || ord_char == 'a' || ord_char == 'd') + sort = 'S'; - octave_idx_type n = a_nc; - octave_idx_type lwork = 8 * n; - octave_idx_type liwork = 1; - octave_idx_type info; - octave_idx_type sdim; - float rconde; - float rcondv; + volatile complex_selector selector = 0; + if (ord_char == 'A' || ord_char == 'a') + selector = select_ana<Complex>; + else if (ord_char == 'D' || ord_char == 'd') + selector = select_dig<Complex>; - schur_mat = a; - - if (calc_unitary) - unitary_mat.clear (n, n); + octave_idx_type n = a_nc; + octave_idx_type lwork = 8 * n; + octave_idx_type info; + octave_idx_type sdim; + double rconde; + double rcondv; - float *s = schur_mat.fortran_vec (); - float *q = unitary_mat.fortran_vec (); - - Array<float> wr (dim_vector (n, 1)); - float *pwr = wr.fortran_vec (); + schur_mat = a; + if (calc_unitary) + unitary_mat.clear (n, n); - Array<float> wi (dim_vector (n, 1)); - float *pwi = wi.fortran_vec (); + Complex *s = schur_mat.fortran_vec (); + Complex *q = unitary_mat.fortran_vec (); + + Array<double> rwork (dim_vector (n, 1)); + double *prwork = rwork.fortran_vec (); - Array<float> work (dim_vector (lwork, 1)); - float *pwork = work.fortran_vec (); + Array<Complex> w (dim_vector (n, 1)); + Complex *pw = w.fortran_vec (); + + Array<Complex> work (dim_vector (lwork, 1)); + Complex *pwork = work.fortran_vec (); - // BWORK is not referenced for the non-ordered Schur routine. - octave_idx_type ntmp = (ord_char == 'N' || ord_char == 'n') ? 0 : n; - Array<octave_idx_type> bwork (dim_vector (ntmp, 1)); - octave_idx_type *pbwork = bwork.fortran_vec (); + // BWORK is not referenced for non-ordered Schur. + octave_idx_type ntmp = (ord_char == 'N' || ord_char == 'n') ? 0 : n; + Array<octave_idx_type> bwork (dim_vector (ntmp, 1)); + octave_idx_type *pbwork = bwork.fortran_vec (); - Array<octave_idx_type> iwork (dim_vector (liwork, 1)); - octave_idx_type *piwork = iwork.fortran_vec (); + F77_XFCN (zgeesx, ZGEESX, (F77_CONST_CHAR_ARG2 (&jobvs, 1), + F77_CONST_CHAR_ARG2 (&sort, 1), + selector, + F77_CONST_CHAR_ARG2 (&sense, 1), + n, F77_DBLE_CMPLX_ARG (s), n, sdim, F77_DBLE_CMPLX_ARG (pw), F77_DBLE_CMPLX_ARG (q), n, rconde, rcondv, + F77_DBLE_CMPLX_ARG (pwork), lwork, prwork, pbwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); - F77_XFCN (sgeesx, SGEESX, (F77_CONST_CHAR_ARG2 (&jobvs, 1), - F77_CONST_CHAR_ARG2 (&sort, 1), - selector, - F77_CONST_CHAR_ARG2 (&sense, 1), - n, s, n, sdim, pwr, pwi, q, n, rconde, rcondv, - pwork, lwork, piwork, liwork, pbwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + return info; + } - return info; -} + template <> + schur<ComplexMatrix> + rsf2csf<ComplexMatrix, Matrix> (const Matrix& s_arg, const Matrix& u_arg) + { + ComplexMatrix s (s_arg); + ComplexMatrix u (u_arg); + + octave_idx_type n = s.rows (); -template <> -octave_idx_type -schur<ComplexMatrix>::init (const ComplexMatrix& a, const std::string& ord, - bool calc_unitary) -{ - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); + if (s.columns () != n || u.rows () != n || u.columns () != n) + (*current_liboctave_error_handler) + ("rsf2csf: inconsistent matrix dimensions"); - if (a_nr != a_nc) - (*current_liboctave_error_handler) ("SCHUR requires square matrix"); + if (n > 0) + { + OCTAVE_LOCAL_BUFFER (double, c, n-1); + OCTAVE_LOCAL_BUFFER (double, sx, n-1); - if (a_nr == 0) - { - schur_mat.clear (); - unitary_mat.clear (); - return 0; + F77_XFCN (zrsf2csf, ZRSF2CSF, (n, F77_DBLE_CMPLX_ARG (s.fortran_vec ()), + F77_DBLE_CMPLX_ARG (u.fortran_vec ()), c, sx)); + } + + return schur<ComplexMatrix> (s, u); } - // Workspace requirements may need to be fixed if any of the - // following change. - - char jobvs; - char sense = 'N'; - char sort = 'N'; + template <> + octave_idx_type + schur<FloatComplexMatrix>::init (const FloatComplexMatrix& a, + const std::string& ord, bool calc_unitary) + { + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); - if (calc_unitary) - jobvs = 'V'; - else - jobvs = 'N'; - - char ord_char = ord.empty () ? 'U' : ord[0]; - - if (ord_char == 'A' || ord_char == 'D' || ord_char == 'a' || ord_char == 'd') - sort = 'S'; + if (a_nr != a_nc) + (*current_liboctave_error_handler) ("SCHUR requires square matrix"); - volatile complex_selector selector = 0; - if (ord_char == 'A' || ord_char == 'a') - selector = select_ana<Complex>; - else if (ord_char == 'D' || ord_char == 'd') - selector = select_dig<Complex>; + if (a_nr == 0) + { + schur_mat.clear (); + unitary_mat.clear (); + return 0; + } + + // Workspace requirements may need to be fixed if any of the + // following change. - octave_idx_type n = a_nc; - octave_idx_type lwork = 8 * n; - octave_idx_type info; - octave_idx_type sdim; - double rconde; - double rcondv; + char jobvs; + char sense = 'N'; + char sort = 'N'; - schur_mat = a; - if (calc_unitary) - unitary_mat.clear (n, n); + if (calc_unitary) + jobvs = 'V'; + else + jobvs = 'N'; - Complex *s = schur_mat.fortran_vec (); - Complex *q = unitary_mat.fortran_vec (); + char ord_char = ord.empty () ? 'U' : ord[0]; - Array<double> rwork (dim_vector (n, 1)); - double *prwork = rwork.fortran_vec (); + if (ord_char == 'A' || ord_char == 'D' || ord_char == 'a' || ord_char == 'd') + sort = 'S'; - Array<Complex> w (dim_vector (n, 1)); - Complex *pw = w.fortran_vec (); - - Array<Complex> work (dim_vector (lwork, 1)); - Complex *pwork = work.fortran_vec (); + volatile float_complex_selector selector = 0; + if (ord_char == 'A' || ord_char == 'a') + selector = select_ana<FloatComplex>; + else if (ord_char == 'D' || ord_char == 'd') + selector = select_dig<FloatComplex>; - // BWORK is not referenced for non-ordered Schur. - octave_idx_type ntmp = (ord_char == 'N' || ord_char == 'n') ? 0 : n; - Array<octave_idx_type> bwork (dim_vector (ntmp, 1)); - octave_idx_type *pbwork = bwork.fortran_vec (); + octave_idx_type n = a_nc; + octave_idx_type lwork = 8 * n; + octave_idx_type info; + octave_idx_type sdim; + float rconde; + float rcondv; - F77_XFCN (zgeesx, ZGEESX, (F77_CONST_CHAR_ARG2 (&jobvs, 1), - F77_CONST_CHAR_ARG2 (&sort, 1), - selector, - F77_CONST_CHAR_ARG2 (&sense, 1), - n, F77_DBLE_CMPLX_ARG (s), n, sdim, F77_DBLE_CMPLX_ARG (pw), F77_DBLE_CMPLX_ARG (q), n, rconde, rcondv, - F77_DBLE_CMPLX_ARG (pwork), lwork, prwork, pbwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); + schur_mat = a; + if (calc_unitary) + unitary_mat.clear (n, n); + + FloatComplex *s = schur_mat.fortran_vec (); + FloatComplex *q = unitary_mat.fortran_vec (); + + Array<float> rwork (dim_vector (n, 1)); + float *prwork = rwork.fortran_vec (); - return info; -} + Array<FloatComplex> w (dim_vector (n, 1)); + FloatComplex *pw = w.fortran_vec (); -template <> -schur<ComplexMatrix> -rsf2csf<ComplexMatrix, Matrix> (const Matrix& s_arg, const Matrix& u_arg) -{ - ComplexMatrix s (s_arg); - ComplexMatrix u (u_arg); + Array<FloatComplex> work (dim_vector (lwork, 1)); + FloatComplex *pwork = work.fortran_vec (); - octave_idx_type n = s.rows (); + // BWORK is not referenced for non-ordered Schur. + octave_idx_type ntmp = (ord_char == 'N' || ord_char == 'n') ? 0 : n; + Array<octave_idx_type> bwork (dim_vector (ntmp, 1)); + octave_idx_type *pbwork = bwork.fortran_vec (); - if (s.columns () != n || u.rows () != n || u.columns () != n) - (*current_liboctave_error_handler) - ("rsf2csf: inconsistent matrix dimensions"); + F77_XFCN (cgeesx, CGEESX, (F77_CONST_CHAR_ARG2 (&jobvs, 1), + F77_CONST_CHAR_ARG2 (&sort, 1), + selector, + F77_CONST_CHAR_ARG2 (&sense, 1), + n, F77_CMPLX_ARG (s), n, sdim, F77_CMPLX_ARG (pw), F77_CMPLX_ARG (q), n, rconde, rcondv, + F77_CMPLX_ARG (pwork), lwork, prwork, pbwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); - if (n > 0) - { - OCTAVE_LOCAL_BUFFER (double, c, n-1); - OCTAVE_LOCAL_BUFFER (double, sx, n-1); - - F77_XFCN (zrsf2csf, ZRSF2CSF, (n, F77_DBLE_CMPLX_ARG (s.fortran_vec ()), - F77_DBLE_CMPLX_ARG (u.fortran_vec ()), c, sx)); + return info; } - return schur<ComplexMatrix> (s, u); -} + template <> + schur<FloatComplexMatrix> + rsf2csf<FloatComplexMatrix, FloatMatrix> (const FloatMatrix& s_arg, const FloatMatrix& u_arg) + { + FloatComplexMatrix s (s_arg); + FloatComplexMatrix u (u_arg); + + octave_idx_type n = s.rows (); -template <> -octave_idx_type -schur<FloatComplexMatrix>::init (const FloatComplexMatrix& a, - const std::string& ord, bool calc_unitary) -{ - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); + if (s.columns () != n || u.rows () != n || u.columns () != n) + (*current_liboctave_error_handler) + ("rsf2csf: inconsistent matrix dimensions"); - if (a_nr != a_nc) - (*current_liboctave_error_handler) ("SCHUR requires square matrix"); + if (n > 0) + { + OCTAVE_LOCAL_BUFFER (float, c, n-1); + OCTAVE_LOCAL_BUFFER (float, sx, n-1); - if (a_nr == 0) - { - schur_mat.clear (); - unitary_mat.clear (); - return 0; + F77_XFCN (crsf2csf, CRSF2CSF, (n, F77_CMPLX_ARG (s.fortran_vec ()), + F77_CMPLX_ARG (u.fortran_vec ()), c, sx)); + } + + return schur<FloatComplexMatrix> (s, u); } - // Workspace requirements may need to be fixed if any of the - // following change. - - char jobvs; - char sense = 'N'; - char sort = 'N'; - - if (calc_unitary) - jobvs = 'V'; - else - jobvs = 'N'; - - char ord_char = ord.empty () ? 'U' : ord[0]; - - if (ord_char == 'A' || ord_char == 'D' || ord_char == 'a' || ord_char == 'd') - sort = 'S'; - - volatile float_complex_selector selector = 0; - if (ord_char == 'A' || ord_char == 'a') - selector = select_ana<FloatComplex>; - else if (ord_char == 'D' || ord_char == 'd') - selector = select_dig<FloatComplex>; + // Instantiations we need. - octave_idx_type n = a_nc; - octave_idx_type lwork = 8 * n; - octave_idx_type info; - octave_idx_type sdim; - float rconde; - float rcondv; - - schur_mat = a; - if (calc_unitary) - unitary_mat.clear (n, n); - - FloatComplex *s = schur_mat.fortran_vec (); - FloatComplex *q = unitary_mat.fortran_vec (); + template class schur<ComplexMatrix>; - Array<float> rwork (dim_vector (n, 1)); - float *prwork = rwork.fortran_vec (); - - Array<FloatComplex> w (dim_vector (n, 1)); - FloatComplex *pw = w.fortran_vec (); - - Array<FloatComplex> work (dim_vector (lwork, 1)); - FloatComplex *pwork = work.fortran_vec (); - - // BWORK is not referenced for non-ordered Schur. - octave_idx_type ntmp = (ord_char == 'N' || ord_char == 'n') ? 0 : n; - Array<octave_idx_type> bwork (dim_vector (ntmp, 1)); - octave_idx_type *pbwork = bwork.fortran_vec (); + template class schur<FloatComplexMatrix>; - F77_XFCN (cgeesx, CGEESX, (F77_CONST_CHAR_ARG2 (&jobvs, 1), - F77_CONST_CHAR_ARG2 (&sort, 1), - selector, - F77_CONST_CHAR_ARG2 (&sense, 1), - n, F77_CMPLX_ARG (s), n, sdim, F77_CMPLX_ARG (pw), F77_CMPLX_ARG (q), n, rconde, rcondv, - F77_CMPLX_ARG (pwork), lwork, prwork, pbwork, info - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1) - F77_CHAR_ARG_LEN (1))); - - return info; -} - -template <> -schur<FloatComplexMatrix> -rsf2csf<FloatComplexMatrix, FloatMatrix> (const FloatMatrix& s_arg, const FloatMatrix& u_arg) -{ - FloatComplexMatrix s (s_arg); - FloatComplexMatrix u (u_arg); - - octave_idx_type n = s.rows (); + template class schur<FloatMatrix>; - if (s.columns () != n || u.rows () != n || u.columns () != n) - (*current_liboctave_error_handler) - ("rsf2csf: inconsistent matrix dimensions"); - - if (n > 0) - { - OCTAVE_LOCAL_BUFFER (float, c, n-1); - OCTAVE_LOCAL_BUFFER (float, sx, n-1); - - F77_XFCN (crsf2csf, CRSF2CSF, (n, F77_CMPLX_ARG (s.fortran_vec ()), - F77_CMPLX_ARG (u.fortran_vec ()), c, sx)); - } - - return schur<FloatComplexMatrix> (s, u); + template class schur<Matrix>; + } } - -// Instantiations we need. - -template class schur<ComplexMatrix>; - -template class schur<FloatComplexMatrix>; - -template class schur<FloatMatrix>; - -template class schur<Matrix>; - -} -}
--- a/liboctave/numeric/schur.h Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/schur.h Wed Aug 17 10:55:38 2016 -0400 @@ -34,75 +34,73 @@ namespace octave { -namespace math -{ - -template <typename T> class schur; + namespace math + { + template <typename T> class schur; -template <typename T> -class -schur -{ -public: + template <typename T> + class + schur + { + public: - schur (void) : schur_mat (), unitary_mat () { } - - schur (const T& a, const std::string& ord, bool calc_unitary = true) - : schur_mat (), unitary_mat () - { - init (a, ord, calc_unitary); - } + schur (void) : schur_mat (), unitary_mat () { } - schur (const T& a, const std::string& ord, octave_idx_type& info, - bool calc_unitary = true) - : schur_mat (), unitary_mat () - { - info = init (a, ord, calc_unitary); - } - - // This one should really be protected or private but we need it in - // rsf2csf and I don't see how to make that function a friend of - // this class. - schur (const T& s, const T& u) : schur_mat (s), unitary_mat (u) { } + schur (const T& a, const std::string& ord, bool calc_unitary = true) + : schur_mat (), unitary_mat () + { + init (a, ord, calc_unitary); + } - schur (const schur& a) - - : schur_mat (a.schur_mat), unitary_mat (a.unitary_mat) - { } - - schur& operator = (const schur& a) - { - if (this != &a) + schur (const T& a, const std::string& ord, octave_idx_type& info, + bool calc_unitary = true) + : schur_mat (), unitary_mat () { - schur_mat = a.schur_mat; - unitary_mat = a.unitary_mat; + info = init (a, ord, calc_unitary); } - return *this; - } + // This one should really be protected or private but we need it in + // rsf2csf and I don't see how to make that function a friend of + // this class. + schur (const T& s, const T& u) : schur_mat (s), unitary_mat (u) { } - ~schur (void) { } + schur (const schur& a) + + : schur_mat (a.schur_mat), unitary_mat (a.unitary_mat) + { } - T schur_matrix (void) const { return schur_mat; } - - T unitary_matrix (void) const { return unitary_mat; } + schur& operator = (const schur& a) + { + if (this != &a) + { + schur_mat = a.schur_mat; + unitary_mat = a.unitary_mat; + } -protected: - -private: + return *this; + } - T schur_mat; - T unitary_mat; + ~schur (void) { } + + T schur_matrix (void) const { return schur_mat; } + + T unitary_matrix (void) const { return unitary_mat; } + + protected: + + private: - octave_idx_type - init (const T& a, const std::string& ord, bool calc_unitary); -}; + T schur_mat; + T unitary_mat; -template <typename RT, typename AT> -extern schur<RT> -rsf2csf (const AT& s, const AT& u); + octave_idx_type + init (const T& a, const std::string& ord, bool calc_unitary); + }; -} + template <typename RT, typename AT> + extern schur<RT> + rsf2csf (const AT& s, const AT& u); + } } #endif
--- a/liboctave/numeric/sparse-chol.cc Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/sparse-chol.cc Wed Aug 17 10:55:38 2016 -0400 @@ -36,563 +36,561 @@ namespace octave { -namespace math -{ - -template <typename chol_type> -class sparse_chol<chol_type>::sparse_chol_rep -{ -public: - - sparse_chol_rep (void) - : count (1), is_pd (false), minor_p (0), perms (), cond (0) -#if defined (HAVE_CHOLMOD) - , Lsparse (0), Common () -#endif - { } - - sparse_chol_rep (const chol_type& a, bool natural, bool force) - : count (1), is_pd (false), minor_p (0), perms (), cond (0) -#if defined (HAVE_CHOLMOD) - , Lsparse (0), Common () -#endif + namespace math { - init (a, natural, force); - } + template <typename chol_type> + class sparse_chol<chol_type>::sparse_chol_rep + { + public: - sparse_chol_rep (const chol_type& a, octave_idx_type& info, - bool natural, bool force) - : count (1), is_pd (false), minor_p (0), perms (), cond (0) + sparse_chol_rep (void) + : count (1), is_pd (false), minor_p (0), perms (), cond (0) #if defined (HAVE_CHOLMOD) - , Lsparse (0), Common () + , Lsparse (0), Common () +#endif + { } + + sparse_chol_rep (const chol_type& a, bool natural, bool force) + : count (1), is_pd (false), minor_p (0), perms (), cond (0) +#if defined (HAVE_CHOLMOD) + , Lsparse (0), Common () #endif - { - info = init (a, natural, force); - } + { + init (a, natural, force); + } - ~sparse_chol_rep (void) - { + sparse_chol_rep (const chol_type& a, octave_idx_type& info, + bool natural, bool force) + : count (1), is_pd (false), minor_p (0), perms (), cond (0) #if defined (HAVE_CHOLMOD) - if (Lsparse) - CHOLMOD_NAME (free_sparse) (&Lsparse, &Common); + , Lsparse (0), Common () +#endif + { + info = init (a, natural, force); + } - CHOLMOD_NAME(finish) (&Common); + ~sparse_chol_rep (void) + { +#if defined (HAVE_CHOLMOD) + if (Lsparse) + CHOLMOD_NAME (free_sparse) (&Lsparse, &Common); + + CHOLMOD_NAME(finish) (&Common); #endif - } + } #if defined (HAVE_CHOLMOD) - cholmod_sparse *L (void) const - { - return Lsparse; - } + cholmod_sparse *L (void) const + { + return Lsparse; + } #endif - octave_idx_type P (void) const - { + octave_idx_type P (void) const + { #if defined (HAVE_CHOLMOD) - return (minor_p == static_cast<octave_idx_type>(Lsparse->ncol) ? - 0 : minor_p + 1); + return (minor_p == static_cast<octave_idx_type>(Lsparse->ncol) ? + 0 : minor_p + 1); #else - return 0; + return 0; #endif - } + } - RowVector perm (void) const { return perms + 1; } + RowVector perm (void) const { return perms + 1; } - SparseMatrix Q (void) const; + SparseMatrix Q (void) const; - bool is_positive_definite (void) const { return is_pd; } + bool is_positive_definite (void) const { return is_pd; } - double rcond (void) const { return cond; } + double rcond (void) const { return cond; } - octave_refcount<int> count; + octave_refcount<int> count; -private: + private: - bool is_pd; + bool is_pd; - octave_idx_type minor_p; + octave_idx_type minor_p; - RowVector perms; + RowVector perms; - double cond; + double cond; #if defined (HAVE_CHOLMOD) - cholmod_sparse *Lsparse; + cholmod_sparse *Lsparse; - cholmod_common Common; + cholmod_common Common; - void drop_zeros (const cholmod_sparse *S); + void drop_zeros (const cholmod_sparse *S); #endif - octave_idx_type init (const chol_type& a, bool natural, bool force); + octave_idx_type init (const chol_type& a, bool natural, bool force); - // No copying! + // No copying! - sparse_chol_rep (const sparse_chol_rep&); + sparse_chol_rep (const sparse_chol_rep&); - sparse_chol_rep& operator = (const sparse_chol_rep&); -}; + sparse_chol_rep& operator = (const sparse_chol_rep&); + }; #if defined (HAVE_CHOLMOD) -// Can't use CHOLMOD_NAME(drop)(0.0, S, cm) because it doesn't treat -// complex matrices. + // Can't use CHOLMOD_NAME(drop)(0.0, S, cm) because it doesn't treat + // complex matrices. -template <typename chol_type> -void -sparse_chol<chol_type>::sparse_chol_rep::drop_zeros (const cholmod_sparse *S) -{ - if (! S) - return; + template <typename chol_type> + void + sparse_chol<chol_type>::sparse_chol_rep::drop_zeros (const cholmod_sparse *S) + { + if (! S) + return; - octave_idx_type *Sp = static_cast<octave_idx_type *>(S->p); - octave_idx_type *Si = static_cast<octave_idx_type *>(S->i); - chol_elt *Sx = static_cast<chol_elt *>(S->x); + octave_idx_type *Sp = static_cast<octave_idx_type *>(S->p); + octave_idx_type *Si = static_cast<octave_idx_type *>(S->i); + chol_elt *Sx = static_cast<chol_elt *>(S->x); - octave_idx_type pdest = 0; - octave_idx_type ncol = S->ncol; + octave_idx_type pdest = 0; + octave_idx_type ncol = S->ncol; - for (octave_idx_type k = 0; k < ncol; k++) - { - octave_idx_type p = Sp[k]; - octave_idx_type pend = Sp[k+1]; - Sp[k] = pdest; + for (octave_idx_type k = 0; k < ncol; k++) + { + octave_idx_type p = Sp[k]; + octave_idx_type pend = Sp[k+1]; + Sp[k] = pdest; - for (; p < pend; p++) - { - chol_elt sik = Sx[p]; + for (; p < pend; p++) + { + chol_elt sik = Sx[p]; - if (CHOLMOD_IS_NONZERO (sik)) - { - if (p != pdest) + if (CHOLMOD_IS_NONZERO (sik)) { - Si[pdest] = Si[p]; - Sx[pdest] = sik; + if (p != pdest) + { + Si[pdest] = Si[p]; + Sx[pdest] = sik; + } + + pdest++; } - - pdest++; } } + + Sp[ncol] = pdest; } - Sp[ncol] = pdest; -} - -// Must provide a specialization for this function. -template <typename T> -int -get_xtype (void); + // Must provide a specialization for this function. + template <typename T> + int + get_xtype (void); -template <> -inline int -get_xtype<double> (void) -{ - return CHOLMOD_REAL; -} + template <> + inline int + get_xtype<double> (void) + { + return CHOLMOD_REAL; + } -template <> -inline int -get_xtype<Complex> (void) -{ - return CHOLMOD_COMPLEX; -} + template <> + inline int + get_xtype<Complex> (void) + { + return CHOLMOD_COMPLEX; + } #endif -template <typename chol_type> -octave_idx_type -sparse_chol<chol_type>::sparse_chol_rep::init (const chol_type& a, - bool natural, bool force) -{ - volatile octave_idx_type info = 0; + template <typename chol_type> + octave_idx_type + sparse_chol<chol_type>::sparse_chol_rep::init (const chol_type& a, + bool natural, bool force) + { + volatile octave_idx_type info = 0; #if defined (HAVE_CHOLMOD) - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); - if (a_nr != a_nc) - (*current_liboctave_error_handler) ("sparse_chol requires square matrix"); + if (a_nr != a_nc) + (*current_liboctave_error_handler) ("sparse_chol requires square matrix"); - cholmod_common *cm = &Common; + cholmod_common *cm = &Common; - // Setup initial parameters + // Setup initial parameters - CHOLMOD_NAME(start) (cm); - cm->prefer_zomplex = false; + CHOLMOD_NAME(start) (cm); + cm->prefer_zomplex = false; - double spu = octave_sparse_params::get_key ("spumoni"); + double spu = octave_sparse_params::get_key ("spumoni"); - if (spu == 0.) - { - cm->print = -1; - SUITESPARSE_ASSIGN_FPTR (printf_func, cm->print_function, 0); - } - else - { - cm->print = static_cast<int> (spu) + 2; - SUITESPARSE_ASSIGN_FPTR (printf_func, cm->print_function, &SparseCholPrint); - } - - cm->error_handler = &SparseCholError; + if (spu == 0.) + { + cm->print = -1; + SUITESPARSE_ASSIGN_FPTR (printf_func, cm->print_function, 0); + } + else + { + cm->print = static_cast<int> (spu) + 2; + SUITESPARSE_ASSIGN_FPTR (printf_func, cm->print_function, &SparseCholPrint); + } - SUITESPARSE_ASSIGN_FPTR2 (divcomplex_func, cm->complex_divide, divcomplex); - SUITESPARSE_ASSIGN_FPTR2 (hypot_func, cm->hypotenuse, hypot); + cm->error_handler = &SparseCholError; + + SUITESPARSE_ASSIGN_FPTR2 (divcomplex_func, cm->complex_divide, divcomplex); + SUITESPARSE_ASSIGN_FPTR2 (hypot_func, cm->hypotenuse, hypot); - cm->final_asis = false; - cm->final_super = false; - cm->final_ll = true; - cm->final_pack = true; - cm->final_monotonic = true; - cm->final_resymbol = false; - - cholmod_sparse A; - cholmod_sparse *ac = &A; - double dummy; + cm->final_asis = false; + cm->final_super = false; + cm->final_ll = true; + cm->final_pack = true; + cm->final_monotonic = true; + cm->final_resymbol = false; - ac->nrow = a_nr; - ac->ncol = a_nc; + cholmod_sparse A; + cholmod_sparse *ac = &A; + double dummy; - ac->p = a.cidx (); - ac->i = a.ridx (); - ac->nzmax = a.nnz (); - ac->packed = true; - ac->sorted = true; - ac->nz = 0; -#if defined (OCTAVE_ENABLE_64) - ac->itype = CHOLMOD_LONG; -#else - ac->itype = CHOLMOD_INT; -#endif - ac->dtype = CHOLMOD_DOUBLE; - ac->stype = 1; - ac->xtype = get_xtype<chol_elt> (); + ac->nrow = a_nr; + ac->ncol = a_nc; - if (a_nr < 1) - ac->x = &dummy; - else - ac->x = a.data (); - - // use natural ordering if no q output parameter - if (natural) - { - cm->nmethods = 1; - cm->method[0].ordering = CHOLMOD_NATURAL; - cm->postorder = false; - } + ac->p = a.cidx (); + ac->i = a.ridx (); + ac->nzmax = a.nnz (); + ac->packed = true; + ac->sorted = true; + ac->nz = 0; +#if defined (OCTAVE_ENABLE_64) + ac->itype = CHOLMOD_LONG; +#else + ac->itype = CHOLMOD_INT; +#endif + ac->dtype = CHOLMOD_DOUBLE; + ac->stype = 1; + ac->xtype = get_xtype<chol_elt> (); - cholmod_factor *Lfactor; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - Lfactor = CHOLMOD_NAME(analyze) (ac, cm); - CHOLMOD_NAME(factorize) (ac, Lfactor, cm); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + if (a_nr < 1) + ac->x = &dummy; + else + ac->x = a.data (); - is_pd = cm->status == CHOLMOD_OK; - info = (is_pd ? 0 : cm->status); + // use natural ordering if no q output parameter + if (natural) + { + cm->nmethods = 1; + cm->method[0].ordering = CHOLMOD_NATURAL; + cm->postorder = false; + } - if (is_pd || force) - { + cholmod_factor *Lfactor; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - cond = CHOLMOD_NAME(rcond) (Lfactor, cm); + Lfactor = CHOLMOD_NAME(analyze) (ac, cm); + CHOLMOD_NAME(factorize) (ac, Lfactor, cm); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - minor_p = Lfactor->minor; + is_pd = cm->status == CHOLMOD_OK; + info = (is_pd ? 0 : cm->status); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - Lsparse = CHOLMOD_NAME(factor_to_sparse) (Lfactor, cm); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - if (minor_p > 0 && minor_p < a_nr) + if (is_pd || force) { - size_t n1 = a_nr + 1; - Lsparse->p = CHOLMOD_NAME(realloc) (minor_p+1, - sizeof(octave_idx_type), - Lsparse->p, &n1, cm); BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CHOLMOD_NAME(reallocate_sparse) - (static_cast<octave_idx_type *>(Lsparse->p)[minor_p], Lsparse, cm); + cond = CHOLMOD_NAME(rcond) (Lfactor, cm); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + minor_p = Lfactor->minor; + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + Lsparse = CHOLMOD_NAME(factor_to_sparse) (Lfactor, cm); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - Lsparse->ncol = minor_p; + if (minor_p > 0 && minor_p < a_nr) + { + size_t n1 = a_nr + 1; + Lsparse->p = CHOLMOD_NAME(realloc) (minor_p+1, + sizeof(octave_idx_type), + Lsparse->p, &n1, cm); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CHOLMOD_NAME(reallocate_sparse) + (static_cast<octave_idx_type *>(Lsparse->p)[minor_p], Lsparse, cm); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + Lsparse->ncol = minor_p; + } + + drop_zeros (Lsparse); + + if (! natural) + { + perms.resize (a_nr); + for (octave_idx_type i = 0; i < a_nr; i++) + perms(i) = static_cast<octave_idx_type *>(Lfactor->Perm)[i]; + } } - drop_zeros (Lsparse); - - if (! natural) - { - perms.resize (a_nr); - for (octave_idx_type i = 0; i < a_nr; i++) - perms(i) = static_cast<octave_idx_type *>(Lfactor->Perm)[i]; - } - } + // NAME used to prefix statistics report from print_common + static char blank_name[] = " "; - // NAME used to prefix statistics report from print_common - static char blank_name[] = " "; + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CHOLMOD_NAME(print_common) (blank_name, cm); + CHOLMOD_NAME(free_factor) (&Lfactor, cm); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CHOLMOD_NAME(print_common) (blank_name, cm); - CHOLMOD_NAME(free_factor) (&Lfactor, cm); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - return info; + return info; #else - octave_unused_parameter (a); - octave_unused_parameter (natural); - octave_unused_parameter (force); + octave_unused_parameter (a); + octave_unused_parameter (natural); + octave_unused_parameter (force); - (*current_liboctave_error_handler) - ("support for CHOLMOD was unavailable or disabled when liboctave was built"); + (*current_liboctave_error_handler) + ("support for CHOLMOD was unavailable or disabled when liboctave was built"); - return info; + return info; #endif -} + } -template <typename chol_type> -SparseMatrix -sparse_chol<chol_type>::sparse_chol_rep::Q (void) const -{ + template <typename chol_type> + SparseMatrix + sparse_chol<chol_type>::sparse_chol_rep::Q (void) const + { #if defined (HAVE_CHOLMOD) - octave_idx_type n = Lsparse->nrow; - SparseMatrix p (n, n, n); + octave_idx_type n = Lsparse->nrow; + SparseMatrix p (n, n, n); - for (octave_idx_type i = 0; i < n; i++) - { - p.xcidx (i) = i; - p.xridx (i) = static_cast<octave_idx_type>(perms (i)); - p.xdata (i) = 1; - } + for (octave_idx_type i = 0; i < n; i++) + { + p.xcidx (i) = i; + p.xridx (i) = static_cast<octave_idx_type>(perms (i)); + p.xdata (i) = 1; + } - p.xcidx (n) = n; + p.xcidx (n) = n; - return p; + return p; #else - return SparseMatrix (); + return SparseMatrix (); #endif -} + } -template <typename chol_type> -sparse_chol<chol_type>::sparse_chol (void) - : rep (new typename sparse_chol<chol_type>::sparse_chol_rep ()) -{ } + template <typename chol_type> + sparse_chol<chol_type>::sparse_chol (void) + : rep (new typename sparse_chol<chol_type>::sparse_chol_rep ()) + { } -template <typename chol_type> -sparse_chol<chol_type>::sparse_chol (const chol_type& a, bool natural, - bool force) - : rep (new typename - sparse_chol<chol_type>::sparse_chol_rep (a, natural, force)) -{ } + template <typename chol_type> + sparse_chol<chol_type>::sparse_chol (const chol_type& a, bool natural, + bool force) + : rep (new typename + sparse_chol<chol_type>::sparse_chol_rep (a, natural, force)) + { } -template <typename chol_type> -sparse_chol<chol_type>::sparse_chol (const chol_type& a, octave_idx_type& info, - bool natural, bool force) - : rep (new typename - sparse_chol<chol_type>::sparse_chol_rep (a, info, natural, force)) -{ } + template <typename chol_type> + sparse_chol<chol_type>::sparse_chol (const chol_type& a, octave_idx_type& info, + bool natural, bool force) + : rep (new typename + sparse_chol<chol_type>::sparse_chol_rep (a, info, natural, force)) + { } -template <typename chol_type> -sparse_chol<chol_type>::sparse_chol (const chol_type& a, octave_idx_type& info, - bool natural) - : rep (new typename - sparse_chol<chol_type>::sparse_chol_rep (a, info, natural, false)) -{ } - -template <typename chol_type> -sparse_chol<chol_type>::sparse_chol (const chol_type& a, octave_idx_type& info) - : rep (new typename - sparse_chol<chol_type>::sparse_chol_rep (a, info, false, false)) -{ } + template <typename chol_type> + sparse_chol<chol_type>::sparse_chol (const chol_type& a, octave_idx_type& info, + bool natural) + : rep (new typename + sparse_chol<chol_type>::sparse_chol_rep (a, info, natural, false)) + { } -template <typename chol_type> -sparse_chol<chol_type>::sparse_chol (const sparse_chol<chol_type>& a) - : rep (a.rep) -{ - rep->count++; -} + template <typename chol_type> + sparse_chol<chol_type>::sparse_chol (const chol_type& a, octave_idx_type& info) + : rep (new typename + sparse_chol<chol_type>::sparse_chol_rep (a, info, false, false)) + { } -template <typename chol_type> -sparse_chol<chol_type>::~sparse_chol (void) -{ - if (--rep->count == 0) - delete rep; -} + template <typename chol_type> + sparse_chol<chol_type>::sparse_chol (const sparse_chol<chol_type>& a) + : rep (a.rep) + { + rep->count++; + } -template <typename chol_type> -sparse_chol<chol_type>& -sparse_chol<chol_type>::operator = (const sparse_chol& a) -{ - if (this != &a) + template <typename chol_type> + sparse_chol<chol_type>::~sparse_chol (void) { if (--rep->count == 0) delete rep; - - rep = a.rep; - rep->count++; } - return *this; -} + template <typename chol_type> + sparse_chol<chol_type>& + sparse_chol<chol_type>::operator = (const sparse_chol& a) + { + if (this != &a) + { + if (--rep->count == 0) + delete rep; -template <typename chol_type> -chol_type -sparse_chol<chol_type>::L (void) const -{ + rep = a.rep; + rep->count++; + } + + return *this; + } + + template <typename chol_type> + chol_type + sparse_chol<chol_type>::L (void) const + { #if defined (HAVE_CHOLMOD) - cholmod_sparse *m = rep->L (); + cholmod_sparse *m = rep->L (); - octave_idx_type nc = m->ncol; - octave_idx_type nnz = m->nzmax; + octave_idx_type nc = m->ncol; + octave_idx_type nnz = m->nzmax; - chol_type ret (m->nrow, nc, nnz); + chol_type ret (m->nrow, nc, nnz); - for (octave_idx_type j = 0; j < nc+1; j++) - ret.xcidx (j) = static_cast<octave_idx_type *>(m->p)[j]; + for (octave_idx_type j = 0; j < nc+1; j++) + ret.xcidx (j) = static_cast<octave_idx_type *>(m->p)[j]; - for (octave_idx_type i = 0; i < nnz; i++) - { - ret.xridx (i) = static_cast<octave_idx_type *>(m->i)[i]; - ret.xdata (i) = static_cast<chol_elt *>(m->x)[i]; - } + for (octave_idx_type i = 0; i < nnz; i++) + { + ret.xridx (i) = static_cast<octave_idx_type *>(m->i)[i]; + ret.xdata (i) = static_cast<chol_elt *>(m->x)[i]; + } - return ret; + return ret; #else - return chol_type (); + return chol_type (); #endif -} + } -template <typename chol_type> -octave_idx_type -sparse_chol<chol_type>::P (void) const -{ - return rep->P (); -} + template <typename chol_type> + octave_idx_type + sparse_chol<chol_type>::P (void) const + { + return rep->P (); + } -template <typename chol_type> -RowVector -sparse_chol<chol_type>::perm (void) const -{ - return rep->perm (); -} + template <typename chol_type> + RowVector + sparse_chol<chol_type>::perm (void) const + { + return rep->perm (); + } -template <typename chol_type> -SparseMatrix -sparse_chol<chol_type>::Q (void) const -{ - return rep->Q (); -} + template <typename chol_type> + SparseMatrix + sparse_chol<chol_type>::Q (void) const + { + return rep->Q (); + } -template <typename chol_type> -bool -sparse_chol<chol_type>::is_positive_definite (void) const -{ - return rep->is_positive_definite (); -} + template <typename chol_type> + bool + sparse_chol<chol_type>::is_positive_definite (void) const + { + return rep->is_positive_definite (); + } -template <typename chol_type> -double -sparse_chol<chol_type>::rcond (void) const -{ - return rep->rcond (); -} + template <typename chol_type> + double + sparse_chol<chol_type>::rcond (void) const + { + return rep->rcond (); + } -template <typename chol_type> -chol_type -sparse_chol<chol_type>::inverse (void) const -{ - chol_type retval; + template <typename chol_type> + chol_type + sparse_chol<chol_type>::inverse (void) const + { + chol_type retval; #if defined (HAVE_CHOLMOD) - cholmod_sparse *m = rep->L (); - octave_idx_type n = m->ncol; - RowVector perms = rep->perm (); - double rcond2; - octave_idx_type info; - MatrixType mattype (MatrixType::Upper); - chol_type linv = L ().hermitian ().inverse (mattype, info, rcond2, 1, 0); + cholmod_sparse *m = rep->L (); + octave_idx_type n = m->ncol; + RowVector perms = rep->perm (); + double rcond2; + octave_idx_type info; + MatrixType mattype (MatrixType::Upper); + chol_type linv = L ().hermitian ().inverse (mattype, info, rcond2, 1, 0); - if (perms.numel () == n) - { - SparseMatrix Qc = Q (); + if (perms.numel () == n) + { + SparseMatrix Qc = Q (); - retval = Qc * linv * linv.hermitian () * Qc.transpose (); - } - else - retval = linv * linv.hermitian (); + retval = Qc * linv * linv.hermitian () * Qc.transpose (); + } + else + retval = linv * linv.hermitian (); #endif - return retval; -} - -template <typename chol_type> -chol_type -chol2inv (const chol_type& r) -{ - octave_idx_type r_nr = r.rows (); - octave_idx_type r_nc = r.cols (); - chol_type retval; - - if (r_nr != r_nc) - (*current_liboctave_error_handler) ("U must be a square matrix"); - - MatrixType mattype (r); - int typ = mattype.type (false); - double rcond; - octave_idx_type info; - chol_type rtra, multip; - - if (typ == MatrixType::Upper) - { - rtra = r.transpose (); - multip = (rtra*r); - } - else if (typ == MatrixType::Lower) - { - rtra = r.transpose (); - multip = (r*rtra); + return retval; } - else - (*current_liboctave_error_handler) ("U must be a triangular matrix"); + + template <typename chol_type> + chol_type + chol2inv (const chol_type& r) + { + octave_idx_type r_nr = r.rows (); + octave_idx_type r_nc = r.cols (); + chol_type retval; - MatrixType mattypenew (multip); - retval = multip.inverse (mattypenew, info, rcond, true, false); - return retval; -} + if (r_nr != r_nc) + (*current_liboctave_error_handler) ("U must be a square matrix"); -// SparseComplexMatrix specialization (the value for the NATURAL -// parameter in the sparse_chol<T>::sparse_chol_rep constructor is -// different from the default). + MatrixType mattype (r); + int typ = mattype.type (false); + double rcond; + octave_idx_type info; + chol_type rtra, multip; -template <> -sparse_chol<SparseComplexMatrix>::sparse_chol (const SparseComplexMatrix& a, - octave_idx_type& info) - : rep ( - new sparse_chol<SparseComplexMatrix>::sparse_chol_rep (a, info, true, false)) -{ } + if (typ == MatrixType::Upper) + { + rtra = r.transpose (); + multip = (rtra*r); + } + else if (typ == MatrixType::Lower) + { + rtra = r.transpose (); + multip = (r*rtra); + } + else + (*current_liboctave_error_handler) ("U must be a triangular matrix"); -// Instantiations we need. - -template class sparse_chol<SparseMatrix>; + MatrixType mattypenew (multip); + retval = multip.inverse (mattypenew, info, rcond, true, false); + return retval; + } -template class sparse_chol<SparseComplexMatrix>; + // SparseComplexMatrix specialization (the value for the NATURAL + // parameter in the sparse_chol<T>::sparse_chol_rep constructor is + // different from the default). -template SparseMatrix -chol2inv<SparseMatrix> (const SparseMatrix& r); + template <> + sparse_chol<SparseComplexMatrix>::sparse_chol (const SparseComplexMatrix& a, + octave_idx_type& info) + : rep ( + new sparse_chol<SparseComplexMatrix>::sparse_chol_rep (a, info, true, false)) + { } -template SparseComplexMatrix -chol2inv<SparseComplexMatrix> (const SparseComplexMatrix& r); + // Instantiations we need. + + template class sparse_chol<SparseMatrix>; + + template class sparse_chol<SparseComplexMatrix>; + template SparseMatrix + chol2inv<SparseMatrix> (const SparseMatrix& r); + + template SparseComplexMatrix + chol2inv<SparseComplexMatrix> (const SparseComplexMatrix& r); + } } -}
--- a/liboctave/numeric/sparse-chol.h Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/sparse-chol.h Wed Aug 17 10:55:38 2016 -0400 @@ -33,75 +33,73 @@ namespace octave { -namespace math -{ - -// If the sparse matrix classes become templated on the element type -// (i.e., sparse_matrix<double>), then it might be best to make the -// template parameter of this class also be the element type instead -// of the matrix type. + namespace math + { + // If the sparse matrix classes become templated on the element type + // (i.e., sparse_matrix<double>), then it might be best to make the + // template parameter of this class also be the element type instead + // of the matrix type. -template <typename chol_type> -class -sparse_chol -{ -public: + template <typename chol_type> + class + sparse_chol + { + public: - sparse_chol (void); + sparse_chol (void); + + sparse_chol (const chol_type& a, bool natural, bool force); - sparse_chol (const chol_type& a, bool natural, bool force); + sparse_chol (const chol_type& a, octave_idx_type& info, + bool natural, bool force); - sparse_chol (const chol_type& a, octave_idx_type& info, - bool natural, bool force); + sparse_chol (const chol_type& a, octave_idx_type& info, bool natural); - sparse_chol (const chol_type& a, octave_idx_type& info, bool natural); - - sparse_chol (const chol_type& a, octave_idx_type& info); + sparse_chol (const chol_type& a, octave_idx_type& info); - sparse_chol (const sparse_chol<chol_type>& a); + sparse_chol (const sparse_chol<chol_type>& a); - virtual ~sparse_chol (void); + virtual ~sparse_chol (void); - sparse_chol& operator = (const sparse_chol& a); + sparse_chol& operator = (const sparse_chol& a); - chol_type L (void) const; + chol_type L (void) const; - chol_type R (void) const { return L ().hermitian (); } + chol_type R (void) const { return L ().hermitian (); } - octave_idx_type P (void) const; + octave_idx_type P (void) const; - RowVector perm (void) const; + RowVector perm (void) const; - SparseMatrix Q (void) const; + SparseMatrix Q (void) const; - bool is_positive_definite (void) const; + bool is_positive_definite (void) const; - double rcond (void) const; + double rcond (void) const; - chol_type inverse (void) const; + chol_type inverse (void) const; -protected: + protected: - typedef typename chol_type::element_type chol_elt; + typedef typename chol_type::element_type chol_elt; - class sparse_chol_rep; + class sparse_chol_rep; -private: + private: - sparse_chol_rep *rep; -}; + sparse_chol_rep *rep; + }; -template <typename chol_type> -chol_type -chol2inv (const chol_type& r); - -// SparseComplexMatrix specialization. + template <typename chol_type> + chol_type + chol2inv (const chol_type& r); -template <> -sparse_chol<SparseComplexMatrix>::sparse_chol (const SparseComplexMatrix& a, - octave_idx_type& info); + // SparseComplexMatrix specialization. -} + template <> + sparse_chol<SparseComplexMatrix>::sparse_chol (const SparseComplexMatrix& a, + octave_idx_type& info); + } } #endif
--- a/liboctave/numeric/sparse-lu.cc Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/sparse-lu.cc Wed Aug 17 10:55:38 2016 -0400 @@ -37,444 +37,426 @@ namespace octave { -namespace math -{ - -// Wrappers for SuiteSparse (formerly UMFPACK) functions that have -// different names depending on the sparse matrix data type. -// -// All of these functions must be specialized to forward to the correct -// SuiteSparse functions. + namespace math + { + // Wrappers for SuiteSparse (formerly UMFPACK) functions that have + // different names depending on the sparse matrix data type. + // + // All of these functions must be specialized to forward to the correct + // SuiteSparse functions. -template <typename T> -void -umfpack_defaults (double *Control); - -template <typename T> -void -umfpack_free_numeric (void **Numeric); + template <typename T> + void + umfpack_defaults (double *Control); -template <typename T> -void -umfpack_free_symbolic (void **Symbolic); + template <typename T> + void + umfpack_free_numeric (void **Numeric); -template <typename T> -octave_idx_type -umfpack_get_lunz (octave_idx_type *lnz, octave_idx_type *unz, void *Numeric); + template <typename T> + void + umfpack_free_symbolic (void **Symbolic); -template <typename T> -octave_idx_type -umfpack_get_numeric (octave_idx_type *Lp, octave_idx_type *Lj, - T *Lx, // Or Lz_packed - octave_idx_type *Up, octave_idx_type *Ui, - T *Ux, // Or Uz_packed - octave_idx_type *p, octave_idx_type *q, - double *Dz_packed, octave_idx_type *do_recip, - double *Rs, void *Numeric); - -template <typename T> -octave_idx_type -umfpack_numeric (const octave_idx_type *Ap, const octave_idx_type *Ai, - const T *Ax, // Or Az_packed - void *Symbolic, void **Numeric, - const double *Control, double *Info); + template <typename T> + octave_idx_type + umfpack_get_lunz (octave_idx_type *lnz, octave_idx_type *unz, void *Numeric); -template <typename T> -octave_idx_type -umfpack_qsymbolic (octave_idx_type n_row, octave_idx_type n_col, - const octave_idx_type *Ap, const octave_idx_type *Ai, - const T *Ax, // Or Az_packed - const octave_idx_type *Qinit, void **Symbolic, - const double *Control, double *Info); + template <typename T> + octave_idx_type + umfpack_get_numeric (octave_idx_type *Lp, octave_idx_type *Lj, + T *Lx, // Or Lz_packed + octave_idx_type *Up, octave_idx_type *Ui, + T *Ux, // Or Uz_packed + octave_idx_type *p, octave_idx_type *q, + double *Dz_packed, octave_idx_type *do_recip, + double *Rs, void *Numeric); -template <typename T> -void -umfpack_report_control (const double *Control); + template <typename T> + octave_idx_type + umfpack_numeric (const octave_idx_type *Ap, const octave_idx_type *Ai, + const T *Ax, // Or Az_packed + void *Symbolic, void **Numeric, + const double *Control, double *Info); -template <typename T> -void -umfpack_report_info (const double *Control, const double *Info); - -template <typename T> -void -umfpack_report_matrix (octave_idx_type n_row, octave_idx_type n_col, + template <typename T> + octave_idx_type + umfpack_qsymbolic (octave_idx_type n_row, octave_idx_type n_col, const octave_idx_type *Ap, const octave_idx_type *Ai, const T *Ax, // Or Az_packed - octave_idx_type col_form, const double *Control); + const octave_idx_type *Qinit, void **Symbolic, + const double *Control, double *Info); -template <typename T> -void -umfpack_report_numeric (void *Numeric, const double *Control); + template <typename T> + void + umfpack_report_control (const double *Control); + + template <typename T> + void + umfpack_report_info (const double *Control, const double *Info); -template <typename T> -void -umfpack_report_perm (octave_idx_type np, const octave_idx_type *Perm, - const double *Control); + template <typename T> + void + umfpack_report_matrix (octave_idx_type n_row, octave_idx_type n_col, + const octave_idx_type *Ap, const octave_idx_type *Ai, + const T *Ax, // Or Az_packed + octave_idx_type col_form, const double *Control); + + template <typename T> + void + umfpack_report_numeric (void *Numeric, const double *Control); -template <typename T> -void -umfpack_report_status (double *Control, octave_idx_type status); + template <typename T> + void + umfpack_report_perm (octave_idx_type np, const octave_idx_type *Perm, + const double *Control); -template <typename T> -void -umfpack_report_symbolic (void *Symbolic, const double *Control); + template <typename T> + void + umfpack_report_status (double *Control, octave_idx_type status); + + template <typename T> + void + umfpack_report_symbolic (void *Symbolic, const double *Control); #if defined (HAVE_UMFPACK) -// SparseMatrix Specialization. + // SparseMatrix Specialization. -template <> -inline void -umfpack_defaults<double> (double *Control) -{ - UMFPACK_DNAME (defaults) (Control); -} + template <> + inline void + umfpack_defaults<double> (double *Control) + { + UMFPACK_DNAME (defaults) (Control); + } -template <> -inline void -umfpack_free_numeric<double> (void **Numeric) -{ - UMFPACK_DNAME (free_numeric) (Numeric); -} + template <> + inline void + umfpack_free_numeric<double> (void **Numeric) + { + UMFPACK_DNAME (free_numeric) (Numeric); + } -template <> -inline void -umfpack_free_symbolic<double> (void **Symbolic) -{ - UMFPACK_DNAME (free_symbolic) (Symbolic); -} + template <> + inline void + umfpack_free_symbolic<double> (void **Symbolic) + { + UMFPACK_DNAME (free_symbolic) (Symbolic); + } -template <> -inline octave_idx_type -umfpack_get_lunz<double> - (octave_idx_type *lnz, octave_idx_type *unz, void *Numeric) -{ - octave_idx_type ignore1, ignore2, ignore3; + template <> + inline octave_idx_type + umfpack_get_lunz<double> + (octave_idx_type *lnz, octave_idx_type *unz, void *Numeric) + { + octave_idx_type ignore1, ignore2, ignore3; - return UMFPACK_DNAME (get_lunz) (lnz, unz, &ignore1, &ignore2, - &ignore3, Numeric); -} + return UMFPACK_DNAME (get_lunz) (lnz, unz, &ignore1, &ignore2, + &ignore3, Numeric); + } -template <> -inline octave_idx_type -umfpack_get_numeric<double> - (octave_idx_type *Lp, octave_idx_type *Lj, double *Lx, - octave_idx_type *Up, octave_idx_type *Ui, double *Ux, - octave_idx_type *p, octave_idx_type *q, double *Dx, - octave_idx_type *do_recip, double *Rs, void *Numeric) -{ - return UMFPACK_DNAME (get_numeric) (Lp, Lj, Lx, Up, Ui, Ux, p, q, Dx, - do_recip, Rs, Numeric); -} + template <> + inline octave_idx_type + umfpack_get_numeric<double> + (octave_idx_type *Lp, octave_idx_type *Lj, double *Lx, + octave_idx_type *Up, octave_idx_type *Ui, double *Ux, + octave_idx_type *p, octave_idx_type *q, double *Dx, + octave_idx_type *do_recip, double *Rs, void *Numeric) + { + return UMFPACK_DNAME (get_numeric) (Lp, Lj, Lx, Up, Ui, Ux, p, q, Dx, + do_recip, Rs, Numeric); + } -template <> -inline octave_idx_type -umfpack_numeric<double> - (const octave_idx_type *Ap, const octave_idx_type *Ai, - const double *Ax, void *Symbolic, void **Numeric, - const double *Control, double *Info) -{ - return UMFPACK_DNAME (numeric) (Ap, Ai, Ax, Symbolic, Numeric, Control, - Info); -} + template <> + inline octave_idx_type + umfpack_numeric<double> + (const octave_idx_type *Ap, const octave_idx_type *Ai, + const double *Ax, void *Symbolic, void **Numeric, + const double *Control, double *Info) + { + return UMFPACK_DNAME (numeric) (Ap, Ai, Ax, Symbolic, Numeric, Control, + Info); + } -template <> -inline octave_idx_type -umfpack_qsymbolic<double> - (octave_idx_type n_row, octave_idx_type n_col, const octave_idx_type *Ap, - const octave_idx_type *Ai, const double *Ax, - const octave_idx_type *Qinit, void **Symbolic, - const double *Control, double *Info) -{ - return UMFPACK_DNAME (qsymbolic) (n_row, n_col, Ap, Ai, Ax, Qinit, - Symbolic, Control, Info); -} + template <> + inline octave_idx_type + umfpack_qsymbolic<double> + (octave_idx_type n_row, octave_idx_type n_col, const octave_idx_type *Ap, + const octave_idx_type *Ai, const double *Ax, + const octave_idx_type *Qinit, void **Symbolic, + const double *Control, double *Info) + { + return UMFPACK_DNAME (qsymbolic) (n_row, n_col, Ap, Ai, Ax, Qinit, + Symbolic, Control, Info); + } -template <> -inline void -umfpack_report_control<double> (const double *Control) -{ - UMFPACK_DNAME (report_control) (Control); -} + template <> + inline void + umfpack_report_control<double> (const double *Control) + { + UMFPACK_DNAME (report_control) (Control); + } -template <> -inline void -umfpack_report_info<double> (const double *Control, const double *Info) -{ - UMFPACK_DNAME (report_info) (Control, Info); -} + template <> + inline void + umfpack_report_info<double> (const double *Control, const double *Info) + { + UMFPACK_DNAME (report_info) (Control, Info); + } -template <> -inline void -umfpack_report_matrix<double> - (octave_idx_type n_row, octave_idx_type n_col, const octave_idx_type *Ap, - const octave_idx_type *Ai, const double *Ax, octave_idx_type col_form, - const double *Control) -{ - UMFPACK_DNAME (report_matrix) (n_row, n_col, Ap, Ai, Ax, col_form, Control); -} + template <> + inline void + umfpack_report_matrix<double> + (octave_idx_type n_row, octave_idx_type n_col, const octave_idx_type *Ap, + const octave_idx_type *Ai, const double *Ax, octave_idx_type col_form, + const double *Control) + { + UMFPACK_DNAME (report_matrix) (n_row, n_col, Ap, Ai, Ax, col_form, Control); + } -template <> -inline void -umfpack_report_numeric<double> (void *Numeric, const double *Control) -{ - UMFPACK_DNAME (report_numeric) (Numeric, Control); -} + template <> + inline void + umfpack_report_numeric<double> (void *Numeric, const double *Control) + { + UMFPACK_DNAME (report_numeric) (Numeric, Control); + } -template <> -inline void -umfpack_report_perm<double> - (octave_idx_type np, const octave_idx_type *Perm, const double *Control) -{ - UMFPACK_DNAME (report_perm) (np, Perm, Control); -} + template <> + inline void + umfpack_report_perm<double> + (octave_idx_type np, const octave_idx_type *Perm, const double *Control) + { + UMFPACK_DNAME (report_perm) (np, Perm, Control); + } -template <> -inline void -umfpack_report_status<double> (double *Control, octave_idx_type status) -{ - UMFPACK_DNAME (report_status) (Control, status); -} + template <> + inline void + umfpack_report_status<double> (double *Control, octave_idx_type status) + { + UMFPACK_DNAME (report_status) (Control, status); + } -template <> -inline void -umfpack_report_symbolic<double> (void *Symbolic, const double *Control) -{ - UMFPACK_DNAME (report_symbolic) (Symbolic, Control); -} + template <> + inline void + umfpack_report_symbolic<double> (void *Symbolic, const double *Control) + { + UMFPACK_DNAME (report_symbolic) (Symbolic, Control); + } -// SparseComplexMatrix specialization. + // SparseComplexMatrix specialization. -template <> -inline void -umfpack_defaults<Complex> (double *Control) -{ - UMFPACK_ZNAME (defaults) (Control); -} + template <> + inline void + umfpack_defaults<Complex> (double *Control) + { + UMFPACK_ZNAME (defaults) (Control); + } -template <> -inline void -umfpack_free_numeric<Complex> (void **Numeric) -{ - UMFPACK_ZNAME (free_numeric) (Numeric); -} + template <> + inline void + umfpack_free_numeric<Complex> (void **Numeric) + { + UMFPACK_ZNAME (free_numeric) (Numeric); + } -template <> -inline void -umfpack_free_symbolic<Complex> (void **Symbolic) -{ - UMFPACK_ZNAME (free_symbolic) (Symbolic); -} + template <> + inline void + umfpack_free_symbolic<Complex> (void **Symbolic) + { + UMFPACK_ZNAME (free_symbolic) (Symbolic); + } -template <> -inline octave_idx_type -umfpack_get_lunz<Complex> - (octave_idx_type *lnz, octave_idx_type *unz, void *Numeric) -{ - octave_idx_type ignore1, ignore2, ignore3; + template <> + inline octave_idx_type + umfpack_get_lunz<Complex> + (octave_idx_type *lnz, octave_idx_type *unz, void *Numeric) + { + octave_idx_type ignore1, ignore2, ignore3; - return UMFPACK_ZNAME (get_lunz) (lnz, unz, &ignore1, &ignore2, - &ignore3, Numeric); -} + return UMFPACK_ZNAME (get_lunz) (lnz, unz, &ignore1, &ignore2, + &ignore3, Numeric); + } -template <> -inline octave_idx_type -umfpack_get_numeric<Complex> - (octave_idx_type *Lp, octave_idx_type *Lj, Complex *Lz, - octave_idx_type *Up, octave_idx_type *Ui, Complex *Uz, - octave_idx_type *p, octave_idx_type *q, double *Dz, - octave_idx_type *do_recip, double *Rs, void *Numeric) -{ - return UMFPACK_ZNAME (get_numeric) (Lp, Lj, - reinterpret_cast<double *> (Lz), - 0, Up, Ui, - reinterpret_cast<double *> (Uz), - 0, p, q, - reinterpret_cast<double *> (Dz), - 0, do_recip, Rs, Numeric); -} + template <> + inline octave_idx_type + umfpack_get_numeric<Complex> + (octave_idx_type *Lp, octave_idx_type *Lj, Complex *Lz, + octave_idx_type *Up, octave_idx_type *Ui, Complex *Uz, + octave_idx_type *p, octave_idx_type *q, double *Dz, + octave_idx_type *do_recip, double *Rs, void *Numeric) + { + return UMFPACK_ZNAME (get_numeric) (Lp, Lj, + reinterpret_cast<double *> (Lz), + 0, Up, Ui, + reinterpret_cast<double *> (Uz), + 0, p, q, + reinterpret_cast<double *> (Dz), + 0, do_recip, Rs, Numeric); + } -template <> -inline octave_idx_type -umfpack_numeric<Complex> - (const octave_idx_type *Ap, const octave_idx_type *Ai, - const Complex *Az, void *Symbolic, void **Numeric, - const double *Control, double *Info) -{ - return UMFPACK_ZNAME (numeric) (Ap, Ai, - reinterpret_cast<const double *> (Az), - 0, Symbolic, Numeric, Control, Info); -} + template <> + inline octave_idx_type + umfpack_numeric<Complex> + (const octave_idx_type *Ap, const octave_idx_type *Ai, + const Complex *Az, void *Symbolic, void **Numeric, + const double *Control, double *Info) + { + return UMFPACK_ZNAME (numeric) (Ap, Ai, + reinterpret_cast<const double *> (Az), + 0, Symbolic, Numeric, Control, Info); + } -template <> -inline octave_idx_type -umfpack_qsymbolic<Complex> - (octave_idx_type n_row, octave_idx_type n_col, - const octave_idx_type *Ap, const octave_idx_type *Ai, - const Complex *Az, const octave_idx_type *Qinit, - void **Symbolic, const double *Control, double *Info) -{ - return UMFPACK_ZNAME (qsymbolic) (n_row, n_col, Ap, Ai, - reinterpret_cast<const double *> (Az), - 0, Qinit, Symbolic, Control, Info); -} + template <> + inline octave_idx_type + umfpack_qsymbolic<Complex> + (octave_idx_type n_row, octave_idx_type n_col, + const octave_idx_type *Ap, const octave_idx_type *Ai, + const Complex *Az, const octave_idx_type *Qinit, + void **Symbolic, const double *Control, double *Info) + { + return UMFPACK_ZNAME (qsymbolic) (n_row, n_col, Ap, Ai, + reinterpret_cast<const double *> (Az), + 0, Qinit, Symbolic, Control, Info); + } -template <> -inline void -umfpack_report_control<Complex> (const double *Control) -{ - UMFPACK_ZNAME (report_control) (Control); -} + template <> + inline void + umfpack_report_control<Complex> (const double *Control) + { + UMFPACK_ZNAME (report_control) (Control); + } -template <> -inline void -umfpack_report_info<Complex> (const double *Control, const double *Info) -{ - UMFPACK_ZNAME (report_info) (Control, Info); -} + template <> + inline void + umfpack_report_info<Complex> (const double *Control, const double *Info) + { + UMFPACK_ZNAME (report_info) (Control, Info); + } -template <> -inline void -umfpack_report_matrix<Complex> - (octave_idx_type n_row, octave_idx_type n_col, - const octave_idx_type *Ap, const octave_idx_type *Ai, - const Complex *Az, octave_idx_type col_form, const double *Control) -{ - UMFPACK_ZNAME (report_matrix) (n_row, n_col, Ap, Ai, - reinterpret_cast<const double *> (Az), - 0, col_form, Control); -} + template <> + inline void + umfpack_report_matrix<Complex> + (octave_idx_type n_row, octave_idx_type n_col, + const octave_idx_type *Ap, const octave_idx_type *Ai, + const Complex *Az, octave_idx_type col_form, const double *Control) + { + UMFPACK_ZNAME (report_matrix) (n_row, n_col, Ap, Ai, + reinterpret_cast<const double *> (Az), + 0, col_form, Control); + } -template <> -inline void -umfpack_report_numeric<Complex> (void *Numeric, const double *Control) -{ - UMFPACK_ZNAME (report_numeric) (Numeric, Control); -} + template <> + inline void + umfpack_report_numeric<Complex> (void *Numeric, const double *Control) + { + UMFPACK_ZNAME (report_numeric) (Numeric, Control); + } -template <> -inline void -umfpack_report_perm<Complex> - (octave_idx_type np, const octave_idx_type *Perm, const double *Control) -{ - UMFPACK_ZNAME (report_perm) (np, Perm, Control); -} + template <> + inline void + umfpack_report_perm<Complex> + (octave_idx_type np, const octave_idx_type *Perm, const double *Control) + { + UMFPACK_ZNAME (report_perm) (np, Perm, Control); + } -template <> -inline void -umfpack_report_status<Complex> (double *Control, octave_idx_type status) -{ - UMFPACK_ZNAME (report_status) (Control, status); -} + template <> + inline void + umfpack_report_status<Complex> (double *Control, octave_idx_type status) + { + UMFPACK_ZNAME (report_status) (Control, status); + } -template <> -inline void -umfpack_report_symbolic <Complex> (void *Symbolic, const double *Control) -{ - UMFPACK_ZNAME (report_symbolic) (Symbolic, Control); -} + template <> + inline void + umfpack_report_symbolic <Complex> (void *Symbolic, const double *Control) + { + UMFPACK_ZNAME (report_symbolic) (Symbolic, Control); + } #endif -template <typename lu_type> -sparse_lu<lu_type>::sparse_lu (const lu_type& a, const Matrix& piv_thres, - bool scale) - : Lfact (), Ufact (), Rfact (), cond (0), P (), Q () -{ + template <typename lu_type> + sparse_lu<lu_type>::sparse_lu (const lu_type& a, const Matrix& piv_thres, + bool scale) + : Lfact (), Ufact (), Rfact (), cond (0), P (), Q () + { #if defined (HAVE_UMFPACK) - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - // Setup the control parameters - Matrix Control (UMFPACK_CONTROL, 1); - double *control = Control.fortran_vec (); - umfpack_defaults<lu_elt_type> (control); - - double tmp = octave_sparse_params::get_key ("spumoni"); - if (! octave::math::isnan (tmp)) - Control (UMFPACK_PRL) = tmp; + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); - if (piv_thres.numel () == 2) - { - tmp = (piv_thres (0) > 1. ? 1. : piv_thres (0)); - if (! octave::math::isnan (tmp)) - Control (UMFPACK_PIVOT_TOLERANCE) = tmp; + // Setup the control parameters + Matrix Control (UMFPACK_CONTROL, 1); + double *control = Control.fortran_vec (); + umfpack_defaults<lu_elt_type> (control); - tmp = (piv_thres (1) > 1. ? 1. : piv_thres (1)); + double tmp = octave_sparse_params::get_key ("spumoni"); if (! octave::math::isnan (tmp)) - Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; - } - else - { - tmp = octave_sparse_params::get_key ("piv_tol"); - if (! octave::math::isnan (tmp)) - Control (UMFPACK_PIVOT_TOLERANCE) = tmp; + Control (UMFPACK_PRL) = tmp; - tmp = octave_sparse_params::get_key ("sym_tol"); - if (! octave::math::isnan (tmp)) - Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; - } + if (piv_thres.numel () == 2) + { + tmp = (piv_thres (0) > 1. ? 1. : piv_thres (0)); + if (! octave::math::isnan (tmp)) + Control (UMFPACK_PIVOT_TOLERANCE) = tmp; - // Set whether we are allowed to modify Q or not - tmp = octave_sparse_params::get_key ("autoamd"); - if (! octave::math::isnan (tmp)) - Control (UMFPACK_FIXQ) = tmp; + tmp = (piv_thres (1) > 1. ? 1. : piv_thres (1)); + if (! octave::math::isnan (tmp)) + Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; + } + else + { + tmp = octave_sparse_params::get_key ("piv_tol"); + if (! octave::math::isnan (tmp)) + Control (UMFPACK_PIVOT_TOLERANCE) = tmp; - // Turn-off UMFPACK scaling for LU - if (scale) - Control (UMFPACK_SCALE) = UMFPACK_SCALE_SUM; - else - Control (UMFPACK_SCALE) = UMFPACK_SCALE_NONE; - - umfpack_report_control<lu_elt_type> (control); - - const octave_idx_type *Ap = a.cidx (); - const octave_idx_type *Ai = a.ridx (); - const lu_elt_type *Ax = a.data (); - - umfpack_report_matrix<lu_elt_type> (nr, nc, Ap, Ai, Ax, static_cast<octave_idx_type> (1), control); + tmp = octave_sparse_params::get_key ("sym_tol"); + if (! octave::math::isnan (tmp)) + Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; + } - void *Symbolic; - Matrix Info (1, UMFPACK_INFO); - double *info = Info.fortran_vec (); - int status = umfpack_qsymbolic<lu_elt_type> (nr, nc, Ap, Ai, Ax, 0, &Symbolic, control, info); + // Set whether we are allowed to modify Q or not + tmp = octave_sparse_params::get_key ("autoamd"); + if (! octave::math::isnan (tmp)) + Control (UMFPACK_FIXQ) = tmp; - if (status < 0) - { - umfpack_report_status<lu_elt_type> (control, status); - umfpack_report_info<lu_elt_type> (control, info); - - umfpack_free_symbolic<lu_elt_type> (&Symbolic); + // Turn-off UMFPACK scaling for LU + if (scale) + Control (UMFPACK_SCALE) = UMFPACK_SCALE_SUM; + else + Control (UMFPACK_SCALE) = UMFPACK_SCALE_NONE; - (*current_liboctave_error_handler) - ("sparse_lu: symbolic factorization failed"); - } - else - { - umfpack_report_symbolic<lu_elt_type> (Symbolic, control); + umfpack_report_control<lu_elt_type> (control); + + const octave_idx_type *Ap = a.cidx (); + const octave_idx_type *Ai = a.ridx (); + const lu_elt_type *Ax = a.data (); - void *Numeric; - status = umfpack_numeric<lu_elt_type> (Ap, Ai, Ax, Symbolic, &Numeric, control, info); - umfpack_free_symbolic<lu_elt_type> (&Symbolic); + umfpack_report_matrix<lu_elt_type> (nr, nc, Ap, Ai, Ax, static_cast<octave_idx_type> (1), control); - cond = Info (UMFPACK_RCOND); + void *Symbolic; + Matrix Info (1, UMFPACK_INFO); + double *info = Info.fortran_vec (); + int status = umfpack_qsymbolic<lu_elt_type> (nr, nc, Ap, Ai, Ax, 0, &Symbolic, control, info); if (status < 0) { umfpack_report_status<lu_elt_type> (control, status); umfpack_report_info<lu_elt_type> (control, info); - umfpack_free_numeric<lu_elt_type> (&Numeric); + umfpack_free_symbolic<lu_elt_type> (&Symbolic); (*current_liboctave_error_handler) - ("sparse_lu: numeric factorization failed"); + ("sparse_lu: symbolic factorization failed"); } else { - umfpack_report_numeric<lu_elt_type> (Numeric, control); + umfpack_report_symbolic<lu_elt_type> (Symbolic, control); - octave_idx_type lnz, unz; - status = umfpack_get_lunz<lu_elt_type> (&lnz, &unz, Numeric); + void *Numeric; + status = umfpack_numeric<lu_elt_type> (Ap, Ai, Ax, Symbolic, &Numeric, control, info); + umfpack_free_symbolic<lu_elt_type> (&Symbolic); + + cond = Info (UMFPACK_RCOND); if (status < 0) { @@ -484,214 +466,214 @@ umfpack_free_numeric<lu_elt_type> (&Numeric); (*current_liboctave_error_handler) - ("sparse_lu: extracting LU factors failed"); + ("sparse_lu: numeric factorization failed"); } else { - octave_idx_type n_inner = (nr < nc ? nr : nc); - - if (lnz < 1) - Lfact = lu_type (n_inner, nr, static_cast<octave_idx_type> (1)); - else - Lfact = lu_type (n_inner, nr, lnz); - - octave_idx_type *Ltp = Lfact.cidx (); - octave_idx_type *Ltj = Lfact.ridx (); - lu_elt_type *Ltx = Lfact.data (); - - if (unz < 1) - Ufact = lu_type (n_inner, nc, static_cast<octave_idx_type> (1)); - else - Ufact = lu_type (n_inner, nc, unz); - - octave_idx_type *Up = Ufact.cidx (); - octave_idx_type *Uj = Ufact.ridx (); - lu_elt_type *Ux = Ufact.data (); + umfpack_report_numeric<lu_elt_type> (Numeric, control); - Rfact = SparseMatrix (nr, nr, nr); - for (octave_idx_type i = 0; i < nr; i++) - { - Rfact.xridx (i) = i; - Rfact.xcidx (i) = i; - } - Rfact.xcidx (nr) = nr; - double *Rx = Rfact.data (); - - P.resize (dim_vector (nr, 1)); - octave_idx_type *p = P.fortran_vec (); - - Q.resize (dim_vector (nc, 1)); - octave_idx_type *q = Q.fortran_vec (); - - octave_idx_type do_recip; - status = umfpack_get_numeric<lu_elt_type> (Ltp, Ltj, Ltx, Up, Uj, Ux, p, q, 0, &do_recip, Rx, Numeric); - - umfpack_free_numeric<lu_elt_type> (&Numeric); + octave_idx_type lnz, unz; + status = umfpack_get_lunz<lu_elt_type> (&lnz, &unz, Numeric); if (status < 0) { umfpack_report_status<lu_elt_type> (control, status); + umfpack_report_info<lu_elt_type> (control, info); + + umfpack_free_numeric<lu_elt_type> (&Numeric); (*current_liboctave_error_handler) ("sparse_lu: extracting LU factors failed"); } else { - Lfact = Lfact.transpose (); + octave_idx_type n_inner = (nr < nc ? nr : nc); + + if (lnz < 1) + Lfact = lu_type (n_inner, nr, static_cast<octave_idx_type> (1)); + else + Lfact = lu_type (n_inner, nr, lnz); + + octave_idx_type *Ltp = Lfact.cidx (); + octave_idx_type *Ltj = Lfact.ridx (); + lu_elt_type *Ltx = Lfact.data (); + + if (unz < 1) + Ufact = lu_type (n_inner, nc, static_cast<octave_idx_type> (1)); + else + Ufact = lu_type (n_inner, nc, unz); - if (do_recip) - for (octave_idx_type i = 0; i < nr; i++) - Rx[i] = 1.0 / Rx[i]; + octave_idx_type *Up = Ufact.cidx (); + octave_idx_type *Uj = Ufact.ridx (); + lu_elt_type *Ux = Ufact.data (); + + Rfact = SparseMatrix (nr, nr, nr); + for (octave_idx_type i = 0; i < nr; i++) + { + Rfact.xridx (i) = i; + Rfact.xcidx (i) = i; + } + Rfact.xcidx (nr) = nr; + double *Rx = Rfact.data (); + + P.resize (dim_vector (nr, 1)); + octave_idx_type *p = P.fortran_vec (); - umfpack_report_matrix<lu_elt_type> (nr, n_inner, Lfact.cidx (), Lfact.ridx (), Lfact.data (), static_cast<octave_idx_type> (1), control); - umfpack_report_matrix<lu_elt_type> (n_inner, nc, Ufact.cidx (), Ufact.ridx (), Ufact.data (), static_cast<octave_idx_type> (1), control); - umfpack_report_perm<lu_elt_type> (nr, p, control); - umfpack_report_perm<lu_elt_type> (nc, q, control); + Q.resize (dim_vector (nc, 1)); + octave_idx_type *q = Q.fortran_vec (); + + octave_idx_type do_recip; + status = umfpack_get_numeric<lu_elt_type> (Ltp, Ltj, Ltx, Up, Uj, Ux, p, q, 0, &do_recip, Rx, Numeric); + + umfpack_free_numeric<lu_elt_type> (&Numeric); + + if (status < 0) + { + umfpack_report_status<lu_elt_type> (control, status); + + (*current_liboctave_error_handler) + ("sparse_lu: extracting LU factors failed"); + } + else + { + Lfact = Lfact.transpose (); + + if (do_recip) + for (octave_idx_type i = 0; i < nr; i++) + Rx[i] = 1.0 / Rx[i]; + + umfpack_report_matrix<lu_elt_type> (nr, n_inner, Lfact.cidx (), Lfact.ridx (), Lfact.data (), static_cast<octave_idx_type> (1), control); + umfpack_report_matrix<lu_elt_type> (n_inner, nc, Ufact.cidx (), Ufact.ridx (), Ufact.data (), static_cast<octave_idx_type> (1), control); + umfpack_report_perm<lu_elt_type> (nr, p, control); + umfpack_report_perm<lu_elt_type> (nc, q, control); + } + + umfpack_report_info<lu_elt_type> (control, info); } - - umfpack_report_info<lu_elt_type> (control, info); } } - } #else - octave_unused_parameter (a); - octave_unused_parameter (piv_thres); - octave_unused_parameter (scale); + octave_unused_parameter (a); + octave_unused_parameter (piv_thres); + octave_unused_parameter (scale); - (*current_liboctave_error_handler) - ("support for UMFPACK was unavailable or disabled when liboctave was built"); + (*current_liboctave_error_handler) + ("support for UMFPACK was unavailable or disabled when liboctave was built"); #endif -} - -template <typename lu_type> -sparse_lu<lu_type>::sparse_lu (const lu_type& a, - const ColumnVector& Qinit, - const Matrix& piv_thres, bool scale, - bool FixedQ, double droptol, - bool milu, bool udiag) - : Lfact (), Ufact (), Rfact (), cond (0), P (), Q () -{ -#if defined (HAVE_UMFPACK) - - if (milu) - (*current_liboctave_error_handler) - ("Modified incomplete LU not implemented"); - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - // Setup the control parameters - Matrix Control (UMFPACK_CONTROL, 1); - double *control = Control.fortran_vec (); - umfpack_defaults<lu_elt_type> (control); - - double tmp = octave_sparse_params::get_key ("spumoni"); - if (! octave::math::isnan (tmp)) - Control (UMFPACK_PRL) = tmp; - - if (piv_thres.numel () == 2) - { - tmp = (piv_thres (0) > 1. ? 1. : piv_thres (0)); - if (! octave::math::isnan (tmp)) - Control (UMFPACK_PIVOT_TOLERANCE) = tmp; - tmp = (piv_thres (1) > 1. ? 1. : piv_thres (1)); - if (! octave::math::isnan (tmp)) - Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; - } - else - { - tmp = octave_sparse_params::get_key ("piv_tol"); - if (! octave::math::isnan (tmp)) - Control (UMFPACK_PIVOT_TOLERANCE) = tmp; - - tmp = octave_sparse_params::get_key ("sym_tol"); - if (! octave::math::isnan (tmp)) - Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; } - if (droptol >= 0.) - Control (UMFPACK_DROPTOL) = droptol; + template <typename lu_type> + sparse_lu<lu_type>::sparse_lu (const lu_type& a, + const ColumnVector& Qinit, + const Matrix& piv_thres, bool scale, + bool FixedQ, double droptol, + bool milu, bool udiag) + : Lfact (), Ufact (), Rfact (), cond (0), P (), Q () + { +#if defined (HAVE_UMFPACK) - // Set whether we are allowed to modify Q or not - if (FixedQ) - Control (UMFPACK_FIXQ) = 1.0; - else - { - tmp = octave_sparse_params::get_key ("autoamd"); - if (! octave::math::isnan (tmp)) - Control (UMFPACK_FIXQ) = tmp; - } + if (milu) + (*current_liboctave_error_handler) + ("Modified incomplete LU not implemented"); + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); - // Turn-off UMFPACK scaling for LU - if (scale) - Control (UMFPACK_SCALE) = UMFPACK_SCALE_SUM; - else - Control (UMFPACK_SCALE) = UMFPACK_SCALE_NONE; + // Setup the control parameters + Matrix Control (UMFPACK_CONTROL, 1); + double *control = Control.fortran_vec (); + umfpack_defaults<lu_elt_type> (control); - umfpack_report_control<lu_elt_type> (control); + double tmp = octave_sparse_params::get_key ("spumoni"); + if (! octave::math::isnan (tmp)) + Control (UMFPACK_PRL) = tmp; - const octave_idx_type *Ap = a.cidx (); - const octave_idx_type *Ai = a.ridx (); - const lu_elt_type *Ax = a.data (); - - umfpack_report_matrix<lu_elt_type> (nr, nc, Ap, Ai, Ax, static_cast<octave_idx_type> (1), control); - - void *Symbolic; - Matrix Info (1, UMFPACK_INFO); - double *info = Info.fortran_vec (); - int status; + if (piv_thres.numel () == 2) + { + tmp = (piv_thres (0) > 1. ? 1. : piv_thres (0)); + if (! octave::math::isnan (tmp)) + Control (UMFPACK_PIVOT_TOLERANCE) = tmp; + tmp = (piv_thres (1) > 1. ? 1. : piv_thres (1)); + if (! octave::math::isnan (tmp)) + Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; + } + else + { + tmp = octave_sparse_params::get_key ("piv_tol"); + if (! octave::math::isnan (tmp)) + Control (UMFPACK_PIVOT_TOLERANCE) = tmp; - // Null loop so that qinit is imediately deallocated when not needed - do - { - OCTAVE_LOCAL_BUFFER (octave_idx_type, qinit, nc); + tmp = octave_sparse_params::get_key ("sym_tol"); + if (! octave::math::isnan (tmp)) + Control (UMFPACK_SYM_PIVOT_TOLERANCE) = tmp; + } + + if (droptol >= 0.) + Control (UMFPACK_DROPTOL) = droptol; - for (octave_idx_type i = 0; i < nc; i++) - qinit[i] = static_cast<octave_idx_type> (Qinit (i)); + // Set whether we are allowed to modify Q or not + if (FixedQ) + Control (UMFPACK_FIXQ) = 1.0; + else + { + tmp = octave_sparse_params::get_key ("autoamd"); + if (! octave::math::isnan (tmp)) + Control (UMFPACK_FIXQ) = tmp; + } - status = umfpack_qsymbolic<lu_elt_type> (nr, nc, Ap, Ai, Ax, qinit, &Symbolic, control, info); - } - while (0); + // Turn-off UMFPACK scaling for LU + if (scale) + Control (UMFPACK_SCALE) = UMFPACK_SCALE_SUM; + else + Control (UMFPACK_SCALE) = UMFPACK_SCALE_NONE; - if (status < 0) - { - umfpack_report_status<lu_elt_type> (control, status); - umfpack_report_info<lu_elt_type> (control, info); + umfpack_report_control<lu_elt_type> (control); - umfpack_free_symbolic<lu_elt_type> (&Symbolic); + const octave_idx_type *Ap = a.cidx (); + const octave_idx_type *Ai = a.ridx (); + const lu_elt_type *Ax = a.data (); + + umfpack_report_matrix<lu_elt_type> (nr, nc, Ap, Ai, Ax, static_cast<octave_idx_type> (1), control); - (*current_liboctave_error_handler) - ("sparse_lu: symbolic factorization failed"); - } - else - { - umfpack_report_symbolic<lu_elt_type> (Symbolic, control); + void *Symbolic; + Matrix Info (1, UMFPACK_INFO); + double *info = Info.fortran_vec (); + int status; - void *Numeric; - status = umfpack_numeric<lu_elt_type> (Ap, Ai, Ax, Symbolic, &Numeric, control, info); - umfpack_free_symbolic<lu_elt_type> (&Symbolic); + // Null loop so that qinit is imediately deallocated when not needed + do + { + OCTAVE_LOCAL_BUFFER (octave_idx_type, qinit, nc); - cond = Info (UMFPACK_RCOND); + for (octave_idx_type i = 0; i < nc; i++) + qinit[i] = static_cast<octave_idx_type> (Qinit (i)); + + status = umfpack_qsymbolic<lu_elt_type> (nr, nc, Ap, Ai, Ax, qinit, &Symbolic, control, info); + } + while (0); if (status < 0) { umfpack_report_status<lu_elt_type> (control, status); umfpack_report_info<lu_elt_type> (control, info); - umfpack_free_numeric<lu_elt_type> (&Numeric); + umfpack_free_symbolic<lu_elt_type> (&Symbolic); (*current_liboctave_error_handler) - ("sparse_lu: numeric factorization failed"); + ("sparse_lu: symbolic factorization failed"); } else { - umfpack_report_numeric<lu_elt_type> (Numeric, control); + umfpack_report_symbolic<lu_elt_type> (Symbolic, control); - octave_idx_type lnz, unz; - status = umfpack_get_lunz<lu_elt_type> (&lnz, &unz, Numeric); + void *Numeric; + status = umfpack_numeric<lu_elt_type> (Ap, Ai, Ax, Symbolic, &Numeric, control, info); + umfpack_free_symbolic<lu_elt_type> (&Symbolic); + + cond = Info (UMFPACK_RCOND); if (status < 0) { @@ -701,221 +683,237 @@ umfpack_free_numeric<lu_elt_type> (&Numeric); (*current_liboctave_error_handler) - ("sparse_lu: extracting LU factors failed"); + ("sparse_lu: numeric factorization failed"); } else { - octave_idx_type n_inner = (nr < nc ? nr : nc); - - if (lnz < 1) - Lfact = lu_type (n_inner, nr, static_cast<octave_idx_type> (1)); - else - Lfact = lu_type (n_inner, nr, lnz); - - octave_idx_type *Ltp = Lfact.cidx (); - octave_idx_type *Ltj = Lfact.ridx (); - lu_elt_type *Ltx = Lfact.data (); - - if (unz < 1) - Ufact = lu_type (n_inner, nc, static_cast<octave_idx_type> (1)); - else - Ufact = lu_type (n_inner, nc, unz); - - octave_idx_type *Up = Ufact.cidx (); - octave_idx_type *Uj = Ufact.ridx (); - lu_elt_type *Ux = Ufact.data (); + umfpack_report_numeric<lu_elt_type> (Numeric, control); - Rfact = SparseMatrix (nr, nr, nr); - for (octave_idx_type i = 0; i < nr; i++) - { - Rfact.xridx (i) = i; - Rfact.xcidx (i) = i; - } - Rfact.xcidx (nr) = nr; - double *Rx = Rfact.data (); - - P.resize (dim_vector (nr, 1)); - octave_idx_type *p = P.fortran_vec (); - - Q.resize (dim_vector (nc, 1)); - octave_idx_type *q = Q.fortran_vec (); - - octave_idx_type do_recip; - status = umfpack_get_numeric<lu_elt_type> (Ltp, Ltj, Ltx, Up, Uj, Ux, p, q, 0, &do_recip, Rx, Numeric); - - umfpack_free_numeric<lu_elt_type> (&Numeric); + octave_idx_type lnz, unz; + status = umfpack_get_lunz<lu_elt_type> (&lnz, &unz, Numeric); if (status < 0) { umfpack_report_status<lu_elt_type> (control, status); + umfpack_report_info<lu_elt_type> (control, info); + + umfpack_free_numeric<lu_elt_type> (&Numeric); (*current_liboctave_error_handler) ("sparse_lu: extracting LU factors failed"); } else { - Lfact = Lfact.transpose (); + octave_idx_type n_inner = (nr < nc ? nr : nc); - if (do_recip) - for (octave_idx_type i = 0; i < nr; i++) - Rx[i] = 1.0 / Rx[i]; + if (lnz < 1) + Lfact = lu_type (n_inner, nr, static_cast<octave_idx_type> (1)); + else + Lfact = lu_type (n_inner, nr, lnz); - umfpack_report_matrix<lu_elt_type> (nr, n_inner, Lfact.cidx (), Lfact.ridx (), Lfact.data (), static_cast<octave_idx_type> (1), control); - umfpack_report_matrix<lu_elt_type> (n_inner, nc, Ufact.cidx (), Ufact.ridx (), Ufact.data (), static_cast<octave_idx_type> (1), control); - umfpack_report_perm<lu_elt_type> (nr, p, control); - umfpack_report_perm<lu_elt_type> (nc, q, control); - } + octave_idx_type *Ltp = Lfact.cidx (); + octave_idx_type *Ltj = Lfact.ridx (); + lu_elt_type *Ltx = Lfact.data (); + + if (unz < 1) + Ufact = lu_type (n_inner, nc, static_cast<octave_idx_type> (1)); + else + Ufact = lu_type (n_inner, nc, unz); - umfpack_report_info<lu_elt_type> (control, info); - } - } - } - - if (udiag) - (*current_liboctave_error_handler) - ("Option udiag of incomplete LU not implemented"); + octave_idx_type *Up = Ufact.cidx (); + octave_idx_type *Uj = Ufact.ridx (); + lu_elt_type *Ux = Ufact.data (); -#else + Rfact = SparseMatrix (nr, nr, nr); + for (octave_idx_type i = 0; i < nr; i++) + { + Rfact.xridx (i) = i; + Rfact.xcidx (i) = i; + } + Rfact.xcidx (nr) = nr; + double *Rx = Rfact.data (); - octave_unused_parameter (a); - octave_unused_parameter (Qinit); - octave_unused_parameter (piv_thres); - octave_unused_parameter (scale); - octave_unused_parameter (FixedQ); - octave_unused_parameter (droptol); - octave_unused_parameter (milu); - octave_unused_parameter (udiag); + P.resize (dim_vector (nr, 1)); + octave_idx_type *p = P.fortran_vec (); - (*current_liboctave_error_handler) - ("support for UMFPACK was unavailable or disabled when liboctave was built"); + Q.resize (dim_vector (nc, 1)); + octave_idx_type *q = Q.fortran_vec (); -#endif -} + octave_idx_type do_recip; + status = umfpack_get_numeric<lu_elt_type> (Ltp, Ltj, Ltx, Up, Uj, Ux, p, q, 0, &do_recip, Rx, Numeric); -template <typename lu_type> -lu_type -sparse_lu<lu_type>::Y (void) const -{ - octave_idx_type nr = Lfact.rows (); - octave_idx_type nz = Lfact.cols (); - octave_idx_type nc = Ufact.cols (); + umfpack_free_numeric<lu_elt_type> (&Numeric); + + if (status < 0) + { + umfpack_report_status<lu_elt_type> (control, status); - lu_type Yout (nr, nc, Lfact.nnz () + Ufact.nnz () - (nr<nz?nr:nz)); - octave_idx_type ii = 0; - Yout.xcidx (0) = 0; + (*current_liboctave_error_handler) + ("sparse_lu: extracting LU factors failed"); + } + else + { + Lfact = Lfact.transpose (); - for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = Ufact.cidx (j); i < Ufact.cidx (j + 1); i++) - { - Yout.xridx (ii) = Ufact.ridx (i); - Yout.xdata (ii++) = Ufact.data (i); - } + if (do_recip) + for (octave_idx_type i = 0; i < nr; i++) + Rx[i] = 1.0 / Rx[i]; - if (j < nz) - { - // Note the +1 skips the 1.0 on the diagonal - for (octave_idx_type i = Lfact.cidx (j) + 1; - i < Lfact.cidx (j +1); i++) - { - Yout.xridx (ii) = Lfact.ridx (i); - Yout.xdata (ii++) = Lfact.data (i); + umfpack_report_matrix<lu_elt_type> (nr, n_inner, Lfact.cidx (), Lfact.ridx (), Lfact.data (), static_cast<octave_idx_type> (1), control); + umfpack_report_matrix<lu_elt_type> (n_inner, nc, Ufact.cidx (), Ufact.ridx (), Ufact.data (), static_cast<octave_idx_type> (1), control); + umfpack_report_perm<lu_elt_type> (nr, p, control); + umfpack_report_perm<lu_elt_type> (nc, q, control); + } + + umfpack_report_info<lu_elt_type> (control, info); + } } } - Yout.xcidx (j + 1) = ii; + if (udiag) + (*current_liboctave_error_handler) + ("Option udiag of incomplete LU not implemented"); + +#else + + octave_unused_parameter (a); + octave_unused_parameter (Qinit); + octave_unused_parameter (piv_thres); + octave_unused_parameter (scale); + octave_unused_parameter (FixedQ); + octave_unused_parameter (droptol); + octave_unused_parameter (milu); + octave_unused_parameter (udiag); + + (*current_liboctave_error_handler) + ("support for UMFPACK was unavailable or disabled when liboctave was built"); + +#endif } - return Yout; -} + template <typename lu_type> + lu_type + sparse_lu<lu_type>::Y (void) const + { + octave_idx_type nr = Lfact.rows (); + octave_idx_type nz = Lfact.cols (); + octave_idx_type nc = Ufact.cols (); + + lu_type Yout (nr, nc, Lfact.nnz () + Ufact.nnz () - (nr<nz?nr:nz)); + octave_idx_type ii = 0; + Yout.xcidx (0) = 0; -template <typename lu_type> -SparseMatrix -sparse_lu<lu_type>::Pr (void) const -{ - octave_idx_type nr = Lfact.rows (); + for (octave_idx_type j = 0; j < nc; j++) + { + for (octave_idx_type i = Ufact.cidx (j); i < Ufact.cidx (j + 1); i++) + { + Yout.xridx (ii) = Ufact.ridx (i); + Yout.xdata (ii++) = Ufact.data (i); + } - SparseMatrix Pout (nr, nr, nr); + if (j < nz) + { + // Note the +1 skips the 1.0 on the diagonal + for (octave_idx_type i = Lfact.cidx (j) + 1; + i < Lfact.cidx (j +1); i++) + { + Yout.xridx (ii) = Lfact.ridx (i); + Yout.xdata (ii++) = Lfact.data (i); + } + } - for (octave_idx_type i = 0; i < nr; i++) - { - Pout.cidx (i) = i; - Pout.ridx (P (i)) = i; - Pout.data (i) = 1; + Yout.xcidx (j + 1) = ii; + } + + return Yout; } - Pout.cidx (nr) = nr; + template <typename lu_type> + SparseMatrix + sparse_lu<lu_type>::Pr (void) const + { + octave_idx_type nr = Lfact.rows (); - return Pout; -} + SparseMatrix Pout (nr, nr, nr); -template <typename lu_type> -ColumnVector -sparse_lu<lu_type>::Pr_vec (void) const -{ - octave_idx_type nr = Lfact.rows (); + for (octave_idx_type i = 0; i < nr; i++) + { + Pout.cidx (i) = i; + Pout.ridx (P (i)) = i; + Pout.data (i) = 1; + } - ColumnVector Pout (nr); + Pout.cidx (nr) = nr; - for (octave_idx_type i = 0; i < nr; i++) - Pout.xelem (i) = static_cast<double> (P(i) + 1); - - return Pout; -} + return Pout; + } -template <typename lu_type> -PermMatrix -sparse_lu<lu_type>::Pr_mat (void) const -{ - return PermMatrix (P, false); -} + template <typename lu_type> + ColumnVector + sparse_lu<lu_type>::Pr_vec (void) const + { + octave_idx_type nr = Lfact.rows (); + + ColumnVector Pout (nr); -template <typename lu_type> -SparseMatrix -sparse_lu<lu_type>::Pc (void) const -{ - octave_idx_type nc = Ufact.cols (); + for (octave_idx_type i = 0; i < nr; i++) + Pout.xelem (i) = static_cast<double> (P(i) + 1); + + return Pout; + } - SparseMatrix Pout (nc, nc, nc); - - for (octave_idx_type i = 0; i < nc; i++) + template <typename lu_type> + PermMatrix + sparse_lu<lu_type>::Pr_mat (void) const { - Pout.cidx (i) = i; - Pout.ridx (i) = Q (i); - Pout.data (i) = 1; + return PermMatrix (P, false); } - Pout.cidx (nc) = nc; + template <typename lu_type> + SparseMatrix + sparse_lu<lu_type>::Pc (void) const + { + octave_idx_type nc = Ufact.cols (); - return Pout; -} + SparseMatrix Pout (nc, nc, nc); -template <typename lu_type> -ColumnVector -sparse_lu<lu_type>::Pc_vec (void) const -{ - octave_idx_type nc = Ufact.cols (); + for (octave_idx_type i = 0; i < nc; i++) + { + Pout.cidx (i) = i; + Pout.ridx (i) = Q (i); + Pout.data (i) = 1; + } - ColumnVector Pout (nc); + Pout.cidx (nc) = nc; - for (octave_idx_type i = 0; i < nc; i++) - Pout.xelem (i) = static_cast<double> (Q(i) + 1); + return Pout; + } - return Pout; -} + template <typename lu_type> + ColumnVector + sparse_lu<lu_type>::Pc_vec (void) const + { + octave_idx_type nc = Ufact.cols (); + + ColumnVector Pout (nc); + + for (octave_idx_type i = 0; i < nc; i++) + Pout.xelem (i) = static_cast<double> (Q(i) + 1); + + return Pout; + } -template <typename lu_type> -PermMatrix -sparse_lu<lu_type>::Pc_mat (void) const -{ - return PermMatrix (Q, true); + template <typename lu_type> + PermMatrix + sparse_lu<lu_type>::Pc_mat (void) const + { + return PermMatrix (Q, true); + } + + // Instantiations we need. + + template class sparse_lu<SparseMatrix>; + + template class sparse_lu<SparseComplexMatrix>; + } } - -// Instantiations we need. - -template class sparse_lu<SparseMatrix>; - -template class sparse_lu<SparseComplexMatrix>; - -} -}
--- a/liboctave/numeric/sparse-lu.h Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/sparse-lu.h Wed Aug 17 10:55:38 2016 -0400 @@ -32,93 +32,91 @@ namespace octave { -namespace math -{ - -// If the sparse matrix classes become templated on the element type -// (i.e., sparse_matrix<double>), then it might be best to make the -// template parameter of this class also be the element type instead -// of the matrix type. + namespace math + { + // If the sparse matrix classes become templated on the element type + // (i.e., sparse_matrix<double>), then it might be best to make the + // template parameter of this class also be the element type instead + // of the matrix type. -template <typename lu_type> -class -sparse_lu -{ -public: + template <typename lu_type> + class + sparse_lu + { + public: - typedef typename lu_type::element_type lu_elt_type; + typedef typename lu_type::element_type lu_elt_type; - sparse_lu (void) - : Lfact (), Ufact (), Rfact (), cond (0), P (), Q () { } + sparse_lu (void) + : Lfact (), Ufact (), Rfact (), cond (0), P (), Q () { } + + sparse_lu (const lu_type& a, const Matrix& piv_thres = Matrix (), + bool scale = false); - sparse_lu (const lu_type& a, const Matrix& piv_thres = Matrix (), - bool scale = false); + sparse_lu (const lu_type& a, const ColumnVector& Qinit, + const Matrix& piv_thres, bool scale = false, + bool FixedQ = false, double droptol = -1.0, + bool milu = false, bool udiag = false); - sparse_lu (const lu_type& a, const ColumnVector& Qinit, - const Matrix& piv_thres, bool scale = false, - bool FixedQ = false, double droptol = -1.0, - bool milu = false, bool udiag = false); + sparse_lu (const sparse_lu& a) + : Lfact (a.Lfact), Ufact (a.Ufact), Rfact (), cond (a.cond), + P (a.P), Q (a.Q) + { } - sparse_lu (const sparse_lu& a) - : Lfact (a.Lfact), Ufact (a.Ufact), Rfact (), cond (a.cond), - P (a.P), Q (a.Q) - { } + sparse_lu& operator = (const sparse_lu& a) + { + if (this != &a) + { + Lfact = a.Lfact; + Ufact = a.Ufact; + cond = a.cond; + P = a.P; + Q = a.Q; + } - sparse_lu& operator = (const sparse_lu& a) - { - if (this != &a) - { - Lfact = a.Lfact; - Ufact = a.Ufact; - cond = a.cond; - P = a.P; - Q = a.Q; + return *this; } - return *this; - } + virtual ~sparse_lu (void) { } + + lu_type L (void) const { return Lfact; } - virtual ~sparse_lu (void) { } + lu_type U (void) const { return Ufact; } - lu_type L (void) const { return Lfact; } + SparseMatrix R (void) const { return Rfact; } - lu_type U (void) const { return Ufact; } + lu_type Y (void) const; - SparseMatrix R (void) const { return Rfact; } + SparseMatrix Pc (void) const; - lu_type Y (void) const; - - SparseMatrix Pc (void) const; + SparseMatrix Pr (void) const; - SparseMatrix Pr (void) const; + ColumnVector Pc_vec (void) const; - ColumnVector Pc_vec (void) const; + ColumnVector Pr_vec (void) const; - ColumnVector Pr_vec (void) const; + PermMatrix Pc_mat (void) const; - PermMatrix Pc_mat (void) const; + PermMatrix Pr_mat (void) const; - PermMatrix Pr_mat (void) const; - - const octave_idx_type * row_perm (void) const { return P.fortran_vec (); } + const octave_idx_type * row_perm (void) const { return P.fortran_vec (); } - const octave_idx_type * col_perm (void) const { return Q.fortran_vec (); } + const octave_idx_type * col_perm (void) const { return Q.fortran_vec (); } - double rcond (void) const { return cond; } + double rcond (void) const { return cond; } -protected: + protected: - lu_type Lfact; - lu_type Ufact; - SparseMatrix Rfact; - - double cond; + lu_type Lfact; + lu_type Ufact; + SparseMatrix Rfact; - MArray<octave_idx_type> P; - MArray<octave_idx_type> Q; -}; + double cond; -} + MArray<octave_idx_type> P; + MArray<octave_idx_type> Q; + }; + } } #endif
--- a/liboctave/numeric/sparse-qr.cc Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/sparse-qr.cc Wed Aug 17 10:55:38 2016 -0400 @@ -32,2283 +32,2281 @@ namespace octave { -namespace math -{ - -template <typename SPARSE_T> -class -cxsparse_types -{ -}; - -template <> -class -cxsparse_types<SparseMatrix> -{ -public: + namespace math + { + template <typename SPARSE_T> + class + cxsparse_types + { + }; + + template <> + class + cxsparse_types<SparseMatrix> + { + public: #if defined (HAVE_CXSPARSE) - typedef CXSPARSE_DNAME (s) symbolic_type; - typedef CXSPARSE_DNAME (n) numeric_type; + typedef CXSPARSE_DNAME (s) symbolic_type; + typedef CXSPARSE_DNAME (n) numeric_type; #else - typedef void symbolic_type; - typedef void numeric_type; + typedef void symbolic_type; + typedef void numeric_type; #endif -}; - -template <> -class -cxsparse_types<SparseComplexMatrix> -{ -public: + }; + + template <> + class + cxsparse_types<SparseComplexMatrix> + { + public: #if defined (HAVE_CXSPARSE) - typedef CXSPARSE_ZNAME (s) symbolic_type; - typedef CXSPARSE_ZNAME (n) numeric_type; + typedef CXSPARSE_ZNAME (s) symbolic_type; + typedef CXSPARSE_ZNAME (n) numeric_type; #else - typedef void symbolic_type; - typedef void numeric_type; + typedef void symbolic_type; + typedef void numeric_type; #endif -}; - -template <typename SPARSE_T> -class sparse_qr<SPARSE_T>::sparse_qr_rep -{ -public: - - sparse_qr_rep (const SPARSE_T& a, int order); - - ~sparse_qr_rep (void); - - bool ok (void) const - { + }; + + template <typename SPARSE_T> + class sparse_qr<SPARSE_T>::sparse_qr_rep + { + public: + + sparse_qr_rep (const SPARSE_T& a, int order); + + ~sparse_qr_rep (void); + + bool ok (void) const + { #if defined (HAVE_CXSPARSE) - return (N && S); + return (N && S); #else - return false; + return false; #endif - } - - SPARSE_T V (void) const; - - ColumnVector Pinv (void) const; - - ColumnVector P (void) const; - - SPARSE_T R (bool econ) const; - - typename SPARSE_T::dense_matrix_type - C (const typename SPARSE_T::dense_matrix_type& b) const; - - typename SPARSE_T::dense_matrix_type - Q (void) const; - - octave_refcount<int> count; - - octave_idx_type nrows; - octave_idx_type ncols; - - typename cxsparse_types<SPARSE_T>::symbolic_type *S; - typename cxsparse_types<SPARSE_T>::numeric_type *N; - - template <typename RHS_T, typename RET_T> - RET_T - tall_solve (const RHS_T& b, octave_idx_type& info) const; - - template <typename RHS_T, typename RET_T> - RET_T - wide_solve (const RHS_T& b, octave_idx_type& info) const; - -private: - - // No copying! - - sparse_qr_rep (const sparse_qr_rep&); - - sparse_qr_rep& operator = (const sparse_qr_rep&); -}; - -template <typename SPARSE_T> -ColumnVector -sparse_qr<SPARSE_T>::sparse_qr_rep::Pinv (void) const -{ + } + + SPARSE_T V (void) const; + + ColumnVector Pinv (void) const; + + ColumnVector P (void) const; + + SPARSE_T R (bool econ) const; + + typename SPARSE_T::dense_matrix_type + C (const typename SPARSE_T::dense_matrix_type& b) const; + + typename SPARSE_T::dense_matrix_type + Q (void) const; + + octave_refcount<int> count; + + octave_idx_type nrows; + octave_idx_type ncols; + + typename cxsparse_types<SPARSE_T>::symbolic_type *S; + typename cxsparse_types<SPARSE_T>::numeric_type *N; + + template <typename RHS_T, typename RET_T> + RET_T + tall_solve (const RHS_T& b, octave_idx_type& info) const; + + template <typename RHS_T, typename RET_T> + RET_T + wide_solve (const RHS_T& b, octave_idx_type& info) const; + + private: + + // No copying! + + sparse_qr_rep (const sparse_qr_rep&); + + sparse_qr_rep& operator = (const sparse_qr_rep&); + }; + + template <typename SPARSE_T> + ColumnVector + sparse_qr<SPARSE_T>::sparse_qr_rep::Pinv (void) const + { #if defined (HAVE_CXSPARSE) - ColumnVector ret (N->L->m); - - for (octave_idx_type i = 0; i < N->L->m; i++) - ret.xelem (i) = S->pinv[i]; - - return ret; + ColumnVector ret (N->L->m); + + for (octave_idx_type i = 0; i < N->L->m; i++) + ret.xelem (i) = S->pinv[i]; + + return ret; #else - return ColumnVector (); + return ColumnVector (); #endif -} - -template <typename SPARSE_T> -ColumnVector -sparse_qr<SPARSE_T>::sparse_qr_rep::P (void) const -{ + } + + template <typename SPARSE_T> + ColumnVector + sparse_qr<SPARSE_T>::sparse_qr_rep::P (void) const + { #if defined (HAVE_CXSPARSE) - ColumnVector ret (N->L->m); - - for (octave_idx_type i = 0; i < N->L->m; i++) - ret.xelem (S->pinv[i]) = i; - - return ret; + ColumnVector ret (N->L->m); + + for (octave_idx_type i = 0; i < N->L->m; i++) + ret.xelem (S->pinv[i]) = i; + + return ret; #else - return ColumnVector (); + return ColumnVector (); #endif -} - -// Specializations. - -// Real-valued matrices. - -template <> -sparse_qr<SparseMatrix>::sparse_qr_rep::sparse_qr_rep - (const SparseMatrix& a, int order) - : count (1), nrows (a.rows ()), ncols (a.columns ()) + } + + // Specializations. + + // Real-valued matrices. + + template <> + sparse_qr<SparseMatrix>::sparse_qr_rep::sparse_qr_rep + (const SparseMatrix& a, int order) + : count (1), nrows (a.rows ()), ncols (a.columns ()) #if defined (HAVE_CXSPARSE) - , S (0), N (0) + , S (0), N (0) #endif -{ + { #if defined (HAVE_CXSPARSE) - CXSPARSE_DNAME () A; - - A.nzmax = a.nnz (); - A.m = nrows; - A.n = ncols; - // Cast away const on A, with full knowledge that CSparse won't touch it - // Prevents the methods below making a copy of the data. - A.p = const_cast<octave_idx_type *>(a.cidx ()); - A.i = const_cast<octave_idx_type *>(a.ridx ()); - A.x = const_cast<double *>(a.data ()); - A.nz = -1; - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - S = CXSPARSE_DNAME (_sqr) (order, &A, 1); - N = CXSPARSE_DNAME (_qr) (&A, S); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - if (! N) - (*current_liboctave_error_handler) - ("sparse_qr: sparse matrix QR factorization filled"); - - count = 1; + CXSPARSE_DNAME () A; + + A.nzmax = a.nnz (); + A.m = nrows; + A.n = ncols; + // Cast away const on A, with full knowledge that CSparse won't touch it + // Prevents the methods below making a copy of the data. + A.p = const_cast<octave_idx_type *>(a.cidx ()); + A.i = const_cast<octave_idx_type *>(a.ridx ()); + A.x = const_cast<double *>(a.data ()); + A.nz = -1; + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + S = CXSPARSE_DNAME (_sqr) (order, &A, 1); + N = CXSPARSE_DNAME (_qr) (&A, S); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + if (! N) + (*current_liboctave_error_handler) + ("sparse_qr: sparse matrix QR factorization filled"); + + count = 1; #else - octave_unused_parameter (order); - - (*current_liboctave_error_handler) - ("sparse_qr: support for CXSparse was unavailable or disabled when liboctave was built"); + octave_unused_parameter (order); + + (*current_liboctave_error_handler) + ("sparse_qr: support for CXSparse was unavailable or disabled when liboctave was built"); #endif -} - -template <> -sparse_qr<SparseMatrix>::sparse_qr_rep::~sparse_qr_rep (void) -{ + } + + template <> + sparse_qr<SparseMatrix>::sparse_qr_rep::~sparse_qr_rep (void) + { #if defined (HAVE_CXSPARSE) - CXSPARSE_DNAME (_sfree) (S); - CXSPARSE_DNAME (_nfree) (N); + CXSPARSE_DNAME (_sfree) (S); + CXSPARSE_DNAME (_nfree) (N); #endif -} - -template <> -SparseMatrix -sparse_qr<SparseMatrix>::sparse_qr_rep::V (void) const -{ + } + + template <> + SparseMatrix + sparse_qr<SparseMatrix>::sparse_qr_rep::V (void) const + { #if defined (HAVE_CXSPARSE) - // Drop zeros from V and sort - // FIXME: Is the double transpose to sort necessary? - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_dropzeros) (N->L); - CXSPARSE_DNAME () *D = CXSPARSE_DNAME (_transpose) (N->L, 1); - CXSPARSE_DNAME (_spfree) (N->L); - N->L = CXSPARSE_DNAME (_transpose) (D, 1); - CXSPARSE_DNAME (_spfree) (D); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - octave_idx_type nc = N->L->n; - octave_idx_type nz = N->L->nzmax; - SparseMatrix ret (N->L->m, nc, nz); - - for (octave_idx_type j = 0; j < nc+1; j++) - ret.xcidx (j) = N->L->p[j]; - - for (octave_idx_type j = 0; j < nz; j++) - { - ret.xridx (j) = N->L->i[j]; - ret.xdata (j) = N->L->x[j]; - } - - return ret; + // Drop zeros from V and sort + // FIXME: Is the double transpose to sort necessary? + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_dropzeros) (N->L); + CXSPARSE_DNAME () *D = CXSPARSE_DNAME (_transpose) (N->L, 1); + CXSPARSE_DNAME (_spfree) (N->L); + N->L = CXSPARSE_DNAME (_transpose) (D, 1); + CXSPARSE_DNAME (_spfree) (D); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + octave_idx_type nc = N->L->n; + octave_idx_type nz = N->L->nzmax; + SparseMatrix ret (N->L->m, nc, nz); + + for (octave_idx_type j = 0; j < nc+1; j++) + ret.xcidx (j) = N->L->p[j]; + + for (octave_idx_type j = 0; j < nz; j++) + { + ret.xridx (j) = N->L->i[j]; + ret.xdata (j) = N->L->x[j]; + } + + return ret; #else - return SparseMatrix (); + return SparseMatrix (); #endif -} - -template <> -SparseMatrix -sparse_qr<SparseMatrix>::sparse_qr_rep::R (bool econ) const -{ + } + + template <> + SparseMatrix + sparse_qr<SparseMatrix>::sparse_qr_rep::R (bool econ) const + { #if defined (HAVE_CXSPARSE) - // Drop zeros from R and sort - // FIXME: Is the double transpose to sort necessary? - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_dropzeros) (N->U); - CXSPARSE_DNAME () *D = CXSPARSE_DNAME (_transpose) (N->U, 1); - CXSPARSE_DNAME (_spfree) (N->U); - N->U = CXSPARSE_DNAME (_transpose) (D, 1); - CXSPARSE_DNAME (_spfree) (D); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - octave_idx_type nc = N->U->n; - octave_idx_type nz = N->U->nzmax; - - SparseMatrix ret ((econ ? (nc > nrows ? nrows : nc) : nrows), nc, nz); - - for (octave_idx_type j = 0; j < nc+1; j++) - ret.xcidx (j) = N->U->p[j]; - - for (octave_idx_type j = 0; j < nz; j++) - { - ret.xridx (j) = N->U->i[j]; - ret.xdata (j) = N->U->x[j]; - } - - return ret; + // Drop zeros from R and sort + // FIXME: Is the double transpose to sort necessary? + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_dropzeros) (N->U); + CXSPARSE_DNAME () *D = CXSPARSE_DNAME (_transpose) (N->U, 1); + CXSPARSE_DNAME (_spfree) (N->U); + N->U = CXSPARSE_DNAME (_transpose) (D, 1); + CXSPARSE_DNAME (_spfree) (D); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + octave_idx_type nc = N->U->n; + octave_idx_type nz = N->U->nzmax; + + SparseMatrix ret ((econ ? (nc > nrows ? nrows : nc) : nrows), nc, nz); + + for (octave_idx_type j = 0; j < nc+1; j++) + ret.xcidx (j) = N->U->p[j]; + + for (octave_idx_type j = 0; j < nz; j++) + { + ret.xridx (j) = N->U->i[j]; + ret.xdata (j) = N->U->x[j]; + } + + return ret; #else - octave_unused_parameter (econ); - - return SparseMatrix (); + octave_unused_parameter (econ); + + return SparseMatrix (); #endif -} - -template <> -Matrix -sparse_qr<SparseMatrix>::sparse_qr_rep::C (const Matrix& b) const -{ + } + + template <> + Matrix + sparse_qr<SparseMatrix>::sparse_qr_rep::C (const Matrix& b) const + { #if defined (HAVE_CXSPARSE) - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - octave_idx_type nc = N->L->n; - octave_idx_type nr = nrows; - - const double *bvec = b.fortran_vec (); - - Matrix ret (b_nr, b_nc); - double *vec = ret.fortran_vec (); - - if (nr < 0 || nc < 0 || nr != b_nr) - (*current_liboctave_error_handler) ("matrix dimension mismatch"); - - if (nr == 0 || nc == 0 || b_nc == 0) - ret = Matrix (nc, b_nc, 0.0); - else - { - OCTAVE_LOCAL_BUFFER (double, buf, S->m2); - - for (volatile octave_idx_type j = 0, idx = 0; j < b_nc; j++, idx+=b_nr) + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + octave_idx_type nc = N->L->n; + octave_idx_type nr = nrows; + + const double *bvec = b.fortran_vec (); + + Matrix ret (b_nr, b_nc); + double *vec = ret.fortran_vec (); + + if (nr < 0 || nc < 0 || nr != b_nr) + (*current_liboctave_error_handler) ("matrix dimension mismatch"); + + if (nr == 0 || nc == 0 || b_nc == 0) + ret = Matrix (nc, b_nc, 0.0); + else { - octave_quit (); - - for (octave_idx_type i = nr; i < S->m2; i++) - buf[i] = 0.; - - volatile octave_idx_type nm = (nr < nc ? nr : nc); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_ipvec) (S->pinv, bvec + idx, buf, b_nr); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type i = 0; i < nm; i++) + OCTAVE_LOCAL_BUFFER (double, buf, S->m2); + + for (volatile octave_idx_type j = 0, idx = 0; j < b_nc; j++, idx+=b_nr) { octave_quit (); + for (octave_idx_type i = nr; i < S->m2; i++) + buf[i] = 0.; + + volatile octave_idx_type nm = (nr < nc ? nr : nc); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (N->L, i, N->B[i], buf); + CXSPARSE_DNAME (_ipvec) (S->pinv, bvec + idx, buf, b_nr); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type i = 0; i < nm; i++) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (N->L, i, N->B[i], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + for (octave_idx_type i = 0; i < b_nr; i++) + vec[i+idx] = buf[i]; } - - for (octave_idx_type i = 0; i < b_nr; i++) - vec[i+idx] = buf[i]; } - } - - return ret; + + return ret; #else - octave_unused_parameter (b); - - return Matrix (); + octave_unused_parameter (b); + + return Matrix (); #endif -} - -template <> -Matrix -sparse_qr<SparseMatrix>::sparse_qr_rep::Q (void) const -{ + } + + template <> + Matrix + sparse_qr<SparseMatrix>::sparse_qr_rep::Q (void) const + { #if defined (HAVE_CXSPARSE) - octave_idx_type nc = N->L->n; - octave_idx_type nr = nrows; - Matrix ret (nr, nr); - double *vec = ret.fortran_vec (); - - if (nr < 0 || nc < 0) - (*current_liboctave_error_handler) ("matrix dimension mismatch"); - - if (nr == 0 || nc == 0) - ret = Matrix (nc, nr, 0.0); - else + octave_idx_type nc = N->L->n; + octave_idx_type nr = nrows; + Matrix ret (nr, nr); + double *vec = ret.fortran_vec (); + + if (nr < 0 || nc < 0) + (*current_liboctave_error_handler) ("matrix dimension mismatch"); + + if (nr == 0 || nc == 0) + ret = Matrix (nc, nr, 0.0); + else + { + OCTAVE_LOCAL_BUFFER (double, bvec, nr + 1); + + for (octave_idx_type i = 0; i < nr; i++) + bvec[i] = 0.; + + OCTAVE_LOCAL_BUFFER (double, buf, S->m2); + + for (volatile octave_idx_type j = 0, idx = 0; j < nr; j++, idx+=nr) + { + octave_quit (); + + bvec[j] = 1.0; + for (octave_idx_type i = nr; i < S->m2; i++) + buf[i] = 0.; + + volatile octave_idx_type nm = (nr < nc ? nr : nc); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_ipvec) (S->pinv, bvec, buf, nr); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type i = 0; i < nm; i++) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (N->L, i, N->B[i], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + for (octave_idx_type i = 0; i < nr; i++) + vec[i+idx] = buf[i]; + + bvec[j] = 0.0; + } + } + + return ret.transpose (); + +#else + + return Matrix (); + +#endif + } + + template <> + template <> + Matrix + sparse_qr<SparseMatrix>::sparse_qr_rep::tall_solve<MArray<double>, Matrix> + (const MArray<double>& b, octave_idx_type& info) const { - OCTAVE_LOCAL_BUFFER (double, bvec, nr + 1); - - for (octave_idx_type i = 0; i < nr; i++) - bvec[i] = 0.; + info = -1; + +#if defined (HAVE_CXSPARSE) + + octave_idx_type nr = nrows; + octave_idx_type nc = ncols; + + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nr = b.rows (); + + const double *bvec = b.data (); + + Matrix x (nc, b_nc); + double *vec = x.fortran_vec (); OCTAVE_LOCAL_BUFFER (double, buf, S->m2); - for (volatile octave_idx_type j = 0, idx = 0; j < nr; j++, idx+=nr) + for (volatile octave_idx_type i = 0, idx = 0, bidx = 0; i < b_nc; + i++, idx+=nc, bidx+=b_nr) { octave_quit (); - bvec[j] = 1.0; - for (octave_idx_type i = nr; i < S->m2; i++) - buf[i] = 0.; - - volatile octave_idx_type nm = (nr < nc ? nr : nc); + for (octave_idx_type j = nr; j < S->m2; j++) + buf[j] = 0.; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_ipvec) (S->pinv, bvec, buf, nr); + CXSPARSE_DNAME (_ipvec) (S->pinv, bvec + bidx, buf, nr); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type i = 0; i < nm; i++) + for (volatile octave_idx_type j = 0; j < nc; j++) { octave_quit (); BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (N->L, i, N->B[i], buf); + CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; } - for (octave_idx_type i = 0; i < nr; i++) - vec[i+idx] = buf[i]; - - bvec[j] = 0.0; - } - } - - return ret.transpose (); - -#else - - return Matrix (); - -#endif -} - -template <> -template <> -Matrix -sparse_qr<SparseMatrix>::sparse_qr_rep::tall_solve<MArray<double>, Matrix> - (const MArray<double>& b, octave_idx_type& info) const -{ - info = -1; - -#if defined (HAVE_CXSPARSE) - - octave_idx_type nr = nrows; - octave_idx_type nc = ncols; - - octave_idx_type b_nc = b.cols (); - octave_idx_type b_nr = b.rows (); - - const double *bvec = b.data (); - - Matrix x (nc, b_nc); - double *vec = x.fortran_vec (); - - OCTAVE_LOCAL_BUFFER (double, buf, S->m2); - - for (volatile octave_idx_type i = 0, idx = 0, bidx = 0; i < b_nc; - i++, idx+=nc, bidx+=b_nr) - { - octave_quit (); - - for (octave_idx_type j = nr; j < S->m2; j++) - buf[j] = 0.; - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_ipvec) (S->pinv, bvec + bidx, buf, nr); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); + CXSPARSE_DNAME (_usolve) (N->U, buf); + CXSPARSE_DNAME (_ipvec) (S->q, buf, vec + idx, nc); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_usolve) (N->U, buf); - CXSPARSE_DNAME (_ipvec) (S->q, buf, vec + idx, nc); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - info = 0; - - return x; + info = 0; + + return x; #else - octave_unused_parameter (b); - - return Matrix (); - -#endif -} - -template <> -template <> -Matrix -sparse_qr<SparseMatrix>::sparse_qr_rep::wide_solve<MArray<double>, Matrix> - (const MArray<double>& b, octave_idx_type& info) const -{ - info = -1; - -#if defined (HAVE_CXSPARSE) - - // These are swapped because the original matrix was transposed in - // sparse_qr<SparseMatrix>::solve. - - octave_idx_type nr = ncols; - octave_idx_type nc = nrows; - - octave_idx_type b_nc = b.cols (); - octave_idx_type b_nr = b.rows (); - - const double *bvec = b.data (); - - Matrix x (nc, b_nc); - double *vec = x.fortran_vec (); - - volatile octave_idx_type nbuf = (nc > S->m2 ? nc : S->m2); - - OCTAVE_LOCAL_BUFFER (double, buf, nbuf); - - for (volatile octave_idx_type i = 0, idx = 0, bidx = 0; i < b_nc; - i++, idx+=nc, bidx+=b_nr) - { - octave_quit (); - - for (octave_idx_type j = nr; j < nbuf; j++) - buf[j] = 0.; - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_pvec) (S->q, bvec + bidx, buf, nr); - CXSPARSE_DNAME (_utsolve) (N->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = nr-1; j >= 0; j--) - { - octave_quit (); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_pvec) (S->pinv, buf, vec + idx, nc); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - info = 0; - - return x; - -#else - - octave_unused_parameter (b); - - return Matrix (); + octave_unused_parameter (b); + + return Matrix (); #endif -} - -template <> -template <> -SparseMatrix -sparse_qr<SparseMatrix>::sparse_qr_rep::tall_solve<SparseMatrix, SparseMatrix> - (const SparseMatrix& b, octave_idx_type& info) const -{ - info = -1; - -#if defined (HAVE_CXSPARSE) - - octave_idx_type nr = nrows; - octave_idx_type nc = ncols; - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - SparseMatrix x (nc, b_nc, b.nnz ()); - x.xcidx (0) = 0; - - volatile octave_idx_type x_nz = b.nnz (); - volatile octave_idx_type ii = 0; - - OCTAVE_LOCAL_BUFFER (double, Xx, (b_nr > nc ? b_nr : nc)); - OCTAVE_LOCAL_BUFFER (double, buf, S->m2); - - for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) + } + + template <> + template <> + Matrix + sparse_qr<SparseMatrix>::sparse_qr_rep::wide_solve<MArray<double>, Matrix> + (const MArray<double>& b, octave_idx_type& info) const { - octave_quit (); - - for (octave_idx_type j = 0; j < b_nr; j++) - Xx[j] = b.xelem (j,i); - - for (octave_idx_type j = nr; j < S->m2; j++) - buf[j] = 0.; - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_ipvec) (S->pinv, Xx, buf, nr); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_usolve) (N->U, buf); - CXSPARSE_DNAME (_ipvec) (S->q, buf, Xx, nc); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (octave_idx_type j = 0; j < nc; j++) - { - double tmp = Xx[j]; - - if (tmp != 0.0) - { - if (ii == x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - i) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - x.change_capacity (sz); - x_nz = sz; - } - - x.xdata (ii) = tmp; - x.xridx (ii++) = j; - } - } - - x.xcidx (i+1) = ii; - } - - info = 0; - - return x; - -#else - - octave_unused_parameter (b); - - return SparseMatrix (); - -#endif -} - -template <> -template <> -SparseMatrix -sparse_qr<SparseMatrix>::sparse_qr_rep::wide_solve<SparseMatrix, SparseMatrix> - (const SparseMatrix& b, octave_idx_type& info) const -{ - info = -1; - -#if defined (HAVE_CXSPARSE) - - // These are swapped because the original matrix was transposed in - // sparse_qr<SparseMatrix>::solve. - - octave_idx_type nr = ncols; - octave_idx_type nc = nrows; - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - SparseMatrix x (nc, b_nc, b.nnz ()); - x.xcidx (0) = 0; - - volatile octave_idx_type x_nz = b.nnz (); - volatile octave_idx_type ii = 0; - volatile octave_idx_type nbuf = (nc > S->m2 ? nc : S->m2); - - OCTAVE_LOCAL_BUFFER (double, Xx, (b_nr > nc ? b_nr : nc)); - OCTAVE_LOCAL_BUFFER (double, buf, nbuf); - - for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) - { - octave_quit (); - - for (octave_idx_type j = 0; j < b_nr; j++) - Xx[j] = b.xelem (j,i); - - for (octave_idx_type j = nr; j < nbuf; j++) - buf[j] = 0.; - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_pvec) (S->q, Xx, buf, nr); - CXSPARSE_DNAME (_utsolve) (N->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = nr-1; j >= 0; j--) - { - octave_quit (); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_pvec) (S->pinv, buf, Xx, nc); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (octave_idx_type j = 0; j < nc; j++) - { - double tmp = Xx[j]; - - if (tmp != 0.0) - { - if (ii == x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - i) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - x.change_capacity (sz); - x_nz = sz; - } - - x.xdata (ii) = tmp; - x.xridx (ii++) = j; - } - } - - x.xcidx (i+1) = ii; - } - - info = 0; - - x.maybe_compress (); - - return x; - -#else - - octave_unused_parameter (b); - - return SparseMatrix (); - -#endif -} - -template <> -template <> -ComplexMatrix -sparse_qr<SparseMatrix>::sparse_qr_rep::tall_solve<MArray<Complex>, ComplexMatrix> - (const MArray<Complex>& b, octave_idx_type& info) const -{ - info = -1; + info = -1; #if defined (HAVE_CXSPARSE) - octave_idx_type nr = nrows; - octave_idx_type nc = ncols; - - octave_idx_type b_nc = b.cols (); - octave_idx_type b_nr = b.rows (); - - ComplexMatrix x (nc, b_nc); - Complex *vec = x.fortran_vec (); - - OCTAVE_LOCAL_BUFFER (double, Xx, (b_nr > nc ? b_nr : nc)); - OCTAVE_LOCAL_BUFFER (double, Xz, (b_nr > nc ? b_nr : nc)); - OCTAVE_LOCAL_BUFFER (double, buf, S->m2); - - for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) - { - octave_quit (); - - for (octave_idx_type j = 0; j < b_nr; j++) - { - Complex c = b.xelem (j,i); - Xx[j] = c.real (); - Xz[j] = c.imag (); - } - - for (octave_idx_type j = nr; j < S->m2; j++) - buf[j] = 0.; - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_ipvec) (S->pinv, Xx, buf, nr); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = 0; j < nc; j++) + // These are swapped because the original matrix was transposed in + // sparse_qr<SparseMatrix>::solve. + + octave_idx_type nr = ncols; + octave_idx_type nc = nrows; + + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nr = b.rows (); + + const double *bvec = b.data (); + + Matrix x (nc, b_nc); + double *vec = x.fortran_vec (); + + volatile octave_idx_type nbuf = (nc > S->m2 ? nc : S->m2); + + OCTAVE_LOCAL_BUFFER (double, buf, nbuf); + + for (volatile octave_idx_type i = 0, idx = 0, bidx = 0; i < b_nc; + i++, idx+=nc, bidx+=b_nr) { octave_quit (); - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_usolve) (N->U, buf); - CXSPARSE_DNAME (_ipvec) (S->q, buf, Xx, nc); - - for (octave_idx_type j = nr; j < S->m2; j++) - buf[j] = 0.; - - CXSPARSE_DNAME (_ipvec) (S->pinv, Xz, buf, nr); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = 0.; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); + CXSPARSE_DNAME (_pvec) (S->q, bvec + bidx, buf, nr); + CXSPARSE_DNAME (_utsolve) (N->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_pvec) (S->pinv, buf, vec + idx, nc); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_usolve) (N->U, buf); - CXSPARSE_DNAME (_ipvec) (S->q, buf, Xz, nc); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (octave_idx_type j = 0; j < nc; j++) - vec[j+idx] = Complex (Xx[j], Xz[j]); - } - - info = 0; - - return x; - -#else - - octave_unused_parameter (b); - - return ComplexMatrix (); - -#endif -} - -template <> -template <> -ComplexMatrix -sparse_qr<SparseMatrix>::sparse_qr_rep::wide_solve<MArray<Complex>, ComplexMatrix> - (const MArray<Complex>& b, octave_idx_type& info) const -{ - info = -1; - -#if defined (HAVE_CXSPARSE) - - // These are swapped because the original matrix was transposed in - // sparse_qr<SparseMatrix>::solve. - - octave_idx_type nr = ncols; - octave_idx_type nc = nrows; - - octave_idx_type b_nc = b.cols (); - octave_idx_type b_nr = b.rows (); - - ComplexMatrix x (nc, b_nc); - Complex *vec = x.fortran_vec (); - - volatile octave_idx_type nbuf = (nc > S->m2 ? nc : S->m2); - - OCTAVE_LOCAL_BUFFER (double, Xx, (b_nr > nc ? b_nr : nc)); - OCTAVE_LOCAL_BUFFER (double, Xz, (b_nr > nc ? b_nr : nc)); - OCTAVE_LOCAL_BUFFER (double, buf, nbuf); - - for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) - { - octave_quit (); - - for (octave_idx_type j = 0; j < b_nr; j++) - { - Complex c = b.xelem (j,i); - Xx[j] = c.real (); - Xz[j] = c.imag (); - } - - for (octave_idx_type j = nr; j < nbuf; j++) - buf[j] = 0.; - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_pvec) (S->q, Xx, buf, nr); - CXSPARSE_DNAME (_utsolve) (N->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = nr-1; j >= 0; j--) - { - octave_quit (); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_pvec) (S->pinv, buf, Xx, nc); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (octave_idx_type j = nr; j < nbuf; j++) - buf[j] = 0.; - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_pvec) (S->q, Xz, buf, nr); - CXSPARSE_DNAME (_utsolve) (N->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = nr-1; j >= 0; j--) - { - octave_quit (); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_pvec) (S->pinv, buf, Xz, nc); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (octave_idx_type j = 0; j < nc; j++) - vec[j+idx] = Complex (Xx[j], Xz[j]); - } - - info = 0; - - return x; + info = 0; + + return x; #else - octave_unused_parameter (b); - - return ComplexMatrix (); - -#endif -} - -// Complex-valued matrices. - -template <> -sparse_qr<SparseComplexMatrix>::sparse_qr_rep::sparse_qr_rep - (const SparseComplexMatrix& a, int order) - : count (1), nrows (a.rows ()), ncols (a.columns ()) -#if defined (HAVE_CXSPARSE) - , S (0), N (0) -#endif -{ -#if defined (HAVE_CXSPARSE) - - CXSPARSE_ZNAME () A; - - A.nzmax = a.nnz (); - A.m = nrows; - A.n = ncols; - // Cast away const on A, with full knowledge that CSparse won't touch it - // Prevents the methods below making a copy of the data. - A.p = const_cast<octave_idx_type *>(a.cidx ()); - A.i = const_cast<octave_idx_type *>(a.ridx ()); - A.x = const_cast<cs_complex_t *>(reinterpret_cast<const cs_complex_t *> (a.data ())); - A.nz = -1; - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - S = CXSPARSE_ZNAME (_sqr) (order, &A, 1); - N = CXSPARSE_ZNAME (_qr) (&A, S); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - if (! N) - (*current_liboctave_error_handler) - ("sparse_qr: sparse matrix QR factorization filled"); - - count = 1; - -#else - - octave_unused_parameter (order); - - (*current_liboctave_error_handler) - ("sparse_qr: support for CXSparse was unavailable or disabled when liboctave was built"); + octave_unused_parameter (b); + + return Matrix (); #endif -} - -template <> -sparse_qr<SparseComplexMatrix>::sparse_qr_rep::~sparse_qr_rep (void) -{ -#if defined (HAVE_CXSPARSE) - CXSPARSE_ZNAME (_sfree) (S); - CXSPARSE_ZNAME (_nfree) (N); -#endif -} - -template <> -SparseComplexMatrix -sparse_qr<SparseComplexMatrix>::sparse_qr_rep::V (void) const -{ -#if defined (HAVE_CXSPARSE) - // Drop zeros from V and sort - // FIXME: Is the double transpose to sort necessary? - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_dropzeros) (N->L); - CXSPARSE_ZNAME () *D = CXSPARSE_ZNAME (_transpose) (N->L, 1); - CXSPARSE_ZNAME (_spfree) (N->L); - N->L = CXSPARSE_ZNAME (_transpose) (D, 1); - CXSPARSE_ZNAME (_spfree) (D); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - octave_idx_type nc = N->L->n; - octave_idx_type nz = N->L->nzmax; - SparseComplexMatrix ret (N->L->m, nc, nz); - - for (octave_idx_type j = 0; j < nc+1; j++) - ret.xcidx (j) = N->L->p[j]; - - for (octave_idx_type j = 0; j < nz; j++) + } + + template <> + template <> + SparseMatrix + sparse_qr<SparseMatrix>::sparse_qr_rep::tall_solve<SparseMatrix, SparseMatrix> + (const SparseMatrix& b, octave_idx_type& info) const { - ret.xridx (j) = N->L->i[j]; - ret.xdata (j) = reinterpret_cast<Complex *>(N->L->x)[j]; - } - - return ret; - -#else - - return SparseComplexMatrix (); - -#endif -} - -template <> -SparseComplexMatrix -sparse_qr<SparseComplexMatrix>::sparse_qr_rep::R (bool econ) const -{ + info = -1; + #if defined (HAVE_CXSPARSE) - // Drop zeros from R and sort - // FIXME: Is the double transpose to sort necessary? - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_dropzeros) (N->U); - CXSPARSE_ZNAME () *D = CXSPARSE_ZNAME (_transpose) (N->U, 1); - CXSPARSE_ZNAME (_spfree) (N->U); - N->U = CXSPARSE_ZNAME (_transpose) (D, 1); - CXSPARSE_ZNAME (_spfree) (D); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - octave_idx_type nc = N->U->n; - octave_idx_type nz = N->U->nzmax; - - SparseComplexMatrix ret ((econ ? (nc > nrows ? nrows : nc) : nrows), nc, nz); - - for (octave_idx_type j = 0; j < nc+1; j++) - ret.xcidx (j) = N->U->p[j]; - - for (octave_idx_type j = 0; j < nz; j++) - { - ret.xridx (j) = N->U->i[j]; - ret.xdata (j) = reinterpret_cast<Complex *>(N->U->x)[j]; - } - - return ret; - -#else - - octave_unused_parameter (econ); - - return SparseComplexMatrix (); - -#endif -} - -template <> -ComplexMatrix -sparse_qr<SparseComplexMatrix>::sparse_qr_rep::C (const ComplexMatrix& b) const -{ -#if defined (HAVE_CXSPARSE) - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - octave_idx_type nc = N->L->n; - octave_idx_type nr = nrows; - const cs_complex_t *bvec = reinterpret_cast<const cs_complex_t *>(b.fortran_vec ()); - ComplexMatrix ret (b_nr, b_nc); - Complex *vec = ret.fortran_vec (); - - if (nr < 0 || nc < 0 || nr != b_nr) - (*current_liboctave_error_handler) ("matrix dimension mismatch"); - - if (nr == 0 || nc == 0 || b_nc == 0) - ret = ComplexMatrix (nc, b_nc, Complex (0.0, 0.0)); - else - { - OCTAVE_LOCAL_BUFFER (Complex, buf, S->m2); - - for (volatile octave_idx_type j = 0, idx = 0; j < b_nc; j++, idx+=b_nr) + + octave_idx_type nr = nrows; + octave_idx_type nc = ncols; + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + SparseMatrix x (nc, b_nc, b.nnz ()); + x.xcidx (0) = 0; + + volatile octave_idx_type x_nz = b.nnz (); + volatile octave_idx_type ii = 0; + + OCTAVE_LOCAL_BUFFER (double, Xx, (b_nr > nc ? b_nr : nc)); + OCTAVE_LOCAL_BUFFER (double, buf, S->m2); + + for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) { octave_quit (); - volatile octave_idx_type nm = (nr < nc ? nr : nc); + for (octave_idx_type j = 0; j < b_nr; j++) + Xx[j] = b.xelem (j,i); + + for (octave_idx_type j = nr; j < S->m2; j++) + buf[j] = 0.; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_ipvec) (S->pinv, bvec + idx, reinterpret_cast<cs_complex_t *>(buf), b_nr); + CXSPARSE_DNAME (_ipvec) (S->pinv, Xx, buf, nr); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type i = 0; i < nm; i++) + for (volatile octave_idx_type j = 0; j < nc; j++) { octave_quit (); BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_happly) (N->L, i, N->B[i], reinterpret_cast<cs_complex_t *>(buf)); + CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; } - for (octave_idx_type i = 0; i < b_nr; i++) - vec[i+idx] = buf[i]; + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_usolve) (N->U, buf); + CXSPARSE_DNAME (_ipvec) (S->q, buf, Xx, nc); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (octave_idx_type j = 0; j < nc; j++) + { + double tmp = Xx[j]; + + if (tmp != 0.0) + { + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * (b_nc - i) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + x.change_capacity (sz); + x_nz = sz; + } + + x.xdata (ii) = tmp; + x.xridx (ii++) = j; + } + } + + x.xcidx (i+1) = ii; } - } - - return ret; + + info = 0; + + return x; #else - octave_unused_parameter (b); - - return ComplexMatrix (); + octave_unused_parameter (b); + + return SparseMatrix (); + +#endif + } + + template <> + template <> + SparseMatrix + sparse_qr<SparseMatrix>::sparse_qr_rep::wide_solve<SparseMatrix, SparseMatrix> + (const SparseMatrix& b, octave_idx_type& info) const + { + info = -1; + +#if defined (HAVE_CXSPARSE) + + // These are swapped because the original matrix was transposed in + // sparse_qr<SparseMatrix>::solve. + + octave_idx_type nr = ncols; + octave_idx_type nc = nrows; + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + SparseMatrix x (nc, b_nc, b.nnz ()); + x.xcidx (0) = 0; + + volatile octave_idx_type x_nz = b.nnz (); + volatile octave_idx_type ii = 0; + volatile octave_idx_type nbuf = (nc > S->m2 ? nc : S->m2); + + OCTAVE_LOCAL_BUFFER (double, Xx, (b_nr > nc ? b_nr : nc)); + OCTAVE_LOCAL_BUFFER (double, buf, nbuf); + + for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) + { + octave_quit (); + + for (octave_idx_type j = 0; j < b_nr; j++) + Xx[j] = b.xelem (j,i); + + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = 0.; + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_pvec) (S->q, Xx, buf, nr); + CXSPARSE_DNAME (_utsolve) (N->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_pvec) (S->pinv, buf, Xx, nc); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (octave_idx_type j = 0; j < nc; j++) + { + double tmp = Xx[j]; + + if (tmp != 0.0) + { + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * (b_nc - i) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + x.change_capacity (sz); + x_nz = sz; + } + + x.xdata (ii) = tmp; + x.xridx (ii++) = j; + } + } + + x.xcidx (i+1) = ii; + } + + info = 0; + + x.maybe_compress (); + + return x; + +#else + + octave_unused_parameter (b); + + return SparseMatrix (); #endif -} - -template <> -ComplexMatrix -sparse_qr<SparseComplexMatrix>::sparse_qr_rep::Q (void) const -{ + } + + template <> + template <> + ComplexMatrix + sparse_qr<SparseMatrix>::sparse_qr_rep::tall_solve<MArray<Complex>, ComplexMatrix> + (const MArray<Complex>& b, octave_idx_type& info) const + { + info = -1; + #if defined (HAVE_CXSPARSE) - octave_idx_type nc = N->L->n; - octave_idx_type nr = nrows; - ComplexMatrix ret (nr, nr); - Complex *vec = ret.fortran_vec (); - - if (nr < 0 || nc < 0) - (*current_liboctave_error_handler) ("matrix dimension mismatch"); - - if (nr == 0 || nc == 0) - ret = ComplexMatrix (nc, nr, Complex (0.0, 0.0)); - else - { - OCTAVE_LOCAL_BUFFER (cs_complex_t, bvec, nr); - - for (octave_idx_type i = 0; i < nr; i++) - bvec[i] = cs_complex_t (0.0, 0.0); - - OCTAVE_LOCAL_BUFFER (Complex, buf, S->m2); - - for (volatile octave_idx_type j = 0, idx = 0; j < nr; j++, idx+=nr) + + octave_idx_type nr = nrows; + octave_idx_type nc = ncols; + + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nr = b.rows (); + + ComplexMatrix x (nc, b_nc); + Complex *vec = x.fortran_vec (); + + OCTAVE_LOCAL_BUFFER (double, Xx, (b_nr > nc ? b_nr : nc)); + OCTAVE_LOCAL_BUFFER (double, Xz, (b_nr > nc ? b_nr : nc)); + OCTAVE_LOCAL_BUFFER (double, buf, S->m2); + + for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) { octave_quit (); - bvec[j] = cs_complex_t (1.0, 0.0); - - volatile octave_idx_type nm = (nr < nc ? nr : nc); + for (octave_idx_type j = 0; j < b_nr; j++) + { + Complex c = b.xelem (j,i); + Xx[j] = c.real (); + Xz[j] = c.imag (); + } + + for (octave_idx_type j = nr; j < S->m2; j++) + buf[j] = 0.; + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_ipvec) (S->pinv, Xx, buf, nr); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_usolve) (N->U, buf); + CXSPARSE_DNAME (_ipvec) (S->q, buf, Xx, nc); + + for (octave_idx_type j = nr; j < S->m2; j++) + buf[j] = 0.; + + CXSPARSE_DNAME (_ipvec) (S->pinv, Xz, buf, nr); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_ipvec) (S->pinv, bvec, reinterpret_cast<cs_complex_t *>(buf), nr); + CXSPARSE_DNAME (_usolve) (N->U, buf); + CXSPARSE_DNAME (_ipvec) (S->q, buf, Xz, nc); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (volatile octave_idx_type i = 0; i < nm; i++) + for (octave_idx_type j = 0; j < nc; j++) + vec[j+idx] = Complex (Xx[j], Xz[j]); + } + + info = 0; + + return x; + +#else + + octave_unused_parameter (b); + + return ComplexMatrix (); + +#endif + } + + template <> + template <> + ComplexMatrix + sparse_qr<SparseMatrix>::sparse_qr_rep::wide_solve<MArray<Complex>, ComplexMatrix> + (const MArray<Complex>& b, octave_idx_type& info) const + { + info = -1; + +#if defined (HAVE_CXSPARSE) + + // These are swapped because the original matrix was transposed in + // sparse_qr<SparseMatrix>::solve. + + octave_idx_type nr = ncols; + octave_idx_type nc = nrows; + + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nr = b.rows (); + + ComplexMatrix x (nc, b_nc); + Complex *vec = x.fortran_vec (); + + volatile octave_idx_type nbuf = (nc > S->m2 ? nc : S->m2); + + OCTAVE_LOCAL_BUFFER (double, Xx, (b_nr > nc ? b_nr : nc)); + OCTAVE_LOCAL_BUFFER (double, Xz, (b_nr > nc ? b_nr : nc)); + OCTAVE_LOCAL_BUFFER (double, buf, nbuf); + + for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) + { + octave_quit (); + + for (octave_idx_type j = 0; j < b_nr; j++) + { + Complex c = b.xelem (j,i); + Xx[j] = c.real (); + Xz[j] = c.imag (); + } + + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = 0.; + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_pvec) (S->q, Xx, buf, nr); + CXSPARSE_DNAME (_utsolve) (N->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_pvec) (S->pinv, buf, Xx, nc); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = 0.; + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_pvec) (S->q, Xz, buf, nr); + CXSPARSE_DNAME (_utsolve) (N->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type j = nr-1; j >= 0; j--) { octave_quit (); BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_happly) (N->L, i, N->B[i], reinterpret_cast<cs_complex_t *>(buf)); + CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; } - for (octave_idx_type i = 0; i < nr; i++) - vec[i+idx] = buf[i]; - - bvec[j] = cs_complex_t (0.0, 0.0); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_pvec) (S->pinv, buf, Xz, nc); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (octave_idx_type j = 0; j < nc; j++) + vec[j+idx] = Complex (Xx[j], Xz[j]); } - } - - return ret.hermitian (); + + info = 0; + + return x; #else - return ComplexMatrix (); + octave_unused_parameter (b); + + return ComplexMatrix (); #endif -} - -template <> -template <> -SparseComplexMatrix -sparse_qr<SparseMatrix>::sparse_qr_rep::tall_solve<SparseComplexMatrix, SparseComplexMatrix> - (const SparseComplexMatrix& b, octave_idx_type& info) const -{ - info = -1; - + } + + // Complex-valued matrices. + + template <> + sparse_qr<SparseComplexMatrix>::sparse_qr_rep::sparse_qr_rep + (const SparseComplexMatrix& a, int order) + : count (1), nrows (a.rows ()), ncols (a.columns ()) #if defined (HAVE_CXSPARSE) - - octave_idx_type nr = nrows; - octave_idx_type nc = ncols; - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - SparseComplexMatrix x (nc, b_nc, b.nnz ()); - x.xcidx (0) = 0; - - volatile octave_idx_type x_nz = b.nnz (); - volatile octave_idx_type ii = 0; - - OCTAVE_LOCAL_BUFFER (double, Xx, (b_nr > nc ? b_nr : nc)); - OCTAVE_LOCAL_BUFFER (double, Xz, (b_nr > nc ? b_nr : nc)); - OCTAVE_LOCAL_BUFFER (double, buf, S->m2); - - for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) + , S (0), N (0) +#endif { - octave_quit (); - - for (octave_idx_type j = 0; j < b_nr; j++) - { - Complex c = b.xelem (j,i); - Xx[j] = c.real (); - Xz[j] = c.imag (); - } - - for (octave_idx_type j = nr; j < S->m2; j++) - buf[j] = 0.; - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_ipvec) (S->pinv, Xx, buf, nr); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_usolve) (N->U, buf); - CXSPARSE_DNAME (_ipvec) (S->q, buf, Xx, nc); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (octave_idx_type j = nr; j < S->m2; j++) - buf[j] = 0.; - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_ipvec) (S->pinv, Xz, buf, nr); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } +#if defined (HAVE_CXSPARSE) + + CXSPARSE_ZNAME () A; + + A.nzmax = a.nnz (); + A.m = nrows; + A.n = ncols; + // Cast away const on A, with full knowledge that CSparse won't touch it + // Prevents the methods below making a copy of the data. + A.p = const_cast<octave_idx_type *>(a.cidx ()); + A.i = const_cast<octave_idx_type *>(a.ridx ()); + A.x = const_cast<cs_complex_t *>(reinterpret_cast<const cs_complex_t *> (a.data ())); + A.nz = -1; BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_usolve) (N->U, buf); - CXSPARSE_DNAME (_ipvec) (S->q, buf, Xz, nc); + S = CXSPARSE_ZNAME (_sqr) (order, &A, 1); + N = CXSPARSE_ZNAME (_qr) (&A, S); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (octave_idx_type j = 0; j < nc; j++) - { - Complex tmp = Complex (Xx[j], Xz[j]); - - if (tmp != 0.0) - { - if (ii == x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - i) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - x.change_capacity (sz); - x_nz = sz; - } - - x.xdata (ii) = tmp; - x.xridx (ii++) = j; - } - } - - x.xcidx (i+1) = ii; - } - - info = 0; - - return x; + if (! N) + (*current_liboctave_error_handler) + ("sparse_qr: sparse matrix QR factorization filled"); + + count = 1; #else - octave_unused_parameter (b); - - return SparseComplexMatrix (); + octave_unused_parameter (order); + + (*current_liboctave_error_handler) + ("sparse_qr: support for CXSparse was unavailable or disabled when liboctave was built"); #endif -} - -template <> -template <> -SparseComplexMatrix -sparse_qr<SparseMatrix>::sparse_qr_rep::wide_solve<SparseComplexMatrix, SparseComplexMatrix> - (const SparseComplexMatrix& b, octave_idx_type& info) const -{ - info = -1; - + } + + template <> + sparse_qr<SparseComplexMatrix>::sparse_qr_rep::~sparse_qr_rep (void) + { #if defined (HAVE_CXSPARSE) - - // These are swapped because the original matrix was transposed in - // sparse_qr<SparseMatrix>::solve. - - octave_idx_type nr = ncols; - octave_idx_type nc = nrows; - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - SparseComplexMatrix x (nc, b_nc, b.nnz ()); - x.xcidx (0) = 0; - - volatile octave_idx_type x_nz = b.nnz (); - volatile octave_idx_type ii = 0; - volatile octave_idx_type nbuf = (nc > S->m2 ? nc : S->m2); - - OCTAVE_LOCAL_BUFFER (double, Xx, (b_nr > nc ? b_nr : nc)); - OCTAVE_LOCAL_BUFFER (double, Xz, (b_nr > nc ? b_nr : nc)); - OCTAVE_LOCAL_BUFFER (double, buf, nbuf); - - for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) + CXSPARSE_ZNAME (_sfree) (S); + CXSPARSE_ZNAME (_nfree) (N); +#endif + } + + template <> + SparseComplexMatrix + sparse_qr<SparseComplexMatrix>::sparse_qr_rep::V (void) const { - octave_quit (); - - for (octave_idx_type j = 0; j < b_nr; j++) - { - Complex c = b.xelem (j,i); - Xx[j] = c.real (); - Xz[j] = c.imag (); - } - - for (octave_idx_type j = nr; j < nbuf; j++) - buf[j] = 0.; +#if defined (HAVE_CXSPARSE) + // Drop zeros from V and sort + // FIXME: Is the double transpose to sort necessary? BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_pvec) (S->q, Xx, buf, nr); - CXSPARSE_DNAME (_utsolve) (N->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = nr-1; j >= 0; j--) - { - octave_quit (); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_pvec) (S->pinv, buf, Xx, nc); + CXSPARSE_ZNAME (_dropzeros) (N->L); + CXSPARSE_ZNAME () *D = CXSPARSE_ZNAME (_transpose) (N->L, 1); + CXSPARSE_ZNAME (_spfree) (N->L); + N->L = CXSPARSE_ZNAME (_transpose) (D, 1); + CXSPARSE_ZNAME (_spfree) (D); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (octave_idx_type j = nr; j < nbuf; j++) - buf[j] = 0.; - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_pvec) (S->q, Xz, buf, nr); - CXSPARSE_DNAME (_utsolve) (N->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = nr-1; j >= 0; j--) + octave_idx_type nc = N->L->n; + octave_idx_type nz = N->L->nzmax; + SparseComplexMatrix ret (N->L->m, nc, nz); + + for (octave_idx_type j = 0; j < nc+1; j++) + ret.xcidx (j) = N->L->p[j]; + + for (octave_idx_type j = 0; j < nz; j++) { - octave_quit (); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + ret.xridx (j) = N->L->i[j]; + ret.xdata (j) = reinterpret_cast<Complex *>(N->L->x)[j]; } + return ret; + +#else + + return SparseComplexMatrix (); + +#endif + } + + template <> + SparseComplexMatrix + sparse_qr<SparseComplexMatrix>::sparse_qr_rep::R (bool econ) const + { +#if defined (HAVE_CXSPARSE) + // Drop zeros from R and sort + // FIXME: Is the double transpose to sort necessary? + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_DNAME (_pvec) (S->pinv, buf, Xz, nc); + CXSPARSE_ZNAME (_dropzeros) (N->U); + CXSPARSE_ZNAME () *D = CXSPARSE_ZNAME (_transpose) (N->U, 1); + CXSPARSE_ZNAME (_spfree) (N->U); + N->U = CXSPARSE_ZNAME (_transpose) (D, 1); + CXSPARSE_ZNAME (_spfree) (D); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - for (octave_idx_type j = 0; j < nc; j++) + octave_idx_type nc = N->U->n; + octave_idx_type nz = N->U->nzmax; + + SparseComplexMatrix ret ((econ ? (nc > nrows ? nrows : nc) : nrows), nc, nz); + + for (octave_idx_type j = 0; j < nc+1; j++) + ret.xcidx (j) = N->U->p[j]; + + for (octave_idx_type j = 0; j < nz; j++) { - Complex tmp = Complex (Xx[j], Xz[j]); - - if (tmp != 0.0) - { - if (ii == x_nz) - { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - i) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - x.change_capacity (sz); - x_nz = sz; - } - - x.xdata (ii) = tmp; - x.xridx (ii++) = j; - } + ret.xridx (j) = N->U->i[j]; + ret.xdata (j) = reinterpret_cast<Complex *>(N->U->x)[j]; } - x.xcidx (i+1) = ii; - } - - info = 0; - - x.maybe_compress (); - - return x; + return ret; #else - octave_unused_parameter (b); - - return SparseComplexMatrix (); - -#endif -} - -template <> -template <> -ComplexMatrix -sparse_qr<SparseComplexMatrix>::sparse_qr_rep::tall_solve<MArray<double>, ComplexMatrix> - (const MArray<double>& b, octave_idx_type& info) const -{ - info = -1; - -#if defined (HAVE_CXSPARSE) - - octave_idx_type nr = nrows; - octave_idx_type nc = ncols; - - octave_idx_type b_nc = b.cols (); - octave_idx_type b_nr = b.rows (); - - ComplexMatrix x (nc, b_nc); - cs_complex_t *vec = reinterpret_cast<cs_complex_t *> (x.fortran_vec ()); - - OCTAVE_LOCAL_BUFFER (cs_complex_t, buf, S->m2); - OCTAVE_LOCAL_BUFFER (Complex, Xx, b_nr); - - for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) - { - octave_quit (); - - for (octave_idx_type j = 0; j < b_nr; j++) - Xx[j] = b.xelem (j,i); - - for (octave_idx_type j = nr; j < S->m2; j++) - buf[j] = cs_complex_t (0.0, 0.0); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_ipvec) (S->pinv, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_happly) (N->L, j, N->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_usolve) (N->U, buf); - CXSPARSE_ZNAME (_ipvec) (S->q, buf, vec + idx, nc); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - info = 0; - - return x; - -#else - - octave_unused_parameter (b); - - return ComplexMatrix (); + octave_unused_parameter (econ); + + return SparseComplexMatrix (); #endif -} - -template <> -template <> -ComplexMatrix -sparse_qr<SparseComplexMatrix>::sparse_qr_rep::wide_solve<MArray<double>, ComplexMatrix> - (const MArray<double>& b, octave_idx_type& info) const -{ - info = -1; - + } + + template <> + ComplexMatrix + sparse_qr<SparseComplexMatrix>::sparse_qr_rep::C (const ComplexMatrix& b) const + { #if defined (HAVE_CXSPARSE) - - // These are swapped because the original matrix was transposed in - // sparse_qr<SparseComplexMatrix>::solve. - - octave_idx_type nr = ncols; - octave_idx_type nc = nrows; - - octave_idx_type b_nc = b.cols (); - octave_idx_type b_nr = b.rows (); - - ComplexMatrix x (nc, b_nc); - cs_complex_t *vec = reinterpret_cast<cs_complex_t *> (x.fortran_vec ()); - - volatile octave_idx_type nbuf = (nc > S->m2 ? nc : S->m2); - - OCTAVE_LOCAL_BUFFER (cs_complex_t, buf, nbuf); - OCTAVE_LOCAL_BUFFER (Complex, Xx, b_nr); - OCTAVE_LOCAL_BUFFER (double, B, nr); - - for (octave_idx_type i = 0; i < nr; i++) - B[i] = N->B[i]; - - for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) - { - octave_quit (); - - for (octave_idx_type j = 0; j < b_nr; j++) - Xx[j] = b.xelem (j,i); - - for (octave_idx_type j = nr; j < nbuf; j++) - buf[j] = cs_complex_t (0.0, 0.0); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_pvec) (S->q, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); - CXSPARSE_ZNAME (_utsolve) (N->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = nr-1; j >= 0; j--) + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + octave_idx_type nc = N->L->n; + octave_idx_type nr = nrows; + const cs_complex_t *bvec = reinterpret_cast<const cs_complex_t *>(b.fortran_vec ()); + ComplexMatrix ret (b_nr, b_nc); + Complex *vec = ret.fortran_vec (); + + if (nr < 0 || nc < 0 || nr != b_nr) + (*current_liboctave_error_handler) ("matrix dimension mismatch"); + + if (nr == 0 || nc == 0 || b_nc == 0) + ret = ComplexMatrix (nc, b_nc, Complex (0.0, 0.0)); + else { - octave_quit (); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_happly) (N->L, j, B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + OCTAVE_LOCAL_BUFFER (Complex, buf, S->m2); + + for (volatile octave_idx_type j = 0, idx = 0; j < b_nc; j++, idx+=b_nr) + { + octave_quit (); + + volatile octave_idx_type nm = (nr < nc ? nr : nc); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_ipvec) (S->pinv, bvec + idx, reinterpret_cast<cs_complex_t *>(buf), b_nr); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type i = 0; i < nm; i++) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_happly) (N->L, i, N->B[i], reinterpret_cast<cs_complex_t *>(buf)); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + for (octave_idx_type i = 0; i < b_nr; i++) + vec[i+idx] = buf[i]; + } } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_pvec) (S->pinv, buf, vec + idx, nc); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - info = 0; - - return x; + return ret; #else - octave_unused_parameter (b); - - return ComplexMatrix (); + octave_unused_parameter (b); + + return ComplexMatrix (); #endif -} - -template <> -template <> -SparseComplexMatrix -sparse_qr<SparseComplexMatrix>::sparse_qr_rep::tall_solve<SparseMatrix, SparseComplexMatrix> - (const SparseMatrix& b, octave_idx_type& info) const -{ - info = -1; - -#if defined (HAVE_CXSPARSE) - - octave_idx_type nr = nrows; - octave_idx_type nc = ncols; - - octave_idx_type b_nc = b.cols (); - octave_idx_type b_nr = b.rows (); - - SparseComplexMatrix x (nc, b_nc, b.nnz ()); - x.xcidx (0) = 0; - - volatile octave_idx_type x_nz = b.nnz (); - volatile octave_idx_type ii = 0; - - OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); - OCTAVE_LOCAL_BUFFER (cs_complex_t, buf, S->m2); - - for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) + } + + template <> + ComplexMatrix + sparse_qr<SparseComplexMatrix>::sparse_qr_rep::Q (void) const { - octave_quit (); - - for (octave_idx_type j = 0; j < b_nr; j++) - Xx[j] = b.xelem (j,i); - - for (octave_idx_type j = nr; j < S->m2; j++) - buf[j] = cs_complex_t (0.0, 0.0); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_ipvec) (S->pinv, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = 0; j < nc; j++) +#if defined (HAVE_CXSPARSE) + octave_idx_type nc = N->L->n; + octave_idx_type nr = nrows; + ComplexMatrix ret (nr, nr); + Complex *vec = ret.fortran_vec (); + + if (nr < 0 || nc < 0) + (*current_liboctave_error_handler) ("matrix dimension mismatch"); + + if (nr == 0 || nc == 0) + ret = ComplexMatrix (nc, nr, Complex (0.0, 0.0)); + else { - octave_quit (); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_happly) (N->L, j, N->B[j], buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_usolve) (N->U, buf); - CXSPARSE_ZNAME (_ipvec) (S->q, buf, reinterpret_cast<cs_complex_t *>(Xx), nc); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (octave_idx_type j = 0; j < nc; j++) - { - Complex tmp = Xx[j]; - - if (tmp != 0.0) + OCTAVE_LOCAL_BUFFER (cs_complex_t, bvec, nr); + + for (octave_idx_type i = 0; i < nr; i++) + bvec[i] = cs_complex_t (0.0, 0.0); + + OCTAVE_LOCAL_BUFFER (Complex, buf, S->m2); + + for (volatile octave_idx_type j = 0, idx = 0; j < nr; j++, idx+=nr) { - if (ii == x_nz) + octave_quit (); + + bvec[j] = cs_complex_t (1.0, 0.0); + + volatile octave_idx_type nm = (nr < nc ? nr : nc); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_ipvec) (S->pinv, bvec, reinterpret_cast<cs_complex_t *>(buf), nr); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type i = 0; i < nm; i++) { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - i) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - x.change_capacity (sz); - x_nz = sz; + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_happly) (N->L, i, N->B[i], reinterpret_cast<cs_complex_t *>(buf)); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; } - x.xdata (ii) = tmp; - x.xridx (ii++) = j; + for (octave_idx_type i = 0; i < nr; i++) + vec[i+idx] = buf[i]; + + bvec[j] = cs_complex_t (0.0, 0.0); } } - x.xcidx (i+1) = ii; - } - - info = 0; - - x.maybe_compress (); - - return x; + return ret.hermitian (); #else - octave_unused_parameter (b); - - return SparseComplexMatrix (); + return ComplexMatrix (); #endif -} - -template <> -template <> -SparseComplexMatrix -sparse_qr<SparseComplexMatrix>::sparse_qr_rep::wide_solve<SparseMatrix, SparseComplexMatrix> - (const SparseMatrix& b, octave_idx_type& info) const -{ - info = -1; + } + + template <> + template <> + SparseComplexMatrix + sparse_qr<SparseMatrix>::sparse_qr_rep::tall_solve<SparseComplexMatrix, SparseComplexMatrix> + (const SparseComplexMatrix& b, octave_idx_type& info) const + { + info = -1; #if defined (HAVE_CXSPARSE) - // These are swapped because the original matrix was transposed in - // sparse_qr<SparseComplexMatrix>::solve. - - octave_idx_type nr = ncols; - octave_idx_type nc = nrows; - - octave_idx_type b_nc = b.cols (); - octave_idx_type b_nr = b.rows (); - - SparseComplexMatrix x (nc, b_nc, b.nnz ()); - x.xcidx (0) = 0; - - volatile octave_idx_type x_nz = b.nnz (); - volatile octave_idx_type ii = 0; - volatile octave_idx_type nbuf = (nc > S->m2 ? nc : S->m2); - - OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); - OCTAVE_LOCAL_BUFFER (cs_complex_t, buf, nbuf); - OCTAVE_LOCAL_BUFFER (double, B, nr); - - for (octave_idx_type i = 0; i < nr; i++) - B[i] = N->B[i]; - - for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) - { - octave_quit (); - - for (octave_idx_type j = 0; j < b_nr; j++) - Xx[j] = b.xelem (j,i); - - for (octave_idx_type j = nr; j < nbuf; j++) - buf[j] = cs_complex_t (0.0, 0.0); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_pvec) (S->q, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); - CXSPARSE_ZNAME (_utsolve) (N->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = nr-1; j >= 0; j--) + octave_idx_type nr = nrows; + octave_idx_type nc = ncols; + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + SparseComplexMatrix x (nc, b_nc, b.nnz ()); + x.xcidx (0) = 0; + + volatile octave_idx_type x_nz = b.nnz (); + volatile octave_idx_type ii = 0; + + OCTAVE_LOCAL_BUFFER (double, Xx, (b_nr > nc ? b_nr : nc)); + OCTAVE_LOCAL_BUFFER (double, Xz, (b_nr > nc ? b_nr : nc)); + OCTAVE_LOCAL_BUFFER (double, buf, S->m2); + + for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) { octave_quit (); + for (octave_idx_type j = 0; j < b_nr; j++) + { + Complex c = b.xelem (j,i); + Xx[j] = c.real (); + Xz[j] = c.imag (); + } + + for (octave_idx_type j = nr; j < S->m2; j++) + buf[j] = 0.; + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_ipvec) (S->pinv, Xx, buf, nr); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_happly) (N->L, j, B[j], buf); + CXSPARSE_DNAME (_usolve) (N->U, buf); + CXSPARSE_DNAME (_ipvec) (S->q, buf, Xx, nc); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (octave_idx_type j = nr; j < S->m2; j++) + buf[j] = 0.; + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_ipvec) (S->pinv, Xz, buf, nr); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_pvec) (S->pinv, buf, reinterpret_cast<cs_complex_t *>(Xx), nc); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (octave_idx_type j = 0; j < nc; j++) - { - Complex tmp = Xx[j]; - - if (tmp != 0.0) + + for (volatile octave_idx_type j = 0; j < nc; j++) { - if (ii == x_nz) + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_usolve) (N->U, buf); + CXSPARSE_DNAME (_ipvec) (S->q, buf, Xz, nc); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (octave_idx_type j = 0; j < nc; j++) + { + Complex tmp = Complex (Xx[j], Xz[j]); + + if (tmp != 0.0) { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - i) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - x.change_capacity (sz); - x_nz = sz; + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * (b_nc - i) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + x.change_capacity (sz); + x_nz = sz; + } + + x.xdata (ii) = tmp; + x.xridx (ii++) = j; } - - x.xdata (ii) = tmp; - x.xridx (ii++) = j; } + + x.xcidx (i+1) = ii; } - x.xcidx (i+1) = ii; - } - - info = 0; - - x.maybe_compress (); - - return x; + info = 0; + + return x; #else - octave_unused_parameter (b); - - return SparseComplexMatrix (); + octave_unused_parameter (b); + + return SparseComplexMatrix (); #endif -} - -template <> -template <> -ComplexMatrix -sparse_qr<SparseComplexMatrix>::sparse_qr_rep::tall_solve<MArray<Complex>, ComplexMatrix> - (const MArray<Complex>& b, octave_idx_type& info) const -{ - info = -1; + } + + template <> + template <> + SparseComplexMatrix + sparse_qr<SparseMatrix>::sparse_qr_rep::wide_solve<SparseComplexMatrix, SparseComplexMatrix> + (const SparseComplexMatrix& b, octave_idx_type& info) const + { + info = -1; #if defined (HAVE_CXSPARSE) - octave_idx_type nr = nrows; - octave_idx_type nc = ncols; - - octave_idx_type b_nc = b.cols (); - octave_idx_type b_nr = b.rows (); - - const cs_complex_t *bvec = reinterpret_cast<const cs_complex_t *>(b.fortran_vec ()); - - ComplexMatrix x (nc, b_nc); - cs_complex_t *vec = reinterpret_cast<cs_complex_t *> - (x.fortran_vec ()); - - OCTAVE_LOCAL_BUFFER (cs_complex_t, buf, S->m2); - - for (volatile octave_idx_type i = 0, idx = 0, bidx = 0; i < b_nc; - i++, idx+=nc, bidx+=b_nr) - { - octave_quit (); - - for (octave_idx_type j = nr; j < S->m2; j++) - buf[j] = cs_complex_t (0.0, 0.0); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_ipvec) (S->pinv, bvec + bidx, buf, nr); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = 0; j < nc; j++) + // These are swapped because the original matrix was transposed in + // sparse_qr<SparseMatrix>::solve. + + octave_idx_type nr = ncols; + octave_idx_type nc = nrows; + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + SparseComplexMatrix x (nc, b_nc, b.nnz ()); + x.xcidx (0) = 0; + + volatile octave_idx_type x_nz = b.nnz (); + volatile octave_idx_type ii = 0; + volatile octave_idx_type nbuf = (nc > S->m2 ? nc : S->m2); + + OCTAVE_LOCAL_BUFFER (double, Xx, (b_nr > nc ? b_nr : nc)); + OCTAVE_LOCAL_BUFFER (double, Xz, (b_nr > nc ? b_nr : nc)); + OCTAVE_LOCAL_BUFFER (double, buf, nbuf); + + for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) { octave_quit (); + for (octave_idx_type j = 0; j < b_nr; j++) + { + Complex c = b.xelem (j,i); + Xx[j] = c.real (); + Xz[j] = c.imag (); + } + + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = 0.; + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_happly) (N->L, j, N->B[j], buf); + CXSPARSE_DNAME (_pvec) (S->q, Xx, buf, nr); + CXSPARSE_DNAME (_utsolve) (N->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_pvec) (S->pinv, buf, Xx, nc); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = 0.; + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_pvec) (S->q, Xz, buf, nr); + CXSPARSE_DNAME (_utsolve) (N->U, buf); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_happly) (N->L, j, N->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_DNAME (_pvec) (S->pinv, buf, Xz, nc); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (octave_idx_type j = 0; j < nc; j++) + { + Complex tmp = Complex (Xx[j], Xz[j]); + + if (tmp != 0.0) + { + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * (b_nc - i) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + x.change_capacity (sz); + x_nz = sz; + } + + x.xdata (ii) = tmp; + x.xridx (ii++) = j; + } + } + + x.xcidx (i+1) = ii; } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_usolve) (N->U, buf); - CXSPARSE_ZNAME (_ipvec) (S->q, buf, vec + idx, nc); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - info = 0; - - return x; + info = 0; + + x.maybe_compress (); + + return x; #else - octave_unused_parameter (b); - - return ComplexMatrix (); + octave_unused_parameter (b); + + return SparseComplexMatrix (); #endif -} - -template <> -template <> -ComplexMatrix -sparse_qr<SparseComplexMatrix>::sparse_qr_rep::wide_solve<MArray<Complex>, ComplexMatrix> - (const MArray<Complex>& b, octave_idx_type& info) const -{ - info = -1; + } + + template <> + template <> + ComplexMatrix + sparse_qr<SparseComplexMatrix>::sparse_qr_rep::tall_solve<MArray<double>, ComplexMatrix> + (const MArray<double>& b, octave_idx_type& info) const + { + info = -1; #if defined (HAVE_CXSPARSE) - // These are swapped because the original matrix was transposed in - // sparse_qr<SparseComplexMatrix>::solve. - - octave_idx_type nr = ncols; - octave_idx_type nc = nrows; - - octave_idx_type b_nc = b.cols (); - octave_idx_type b_nr = b.rows (); - - const cs_complex_t *bvec = reinterpret_cast<const cs_complex_t *>(b.fortran_vec ()); - - ComplexMatrix x (nc, b_nc); - cs_complex_t *vec = reinterpret_cast<cs_complex_t *> (x.fortran_vec ()); - - volatile octave_idx_type nbuf = (nc > S->m2 ? nc : S->m2); - - OCTAVE_LOCAL_BUFFER (cs_complex_t, buf, nbuf); - OCTAVE_LOCAL_BUFFER (double, B, nr); - - for (octave_idx_type i = 0; i < nr; i++) - B[i] = N->B[i]; - - for (volatile octave_idx_type i = 0, idx = 0, bidx = 0; i < b_nc; - i++, idx+=nc, bidx+=b_nr) - { - octave_quit (); - - for (octave_idx_type j = nr; j < nbuf; j++) - buf[j] = cs_complex_t (0.0, 0.0); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_pvec) (S->q, bvec + bidx, buf, nr); - CXSPARSE_ZNAME (_utsolve) (N->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = nr-1; j >= 0; j--) + octave_idx_type nr = nrows; + octave_idx_type nc = ncols; + + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nr = b.rows (); + + ComplexMatrix x (nc, b_nc); + cs_complex_t *vec = reinterpret_cast<cs_complex_t *> (x.fortran_vec ()); + + OCTAVE_LOCAL_BUFFER (cs_complex_t, buf, S->m2); + OCTAVE_LOCAL_BUFFER (Complex, Xx, b_nr); + + for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) { octave_quit (); + for (octave_idx_type j = 0; j < b_nr; j++) + Xx[j] = b.xelem (j,i); + + for (octave_idx_type j = nr; j < S->m2; j++) + buf[j] = cs_complex_t (0.0, 0.0); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_happly) (N->L, j, B[j], buf); + CXSPARSE_ZNAME (_ipvec) (S->pinv, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_happly) (N->L, j, N->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_usolve) (N->U, buf); + CXSPARSE_ZNAME (_ipvec) (S->q, buf, vec + idx, nc); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + info = 0; + + return x; + +#else + + octave_unused_parameter (b); + + return ComplexMatrix (); + +#endif + } + + template <> + template <> + ComplexMatrix + sparse_qr<SparseComplexMatrix>::sparse_qr_rep::wide_solve<MArray<double>, ComplexMatrix> + (const MArray<double>& b, octave_idx_type& info) const + { + info = -1; + +#if defined (HAVE_CXSPARSE) + + // These are swapped because the original matrix was transposed in + // sparse_qr<SparseComplexMatrix>::solve. + + octave_idx_type nr = ncols; + octave_idx_type nc = nrows; + + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nr = b.rows (); + + ComplexMatrix x (nc, b_nc); + cs_complex_t *vec = reinterpret_cast<cs_complex_t *> (x.fortran_vec ()); + + volatile octave_idx_type nbuf = (nc > S->m2 ? nc : S->m2); + + OCTAVE_LOCAL_BUFFER (cs_complex_t, buf, nbuf); + OCTAVE_LOCAL_BUFFER (Complex, Xx, b_nr); + OCTAVE_LOCAL_BUFFER (double, B, nr); + + for (octave_idx_type i = 0; i < nr; i++) + B[i] = N->B[i]; + + for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) + { + octave_quit (); + + for (octave_idx_type j = 0; j < b_nr; j++) + Xx[j] = b.xelem (j,i); + + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = cs_complex_t (0.0, 0.0); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_pvec) (S->q, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); + CXSPARSE_ZNAME (_utsolve) (N->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_happly) (N->L, j, B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_pvec) (S->pinv, buf, vec + idx, nc); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_pvec) (S->pinv, buf, vec + idx, nc); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - info = 0; - - return x; + info = 0; + + return x; #else - octave_unused_parameter (b); - - return ComplexMatrix (); + octave_unused_parameter (b); + + return ComplexMatrix (); #endif -} - -template <> -template <> -SparseComplexMatrix -sparse_qr<SparseComplexMatrix>::sparse_qr_rep::tall_solve<SparseComplexMatrix, SparseComplexMatrix> - (const SparseComplexMatrix& b, octave_idx_type& info) const -{ - info = -1; + } + + template <> + template <> + SparseComplexMatrix + sparse_qr<SparseComplexMatrix>::sparse_qr_rep::tall_solve<SparseMatrix, SparseComplexMatrix> + (const SparseMatrix& b, octave_idx_type& info) const + { + info = -1; #if defined (HAVE_CXSPARSE) - octave_idx_type nr = nrows; - octave_idx_type nc = ncols; - - octave_idx_type b_nc = b.cols (); - octave_idx_type b_nr = b.rows (); - - SparseComplexMatrix x (nc, b_nc, b.nnz ()); - x.xcidx (0) = 0; - - volatile octave_idx_type x_nz = b.nnz (); - volatile octave_idx_type ii = 0; - - OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); - OCTAVE_LOCAL_BUFFER (cs_complex_t, buf, S->m2); - - for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) - { - octave_quit (); - - for (octave_idx_type j = 0; j < b_nr; j++) - Xx[j] = b.xelem (j,i); - - for (octave_idx_type j = nr; j < S->m2; j++) - buf[j] = cs_complex_t (0.0, 0.0); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_ipvec) (S->pinv, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = 0; j < nc; j++) + octave_idx_type nr = nrows; + octave_idx_type nc = ncols; + + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nr = b.rows (); + + SparseComplexMatrix x (nc, b_nc, b.nnz ()); + x.xcidx (0) = 0; + + volatile octave_idx_type x_nz = b.nnz (); + volatile octave_idx_type ii = 0; + + OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); + OCTAVE_LOCAL_BUFFER (cs_complex_t, buf, S->m2); + + for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) { octave_quit (); + for (octave_idx_type j = 0; j < b_nr; j++) + Xx[j] = b.xelem (j,i); + + for (octave_idx_type j = nr; j < S->m2; j++) + buf[j] = cs_complex_t (0.0, 0.0); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_ipvec) (S->pinv, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_happly) (N->L, j, N->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_happly) (N->L, j, N->B[j], buf); + CXSPARSE_ZNAME (_usolve) (N->U, buf); + CXSPARSE_ZNAME (_ipvec) (S->q, buf, reinterpret_cast<cs_complex_t *>(Xx), nc); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_usolve) (N->U, buf); - CXSPARSE_ZNAME (_ipvec) (S->q, buf, reinterpret_cast<cs_complex_t *>(Xx), nc); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (octave_idx_type j = 0; j < nc; j++) - { - Complex tmp = Xx[j]; - - if (tmp != 0.0) + + for (octave_idx_type j = 0; j < nc; j++) { - if (ii == x_nz) + Complex tmp = Xx[j]; + + if (tmp != 0.0) { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - i) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - x.change_capacity (sz); - x_nz = sz; + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * (b_nc - i) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + x.change_capacity (sz); + x_nz = sz; + } + + x.xdata (ii) = tmp; + x.xridx (ii++) = j; } - - x.xdata (ii) = tmp; - x.xridx (ii++) = j; } + + x.xcidx (i+1) = ii; } - x.xcidx (i+1) = ii; - } - - info = 0; - - x.maybe_compress (); - - return x; + info = 0; + + x.maybe_compress (); + + return x; #else - octave_unused_parameter (b); - - return SparseComplexMatrix (); + octave_unused_parameter (b); + + return SparseComplexMatrix (); #endif -} - -template <> -template <> -SparseComplexMatrix -sparse_qr<SparseComplexMatrix>::sparse_qr_rep::wide_solve<SparseComplexMatrix, SparseComplexMatrix> - (const SparseComplexMatrix& b, octave_idx_type& info) const -{ - info = -1; + } + + template <> + template <> + SparseComplexMatrix + sparse_qr<SparseComplexMatrix>::sparse_qr_rep::wide_solve<SparseMatrix, SparseComplexMatrix> + (const SparseMatrix& b, octave_idx_type& info) const + { + info = -1; + +#if defined (HAVE_CXSPARSE) + + // These are swapped because the original matrix was transposed in + // sparse_qr<SparseComplexMatrix>::solve. + + octave_idx_type nr = ncols; + octave_idx_type nc = nrows; + + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nr = b.rows (); + + SparseComplexMatrix x (nc, b_nc, b.nnz ()); + x.xcidx (0) = 0; + + volatile octave_idx_type x_nz = b.nnz (); + volatile octave_idx_type ii = 0; + volatile octave_idx_type nbuf = (nc > S->m2 ? nc : S->m2); + + OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); + OCTAVE_LOCAL_BUFFER (cs_complex_t, buf, nbuf); + OCTAVE_LOCAL_BUFFER (double, B, nr); + + for (octave_idx_type i = 0; i < nr; i++) + B[i] = N->B[i]; + + for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) + { + octave_quit (); + + for (octave_idx_type j = 0; j < b_nr; j++) + Xx[j] = b.xelem (j,i); + + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = cs_complex_t (0.0, 0.0); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_pvec) (S->q, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); + CXSPARSE_ZNAME (_utsolve) (N->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_happly) (N->L, j, B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_pvec) (S->pinv, buf, reinterpret_cast<cs_complex_t *>(Xx), nc); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (octave_idx_type j = 0; j < nc; j++) + { + Complex tmp = Xx[j]; + + if (tmp != 0.0) + { + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * (b_nc - i) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + x.change_capacity (sz); + x_nz = sz; + } + + x.xdata (ii) = tmp; + x.xridx (ii++) = j; + } + } + + x.xcidx (i+1) = ii; + } + + info = 0; + + x.maybe_compress (); + + return x; + +#else + + octave_unused_parameter (b); + + return SparseComplexMatrix (); + +#endif + } + + template <> + template <> + ComplexMatrix + sparse_qr<SparseComplexMatrix>::sparse_qr_rep::tall_solve<MArray<Complex>, ComplexMatrix> + (const MArray<Complex>& b, octave_idx_type& info) const + { + info = -1; #if defined (HAVE_CXSPARSE) - // These are swapped because the original matrix was transposed in - // sparse_qr<SparseComplexMatrix>::solve. - - octave_idx_type nr = ncols; - octave_idx_type nc = nrows; - - octave_idx_type b_nc = b.cols (); - octave_idx_type b_nr = b.rows (); - - SparseComplexMatrix x (nc, b_nc, b.nnz ()); - x.xcidx (0) = 0; - - volatile octave_idx_type x_nz = b.nnz (); - volatile octave_idx_type ii = 0; - volatile octave_idx_type nbuf = (nc > S->m2 ? nc : S->m2); - - OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); - OCTAVE_LOCAL_BUFFER (cs_complex_t, buf, nbuf); - OCTAVE_LOCAL_BUFFER (double, B, nr); - - for (octave_idx_type i = 0; i < nr; i++) - B[i] = N->B[i]; - - for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) - { - octave_quit (); - - for (octave_idx_type j = 0; j < b_nr; j++) - Xx[j] = b.xelem (j,i); - - for (octave_idx_type j = nr; j < nbuf; j++) - buf[j] = cs_complex_t (0.0, 0.0); - - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_pvec) (S->q, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); - CXSPARSE_ZNAME (_utsolve) (N->U, buf); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (volatile octave_idx_type j = nr-1; j >= 0; j--) + octave_idx_type nr = nrows; + octave_idx_type nc = ncols; + + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nr = b.rows (); + + const cs_complex_t *bvec = reinterpret_cast<const cs_complex_t *>(b.fortran_vec ()); + + ComplexMatrix x (nc, b_nc); + cs_complex_t *vec = reinterpret_cast<cs_complex_t *> + (x.fortran_vec ()); + + OCTAVE_LOCAL_BUFFER (cs_complex_t, buf, S->m2); + + for (volatile octave_idx_type i = 0, idx = 0, bidx = 0; i < b_nc; + i++, idx+=nc, bidx+=b_nr) { octave_quit (); + for (octave_idx_type j = nr; j < S->m2; j++) + buf[j] = cs_complex_t (0.0, 0.0); + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_happly) (N->L, j, B[j], buf); + CXSPARSE_ZNAME (_ipvec) (S->pinv, bvec + bidx, buf, nr); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_happly) (N->L, j, N->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_usolve) (N->U, buf); + CXSPARSE_ZNAME (_ipvec) (S->q, buf, vec + idx, nc); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + info = 0; + + return x; + +#else + + octave_unused_parameter (b); + + return ComplexMatrix (); + +#endif + } + + template <> + template <> + ComplexMatrix + sparse_qr<SparseComplexMatrix>::sparse_qr_rep::wide_solve<MArray<Complex>, ComplexMatrix> + (const MArray<Complex>& b, octave_idx_type& info) const + { + info = -1; + +#if defined (HAVE_CXSPARSE) + + // These are swapped because the original matrix was transposed in + // sparse_qr<SparseComplexMatrix>::solve. + + octave_idx_type nr = ncols; + octave_idx_type nc = nrows; + + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nr = b.rows (); + + const cs_complex_t *bvec = reinterpret_cast<const cs_complex_t *>(b.fortran_vec ()); + + ComplexMatrix x (nc, b_nc); + cs_complex_t *vec = reinterpret_cast<cs_complex_t *> (x.fortran_vec ()); + + volatile octave_idx_type nbuf = (nc > S->m2 ? nc : S->m2); + + OCTAVE_LOCAL_BUFFER (cs_complex_t, buf, nbuf); + OCTAVE_LOCAL_BUFFER (double, B, nr); + + for (octave_idx_type i = 0; i < nr; i++) + B[i] = N->B[i]; + + for (volatile octave_idx_type i = 0, idx = 0, bidx = 0; i < b_nc; + i++, idx+=nc, bidx+=b_nr) + { + octave_quit (); + + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = cs_complex_t (0.0, 0.0); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_pvec) (S->q, bvec + bidx, buf, nr); + CXSPARSE_ZNAME (_utsolve) (N->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_happly) (N->L, j, B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_pvec) (S->pinv, buf, vec + idx, nc); END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; } - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CXSPARSE_ZNAME (_pvec) (S->pinv, buf, reinterpret_cast<cs_complex_t *>(Xx), nc); - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - for (octave_idx_type j = 0; j < nc; j++) + info = 0; + + return x; + +#else + + octave_unused_parameter (b); + + return ComplexMatrix (); + +#endif + } + + template <> + template <> + SparseComplexMatrix + sparse_qr<SparseComplexMatrix>::sparse_qr_rep::tall_solve<SparseComplexMatrix, SparseComplexMatrix> + (const SparseComplexMatrix& b, octave_idx_type& info) const + { + info = -1; + +#if defined (HAVE_CXSPARSE) + + octave_idx_type nr = nrows; + octave_idx_type nc = ncols; + + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nr = b.rows (); + + SparseComplexMatrix x (nc, b_nc, b.nnz ()); + x.xcidx (0) = 0; + + volatile octave_idx_type x_nz = b.nnz (); + volatile octave_idx_type ii = 0; + + OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); + OCTAVE_LOCAL_BUFFER (cs_complex_t, buf, S->m2); + + for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) { - Complex tmp = Xx[j]; - - if (tmp != 0.0) + octave_quit (); + + for (octave_idx_type j = 0; j < b_nr; j++) + Xx[j] = b.xelem (j,i); + + for (octave_idx_type j = nr; j < S->m2; j++) + buf[j] = cs_complex_t (0.0, 0.0); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_ipvec) (S->pinv, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type j = 0; j < nc; j++) { - if (ii == x_nz) + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_happly) (N->L, j, N->B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_usolve) (N->U, buf); + CXSPARSE_ZNAME (_ipvec) (S->q, buf, reinterpret_cast<cs_complex_t *>(Xx), nc); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (octave_idx_type j = 0; j < nc; j++) + { + Complex tmp = Xx[j]; + + if (tmp != 0.0) { - // Resize the sparse matrix - octave_idx_type sz = x_nz * (b_nc - i) / b_nc; - sz = (sz > 10 ? sz : 10) + x_nz; - x.change_capacity (sz); - x_nz = sz; + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * (b_nc - i) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + x.change_capacity (sz); + x_nz = sz; + } + + x.xdata (ii) = tmp; + x.xridx (ii++) = j; } - - x.xdata (ii) = tmp; - x.xridx (ii++) = j; } + + x.xcidx (i+1) = ii; } - x.xcidx (i+1) = ii; - } - - info = 0; - - x.maybe_compress (); - - return x; + info = 0; + + x.maybe_compress (); + + return x; #else - octave_unused_parameter (b); - - return SparseComplexMatrix (); + octave_unused_parameter (b); + + return SparseComplexMatrix (); #endif -} - -template <typename SPARSE_T> -sparse_qr<SPARSE_T>::sparse_qr (void) - : rep (new sparse_qr_rep (SPARSE_T (), 0)) -{ } - -template <typename SPARSE_T> -sparse_qr<SPARSE_T>::sparse_qr (const SPARSE_T& a, int order) - : rep (new sparse_qr_rep (a, order)) -{ } - -template <typename SPARSE_T> -sparse_qr<SPARSE_T>::sparse_qr (const sparse_qr<SPARSE_T>& a) - : rep (a.rep) -{ - rep->count++; -} - -template <typename SPARSE_T> -sparse_qr<SPARSE_T>::~sparse_qr (void) -{ - if (--rep->count == 0) - delete rep; -} - -template <typename SPARSE_T> -sparse_qr<SPARSE_T>& -sparse_qr<SPARSE_T>::operator = (const sparse_qr<SPARSE_T>& a) -{ - if (this != &a) + } + + template <> + template <> + SparseComplexMatrix + sparse_qr<SparseComplexMatrix>::sparse_qr_rep::wide_solve<SparseComplexMatrix, SparseComplexMatrix> + (const SparseComplexMatrix& b, octave_idx_type& info) const + { + info = -1; + +#if defined (HAVE_CXSPARSE) + + // These are swapped because the original matrix was transposed in + // sparse_qr<SparseComplexMatrix>::solve. + + octave_idx_type nr = ncols; + octave_idx_type nc = nrows; + + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nr = b.rows (); + + SparseComplexMatrix x (nc, b_nc, b.nnz ()); + x.xcidx (0) = 0; + + volatile octave_idx_type x_nz = b.nnz (); + volatile octave_idx_type ii = 0; + volatile octave_idx_type nbuf = (nc > S->m2 ? nc : S->m2); + + OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); + OCTAVE_LOCAL_BUFFER (cs_complex_t, buf, nbuf); + OCTAVE_LOCAL_BUFFER (double, B, nr); + + for (octave_idx_type i = 0; i < nr; i++) + B[i] = N->B[i]; + + for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) + { + octave_quit (); + + for (octave_idx_type j = 0; j < b_nr; j++) + Xx[j] = b.xelem (j,i); + + for (octave_idx_type j = nr; j < nbuf; j++) + buf[j] = cs_complex_t (0.0, 0.0); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_pvec) (S->q, reinterpret_cast<cs_complex_t *>(Xx), buf, nr); + CXSPARSE_ZNAME (_utsolve) (N->U, buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (volatile octave_idx_type j = nr-1; j >= 0; j--) + { + octave_quit (); + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_happly) (N->L, j, B[j], buf); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + CXSPARSE_ZNAME (_pvec) (S->pinv, buf, reinterpret_cast<cs_complex_t *>(Xx), nc); + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + for (octave_idx_type j = 0; j < nc; j++) + { + Complex tmp = Xx[j]; + + if (tmp != 0.0) + { + if (ii == x_nz) + { + // Resize the sparse matrix + octave_idx_type sz = x_nz * (b_nc - i) / b_nc; + sz = (sz > 10 ? sz : 10) + x_nz; + x.change_capacity (sz); + x_nz = sz; + } + + x.xdata (ii) = tmp; + x.xridx (ii++) = j; + } + } + + x.xcidx (i+1) = ii; + } + + info = 0; + + x.maybe_compress (); + + return x; + +#else + + octave_unused_parameter (b); + + return SparseComplexMatrix (); + +#endif + } + + template <typename SPARSE_T> + sparse_qr<SPARSE_T>::sparse_qr (void) + : rep (new sparse_qr_rep (SPARSE_T (), 0)) + { } + + template <typename SPARSE_T> + sparse_qr<SPARSE_T>::sparse_qr (const SPARSE_T& a, int order) + : rep (new sparse_qr_rep (a, order)) + { } + + template <typename SPARSE_T> + sparse_qr<SPARSE_T>::sparse_qr (const sparse_qr<SPARSE_T>& a) + : rep (a.rep) + { + rep->count++; + } + + template <typename SPARSE_T> + sparse_qr<SPARSE_T>::~sparse_qr (void) { if (--rep->count == 0) delete rep; - - rep = a.rep; - rep->count++; + } + + template <typename SPARSE_T> + sparse_qr<SPARSE_T>& + sparse_qr<SPARSE_T>::operator = (const sparse_qr<SPARSE_T>& a) + { + if (this != &a) + { + if (--rep->count == 0) + delete rep; + + rep = a.rep; + rep->count++; + } + + return *this; + } + + template <typename SPARSE_T> + bool + sparse_qr<SPARSE_T>::ok (void) const + { + return rep->ok (); + } + + template <typename SPARSE_T> + SPARSE_T + sparse_qr<SPARSE_T>::V (void) const + { + return rep->V (); + } + + template <typename SPARSE_T> + ColumnVector + sparse_qr<SPARSE_T>::Pinv (void) const + { + return rep->P (); + } + + template <typename SPARSE_T> + ColumnVector + sparse_qr<SPARSE_T>::P (void) const + { + return rep->P (); + } + + template <typename SPARSE_T> + SPARSE_T + sparse_qr<SPARSE_T>::R (bool econ) const + { + return rep->R (econ); + } + + template <typename SPARSE_T> + typename SPARSE_T::dense_matrix_type + sparse_qr<SPARSE_T>::C (const typename SPARSE_T::dense_matrix_type& b) const + { + return rep->C (b); + } + + template <typename SPARSE_T> + typename SPARSE_T::dense_matrix_type + sparse_qr<SPARSE_T>::Q (void) const + { + return rep->Q (); } - return *this; -} - -template <typename SPARSE_T> -bool -sparse_qr<SPARSE_T>::ok (void) const -{ - return rep->ok (); -} - -template <typename SPARSE_T> -SPARSE_T -sparse_qr<SPARSE_T>::V (void) const -{ - return rep->V (); -} - -template <typename SPARSE_T> -ColumnVector -sparse_qr<SPARSE_T>::Pinv (void) const -{ - return rep->P (); -} - -template <typename SPARSE_T> -ColumnVector -sparse_qr<SPARSE_T>::P (void) const -{ - return rep->P (); -} - -template <typename SPARSE_T> -SPARSE_T -sparse_qr<SPARSE_T>::R (bool econ) const -{ - return rep->R (econ); -} - -template <typename SPARSE_T> -typename SPARSE_T::dense_matrix_type -sparse_qr<SPARSE_T>::C (const typename SPARSE_T::dense_matrix_type& b) const -{ - return rep->C (b); -} - -template <typename SPARSE_T> -typename SPARSE_T::dense_matrix_type -sparse_qr<SPARSE_T>::Q (void) const -{ - return rep->Q (); + // FIXME: Why is the "order" of the QR calculation as used in the + // CXSparse function sqr 3 for real matrices and 2 for complex? These + // values seem to be required but there was no explanation in David + // Bateman's original code. + + template <typename SPARSE_T> + class + cxsparse_defaults + { + public: + enum { order = -1 }; + }; + + template <> + class + cxsparse_defaults<SparseMatrix> + { + public: + enum { order = 3 }; + }; + + template <> + class + cxsparse_defaults<SparseComplexMatrix> + { + public: + enum { order = 2 }; + }; + + template <typename SPARSE_T> + template <typename RHS_T, typename RET_T> + RET_T + sparse_qr<SPARSE_T>::solve (const SPARSE_T& a, const RHS_T& b, + octave_idx_type& info) + { + info = -1; + + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + octave_idx_type b_nc = b.cols (); + octave_idx_type b_nr = b.rows (); + + int order = cxsparse_defaults<SPARSE_T>::order; + + if (nr < 0 || nc < 0 || nr != b_nr) + (*current_liboctave_error_handler) + ("matrix dimension mismatch in solution of minimum norm problem"); + + if (nr == 0 || nc == 0 || b_nc == 0) + { + info = 0; + + return RET_T (nc, b_nc, 0.0); + } + else if (nr >= nc) + { + sparse_qr<SPARSE_T> q (a, order); + + return q.ok () ? q.tall_solve<RHS_T, RET_T> (b, info) : RET_T (); + } + else + { + sparse_qr<SPARSE_T> q (a.hermitian (), order); + + return q.ok () ? q.wide_solve<RHS_T, RET_T> (b, info) : RET_T (); + } + } + + template <typename SPARSE_T> + template <typename RHS_T, typename RET_T> + RET_T + sparse_qr<SPARSE_T>::tall_solve (const RHS_T& b, octave_idx_type& info) const + { + return rep->template tall_solve<RHS_T, RET_T> (b, info); + } + + template <typename SPARSE_T> + template <typename RHS_T, typename RET_T> + RET_T + sparse_qr<SPARSE_T>::wide_solve (const RHS_T& b, octave_idx_type& info) const + { + return rep->template wide_solve<RHS_T, RET_T> (b, info); + } + + Matrix + qrsolve (const SparseMatrix& a, const MArray<double>& b, + octave_idx_type& info) + { + return sparse_qr<SparseMatrix>::solve<MArray<double>, Matrix> (a, b, info); + } + + SparseMatrix + qrsolve (const SparseMatrix& a, const SparseMatrix& b, + octave_idx_type& info) + { + return sparse_qr<SparseMatrix>::solve<SparseMatrix, SparseMatrix> (a, b, info); + } + + ComplexMatrix + qrsolve (const SparseMatrix& a, const MArray<Complex>& b, + octave_idx_type& info) + { + return sparse_qr<SparseMatrix>::solve<MArray<Complex>, ComplexMatrix> (a, b, info); + } + + SparseComplexMatrix + qrsolve (const SparseMatrix& a, const SparseComplexMatrix& b, + octave_idx_type& info) + { + return sparse_qr<SparseMatrix>::solve<SparseComplexMatrix, SparseComplexMatrix> (a, b, info); + } + + ComplexMatrix + qrsolve (const SparseComplexMatrix& a, const MArray<double>& b, + octave_idx_type& info) + { + return sparse_qr<SparseComplexMatrix>::solve<MArray<double>, ComplexMatrix> (a, b, info); + } + + SparseComplexMatrix + qrsolve (const SparseComplexMatrix& a, const SparseMatrix& b, + octave_idx_type& info) + { + return sparse_qr<SparseComplexMatrix>::solve<SparseMatrix, SparseComplexMatrix> (a, b, info); + } + + ComplexMatrix + qrsolve (const SparseComplexMatrix& a, const MArray<Complex>& b, + octave_idx_type& info) + { + return sparse_qr<SparseComplexMatrix>::solve<MArray<Complex>, ComplexMatrix> (a, b, info); + } + + SparseComplexMatrix + qrsolve (const SparseComplexMatrix& a, const SparseComplexMatrix& b, + octave_idx_type& info) + { + return sparse_qr<SparseComplexMatrix>::solve<SparseComplexMatrix, SparseComplexMatrix> (a, b, info); + } + + // Instantiations we need. + + template class sparse_qr<SparseMatrix>; + + template class sparse_qr<SparseComplexMatrix>; + } } - -// FIXME: Why is the "order" of the QR calculation as used in the -// CXSparse function sqr 3 for real matrices and 2 for complex? These -// values seem to be required but there was no explanation in David -// Bateman's original code. - -template <typename SPARSE_T> -class -cxsparse_defaults -{ -public: - enum { order = -1 }; -}; - -template <> -class -cxsparse_defaults<SparseMatrix> -{ -public: - enum { order = 3 }; -}; - -template <> -class -cxsparse_defaults<SparseComplexMatrix> -{ -public: - enum { order = 2 }; -}; - -template <typename SPARSE_T> -template <typename RHS_T, typename RET_T> -RET_T -sparse_qr<SPARSE_T>::solve (const SPARSE_T& a, const RHS_T& b, - octave_idx_type& info) -{ - info = -1; - - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.cols (); - - octave_idx_type b_nc = b.cols (); - octave_idx_type b_nr = b.rows (); - - int order = cxsparse_defaults<SPARSE_T>::order; - - if (nr < 0 || nc < 0 || nr != b_nr) - (*current_liboctave_error_handler) - ("matrix dimension mismatch in solution of minimum norm problem"); - - if (nr == 0 || nc == 0 || b_nc == 0) - { - info = 0; - - return RET_T (nc, b_nc, 0.0); - } - else if (nr >= nc) - { - sparse_qr<SPARSE_T> q (a, order); - - return q.ok () ? q.tall_solve<RHS_T, RET_T> (b, info) : RET_T (); - } - else - { - sparse_qr<SPARSE_T> q (a.hermitian (), order); - - return q.ok () ? q.wide_solve<RHS_T, RET_T> (b, info) : RET_T (); - } -} - -template <typename SPARSE_T> -template <typename RHS_T, typename RET_T> -RET_T -sparse_qr<SPARSE_T>::tall_solve (const RHS_T& b, octave_idx_type& info) const -{ - return rep->template tall_solve<RHS_T, RET_T> (b, info); -} - -template <typename SPARSE_T> -template <typename RHS_T, typename RET_T> -RET_T -sparse_qr<SPARSE_T>::wide_solve (const RHS_T& b, octave_idx_type& info) const -{ - return rep->template wide_solve<RHS_T, RET_T> (b, info); -} - -Matrix -qrsolve (const SparseMatrix& a, const MArray<double>& b, - octave_idx_type& info) -{ - return sparse_qr<SparseMatrix>::solve<MArray<double>, Matrix> (a, b, info); -} - -SparseMatrix -qrsolve (const SparseMatrix& a, const SparseMatrix& b, - octave_idx_type& info) -{ - return sparse_qr<SparseMatrix>::solve<SparseMatrix, SparseMatrix> (a, b, info); -} - -ComplexMatrix -qrsolve (const SparseMatrix& a, const MArray<Complex>& b, - octave_idx_type& info) -{ - return sparse_qr<SparseMatrix>::solve<MArray<Complex>, ComplexMatrix> (a, b, info); -} - -SparseComplexMatrix -qrsolve (const SparseMatrix& a, const SparseComplexMatrix& b, - octave_idx_type& info) -{ - return sparse_qr<SparseMatrix>::solve<SparseComplexMatrix, SparseComplexMatrix> (a, b, info); -} - -ComplexMatrix -qrsolve (const SparseComplexMatrix& a, const MArray<double>& b, - octave_idx_type& info) -{ - return sparse_qr<SparseComplexMatrix>::solve<MArray<double>, ComplexMatrix> (a, b, info); -} - -SparseComplexMatrix -qrsolve (const SparseComplexMatrix& a, const SparseMatrix& b, - octave_idx_type& info) -{ - return sparse_qr<SparseComplexMatrix>::solve<SparseMatrix, SparseComplexMatrix> (a, b, info); -} - -ComplexMatrix -qrsolve (const SparseComplexMatrix& a, const MArray<Complex>& b, - octave_idx_type& info) -{ - return sparse_qr<SparseComplexMatrix>::solve<MArray<Complex>, ComplexMatrix> (a, b, info); -} - -SparseComplexMatrix -qrsolve (const SparseComplexMatrix& a, const SparseComplexMatrix& b, - octave_idx_type& info) -{ - return sparse_qr<SparseComplexMatrix>::solve<SparseComplexMatrix, SparseComplexMatrix> (a, b, info); -} - -// Instantiations we need. - -template class sparse_qr<SparseMatrix>; - -template class sparse_qr<SparseComplexMatrix>; - -} -}
--- a/liboctave/numeric/sparse-qr.h Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/sparse-qr.h Wed Aug 17 10:55:38 2016 -0400 @@ -33,104 +33,102 @@ namespace octave { -namespace math -{ - -// If the sparse matrix classes become templated on the element type -// (i.e., sparse_matrix<double>), then it might be best to make the -// template parameter of this class also be the element type instead -// of the matrix type. + namespace math + { + // If the sparse matrix classes become templated on the element type + // (i.e., sparse_matrix<double>), then it might be best to make the + // template parameter of this class also be the element type instead + // of the matrix type. -template <typename SPARSE_T> -class -sparse_qr -{ -public: + template <typename SPARSE_T> + class + sparse_qr + { + public: - sparse_qr (void); + sparse_qr (void); - sparse_qr (const SPARSE_T& a, int order = 0); + sparse_qr (const SPARSE_T& a, int order = 0); - sparse_qr (const sparse_qr& a); + sparse_qr (const sparse_qr& a); - ~sparse_qr (void); + ~sparse_qr (void); - sparse_qr& operator = (const sparse_qr& a); + sparse_qr& operator = (const sparse_qr& a); - bool ok (void) const; + bool ok (void) const; - SPARSE_T V (void) const; + SPARSE_T V (void) const; - ColumnVector Pinv (void) const; + ColumnVector Pinv (void) const; - ColumnVector P (void) const; + ColumnVector P (void) const; - SPARSE_T R (bool econ = false) const; + SPARSE_T R (bool econ = false) const; - typename SPARSE_T::dense_matrix_type - C (const typename SPARSE_T::dense_matrix_type& b) const; + typename SPARSE_T::dense_matrix_type + C (const typename SPARSE_T::dense_matrix_type& b) const; - typename SPARSE_T::dense_matrix_type - Q (void) const; + typename SPARSE_T::dense_matrix_type + Q (void) const; - template <typename RHS_T, typename RET_T> - static RET_T - solve (const SPARSE_T& a, const RHS_T& b, - octave_idx_type& info); + template <typename RHS_T, typename RET_T> + static RET_T + solve (const SPARSE_T& a, const RHS_T& b, + octave_idx_type& info); -private: + private: - class sparse_qr_rep; + class sparse_qr_rep; - sparse_qr_rep *rep; + sparse_qr_rep *rep; - template <typename RHS_T, typename RET_T> - RET_T - tall_solve (const RHS_T& b, octave_idx_type& info) const; - - template <typename RHS_T, typename RET_T> - RET_T - wide_solve (const RHS_T& b, octave_idx_type& info) const; -}; + template <typename RHS_T, typename RET_T> + RET_T + tall_solve (const RHS_T& b, octave_idx_type& info) const; -// Provide qrsolve for backward compatibility. + template <typename RHS_T, typename RET_T> + RET_T + wide_solve (const RHS_T& b, octave_idx_type& info) const; + }; -extern Matrix -qrsolve (const SparseMatrix& a, const MArray<double>& b, - octave_idx_type& info); + // Provide qrsolve for backward compatibility. -extern SparseMatrix -qrsolve (const SparseMatrix& a, const SparseMatrix& b, - octave_idx_type& info); + extern Matrix + qrsolve (const SparseMatrix& a, const MArray<double>& b, + octave_idx_type& info); -extern ComplexMatrix -qrsolve (const SparseMatrix& a, const MArray<Complex>& b, - octave_idx_type& info); + extern SparseMatrix + qrsolve (const SparseMatrix& a, const SparseMatrix& b, + octave_idx_type& info); -extern SparseComplexMatrix -qrsolve (const SparseMatrix& a, const SparseComplexMatrix& b, - octave_idx_type& info); + extern ComplexMatrix + qrsolve (const SparseMatrix& a, const MArray<Complex>& b, + octave_idx_type& info); -extern ComplexMatrix -qrsolve (const SparseComplexMatrix& a, const MArray<double>& b, - octave_idx_type& info); + extern SparseComplexMatrix + qrsolve (const SparseMatrix& a, const SparseComplexMatrix& b, + octave_idx_type& info); -extern SparseComplexMatrix -qrsolve (const SparseComplexMatrix& a, const SparseMatrix& b, - octave_idx_type& info); + extern ComplexMatrix + qrsolve (const SparseComplexMatrix& a, const MArray<double>& b, + octave_idx_type& info); -extern ComplexMatrix -qrsolve (const SparseComplexMatrix& a, const MArray<Complex>& b, - octave_idx_type& info); + extern SparseComplexMatrix + qrsolve (const SparseComplexMatrix& a, const SparseMatrix& b, + octave_idx_type& info); + + extern ComplexMatrix + qrsolve (const SparseComplexMatrix& a, const MArray<Complex>& b, + octave_idx_type& info); -extern SparseComplexMatrix -qrsolve (const SparseComplexMatrix& a, const SparseComplexMatrix& b, - octave_idx_type& info); + extern SparseComplexMatrix + qrsolve (const SparseComplexMatrix& a, const SparseComplexMatrix& b, + octave_idx_type& info); -typedef sparse_qr<SparseMatrix> SparseQR; -typedef sparse_qr<SparseComplexMatrix> SparseComplexQR; - -} + typedef sparse_qr<SparseMatrix> SparseQR; + typedef sparse_qr<SparseComplexMatrix> SparseComplexQR; + } } #endif
--- a/liboctave/numeric/svd.cc Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/svd.cc Wed Aug 17 10:55:38 2016 -0400 @@ -42,376 +42,374 @@ namespace octave { -namespace math -{ - -template <typename T> -T -svd<T>::left_singular_matrix (void) const -{ - if (m_type == svd::Type::sigma_only) - (*current_liboctave_error_handler) - ("svd: U not computed because type == svd::sigma_only"); + namespace math + { + template <typename T> + T + svd<T>::left_singular_matrix (void) const + { + if (m_type == svd::Type::sigma_only) + (*current_liboctave_error_handler) + ("svd: U not computed because type == svd::sigma_only"); - return left_sm; -} + return left_sm; + } -template <typename T> -T -svd<T>::right_singular_matrix (void) const -{ - if (m_type == svd::Type::sigma_only) - (*current_liboctave_error_handler) - ("svd: V not computed because type == svd::sigma_only"); + template <typename T> + T + svd<T>::right_singular_matrix (void) const + { + if (m_type == svd::Type::sigma_only) + (*current_liboctave_error_handler) + ("svd: V not computed because type == svd::sigma_only"); - return right_sm; -} + return right_sm; + } -// GESVD specializations + // GESVD specializations -#define GESVD_REAL_STEP(f, F) \ - F77_XFCN (f, F, (F77_CONST_CHAR_ARG2 (&jobu, 1), \ - F77_CONST_CHAR_ARG2 (&jobv, 1), \ - m, n, tmp_data, m1, s_vec, u, m1, vt, \ - nrow_vt1, work.data (), lwork, info \ - F77_CHAR_ARG_LEN (1) \ - F77_CHAR_ARG_LEN (1))) +#define GESVD_REAL_STEP(f, F) \ + F77_XFCN (f, F, (F77_CONST_CHAR_ARG2 (&jobu, 1), \ + F77_CONST_CHAR_ARG2 (&jobv, 1), \ + m, n, tmp_data, m1, s_vec, u, m1, vt, \ + nrow_vt1, work.data (), lwork, info \ + F77_CHAR_ARG_LEN (1) \ + F77_CHAR_ARG_LEN (1))) -#define GESVD_COMPLEX_STEP(f, F, CMPLX_ARG) \ - F77_XFCN (f, F, (F77_CONST_CHAR_ARG2 (&jobu, 1), \ - F77_CONST_CHAR_ARG2 (&jobv, 1), \ - m, n, CMPLX_ARG (tmp_data), \ - m1, s_vec, CMPLX_ARG (u), m1, \ - CMPLX_ARG (vt), nrow_vt1, \ - CMPLX_ARG (work.data ()), \ - lwork, rwork.data (), info \ - F77_CHAR_ARG_LEN (1) \ - F77_CHAR_ARG_LEN (1))) +#define GESVD_COMPLEX_STEP(f, F, CMPLX_ARG) \ + F77_XFCN (f, F, (F77_CONST_CHAR_ARG2 (&jobu, 1), \ + F77_CONST_CHAR_ARG2 (&jobv, 1), \ + m, n, CMPLX_ARG (tmp_data), \ + m1, s_vec, CMPLX_ARG (u), m1, \ + CMPLX_ARG (vt), nrow_vt1, \ + CMPLX_ARG (work.data ()), \ + lwork, rwork.data (), info \ + F77_CHAR_ARG_LEN (1) \ + F77_CHAR_ARG_LEN (1))) -// DGESVD -template<> -void -svd<Matrix>::gesvd (char& jobu, char& jobv, octave_idx_type m, - octave_idx_type n, double* tmp_data, octave_idx_type m1, - double* s_vec, double* u, double* vt, - octave_idx_type nrow_vt1, std::vector<double>& work, - octave_idx_type& lwork, octave_idx_type& info) -{ - GESVD_REAL_STEP (dgesvd, DGESVD); + // DGESVD + template<> + void + svd<Matrix>::gesvd (char& jobu, char& jobv, octave_idx_type m, + octave_idx_type n, double* tmp_data, octave_idx_type m1, + double* s_vec, double* u, double* vt, + octave_idx_type nrow_vt1, std::vector<double>& work, + octave_idx_type& lwork, octave_idx_type& info) + { + GESVD_REAL_STEP (dgesvd, DGESVD); - lwork = work[0]; - work.reserve (lwork); + lwork = work[0]; + work.reserve (lwork); - GESVD_REAL_STEP (dgesvd, DGESVD); -} + GESVD_REAL_STEP (dgesvd, DGESVD); + } -// SGESVD -template<> -void -svd<FloatMatrix>::gesvd (char& jobu, char& jobv, octave_idx_type m, - octave_idx_type n, float* tmp_data, - octave_idx_type m1, float* s_vec, float* u, float* vt, - octave_idx_type nrow_vt1, std::vector<float>& work, - octave_idx_type& lwork, octave_idx_type& info) -{ - GESVD_REAL_STEP (sgesvd, SGESVD); + // SGESVD + template<> + void + svd<FloatMatrix>::gesvd (char& jobu, char& jobv, octave_idx_type m, + octave_idx_type n, float* tmp_data, + octave_idx_type m1, float* s_vec, float* u, float* vt, + octave_idx_type nrow_vt1, std::vector<float>& work, + octave_idx_type& lwork, octave_idx_type& info) + { + GESVD_REAL_STEP (sgesvd, SGESVD); - lwork = work[0]; - work.reserve (lwork); + lwork = work[0]; + work.reserve (lwork); - GESVD_REAL_STEP (sgesvd, SGESVD); -} + GESVD_REAL_STEP (sgesvd, SGESVD); + } -// ZGESVD -template<> -void -svd<ComplexMatrix>::gesvd (char& jobu, char& jobv, octave_idx_type m, - octave_idx_type n, Complex* tmp_data, - octave_idx_type m1, double* s_vec, Complex* u, - Complex* vt, octave_idx_type nrow_vt1, - std::vector<Complex>& work, - octave_idx_type& lwork, octave_idx_type& info) -{ - std::vector<double> rwork (5 * std::max (m, n)); + // ZGESVD + template<> + void + svd<ComplexMatrix>::gesvd (char& jobu, char& jobv, octave_idx_type m, + octave_idx_type n, Complex* tmp_data, + octave_idx_type m1, double* s_vec, Complex* u, + Complex* vt, octave_idx_type nrow_vt1, + std::vector<Complex>& work, + octave_idx_type& lwork, octave_idx_type& info) + { + std::vector<double> rwork (5 * std::max (m, n)); - GESVD_COMPLEX_STEP (zgesvd, ZGESVD, F77_DBLE_CMPLX_ARG); + GESVD_COMPLEX_STEP (zgesvd, ZGESVD, F77_DBLE_CMPLX_ARG); - lwork = work[0].real (); - work.reserve (lwork); + lwork = work[0].real (); + work.reserve (lwork); - GESVD_COMPLEX_STEP (zgesvd, ZGESVD, F77_DBLE_CMPLX_ARG); -} + GESVD_COMPLEX_STEP (zgesvd, ZGESVD, F77_DBLE_CMPLX_ARG); + } -// CGESVD -template<> -void -svd<FloatComplexMatrix>::gesvd (char& jobu, char& jobv, - octave_idx_type m, octave_idx_type n, - FloatComplex* tmp_data, octave_idx_type m1, - float* s_vec, FloatComplex* u, - FloatComplex* vt, octave_idx_type nrow_vt1, - std::vector<FloatComplex>& work, - octave_idx_type& lwork, octave_idx_type& info) -{ - std::vector<float> rwork (5 * std::max (m, n)); + // CGESVD + template<> + void + svd<FloatComplexMatrix>::gesvd (char& jobu, char& jobv, + octave_idx_type m, octave_idx_type n, + FloatComplex* tmp_data, octave_idx_type m1, + float* s_vec, FloatComplex* u, + FloatComplex* vt, octave_idx_type nrow_vt1, + std::vector<FloatComplex>& work, + octave_idx_type& lwork, octave_idx_type& info) + { + std::vector<float> rwork (5 * std::max (m, n)); - GESVD_COMPLEX_STEP (cgesvd, CGESVD, F77_CMPLX_ARG); + GESVD_COMPLEX_STEP (cgesvd, CGESVD, F77_CMPLX_ARG); - lwork = work[0].real (); - work.reserve (lwork); + lwork = work[0].real (); + work.reserve (lwork); - GESVD_COMPLEX_STEP (cgesvd, CGESVD, F77_CMPLX_ARG); -} + GESVD_COMPLEX_STEP (cgesvd, CGESVD, F77_CMPLX_ARG); + } #undef GESVD_REAL_STEP #undef GESVD_COMPLEX_STEP -// GESDD specializations + // GESDD specializations -#define GESDD_REAL_STEP(f, F) \ - F77_XFCN (f, F, (F77_CONST_CHAR_ARG2 (&jobz, 1), \ - m, n, tmp_data, m1, s_vec, u, m1, vt, nrow_vt1, \ - work.data (), lwork, iwork, info \ - F77_CHAR_ARG_LEN (1))) +#define GESDD_REAL_STEP(f, F) \ + F77_XFCN (f, F, (F77_CONST_CHAR_ARG2 (&jobz, 1), \ + m, n, tmp_data, m1, s_vec, u, m1, vt, nrow_vt1, \ + work.data (), lwork, iwork, info \ + F77_CHAR_ARG_LEN (1))) -#define GESDD_COMPLEX_STEP(f, F, CMPLX_ARG) \ - F77_XFCN (f, F, (F77_CONST_CHAR_ARG2 (&jobz, 1), m, n, \ - CMPLX_ARG (tmp_data), m1, \ - s_vec, CMPLX_ARG (u), m1, \ - CMPLX_ARG (vt), nrow_vt1, \ - CMPLX_ARG (work.data ()), lwork, \ - rwork.data (), iwork, info \ - F77_CHAR_ARG_LEN (1))) +#define GESDD_COMPLEX_STEP(f, F, CMPLX_ARG) \ + F77_XFCN (f, F, (F77_CONST_CHAR_ARG2 (&jobz, 1), m, n, \ + CMPLX_ARG (tmp_data), m1, \ + s_vec, CMPLX_ARG (u), m1, \ + CMPLX_ARG (vt), nrow_vt1, \ + CMPLX_ARG (work.data ()), lwork, \ + rwork.data (), iwork, info \ + F77_CHAR_ARG_LEN (1))) -// DGESDD -template<> -void -svd<Matrix>::gesdd (char& jobz, octave_idx_type m, octave_idx_type n, - double* tmp_data, octave_idx_type m1, - double* s_vec, double* u, - double* vt, octave_idx_type nrow_vt1, - std::vector<double>& work, octave_idx_type& lwork, - octave_idx_type* iwork, octave_idx_type& info) -{ - GESDD_REAL_STEP (dgesdd, DGESDD); + // DGESDD + template<> + void + svd<Matrix>::gesdd (char& jobz, octave_idx_type m, octave_idx_type n, + double* tmp_data, octave_idx_type m1, + double* s_vec, double* u, + double* vt, octave_idx_type nrow_vt1, + std::vector<double>& work, octave_idx_type& lwork, + octave_idx_type* iwork, octave_idx_type& info) + { + GESDD_REAL_STEP (dgesdd, DGESDD); - lwork = work[0]; - work.reserve (lwork); + lwork = work[0]; + work.reserve (lwork); - GESDD_REAL_STEP (dgesdd, DGESDD); -} + GESDD_REAL_STEP (dgesdd, DGESDD); + } -// SGESDD -template<> -void -svd<FloatMatrix>::gesdd (char& jobz, octave_idx_type m, octave_idx_type n, - float* tmp_data, octave_idx_type m1, - float* s_vec, float* u, - float* vt, octave_idx_type nrow_vt1, - std::vector<float>& work, octave_idx_type& lwork, - octave_idx_type* iwork, octave_idx_type& info) -{ - GESDD_REAL_STEP (sgesdd, SGESDD); + // SGESDD + template<> + void + svd<FloatMatrix>::gesdd (char& jobz, octave_idx_type m, octave_idx_type n, + float* tmp_data, octave_idx_type m1, + float* s_vec, float* u, + float* vt, octave_idx_type nrow_vt1, + std::vector<float>& work, octave_idx_type& lwork, + octave_idx_type* iwork, octave_idx_type& info) + { + GESDD_REAL_STEP (sgesdd, SGESDD); - lwork = work[0]; - work.reserve (lwork); + lwork = work[0]; + work.reserve (lwork); - GESDD_REAL_STEP (sgesdd, SGESDD); -} + GESDD_REAL_STEP (sgesdd, SGESDD); + } -// ZGESDD -template<> -void -svd<ComplexMatrix>::gesdd (char& jobz, octave_idx_type m, octave_idx_type n, - Complex* tmp_data, octave_idx_type m1, - double* s_vec, Complex* u, - Complex* vt, octave_idx_type nrow_vt1, - std::vector<Complex>& work, octave_idx_type& lwork, - octave_idx_type* iwork, octave_idx_type& info) -{ + // ZGESDD + template<> + void + svd<ComplexMatrix>::gesdd (char& jobz, octave_idx_type m, octave_idx_type n, + Complex* tmp_data, octave_idx_type m1, + double* s_vec, Complex* u, + Complex* vt, octave_idx_type nrow_vt1, + std::vector<Complex>& work, octave_idx_type& lwork, + octave_idx_type* iwork, octave_idx_type& info) + { - octave_idx_type min_mn = std::min (m, n); + octave_idx_type min_mn = std::min (m, n); - octave_idx_type lrwork; - if (jobz == 'N') - lrwork = 7*min_mn; - else - lrwork = 5*min_mn*min_mn + 5*min_mn; + octave_idx_type lrwork; + if (jobz == 'N') + lrwork = 7*min_mn; + else + lrwork = 5*min_mn*min_mn + 5*min_mn; - std::vector<double> rwork (lrwork); + std::vector<double> rwork (lrwork); - GESDD_COMPLEX_STEP (zgesdd, ZGESDD, F77_DBLE_CMPLX_ARG); + GESDD_COMPLEX_STEP (zgesdd, ZGESDD, F77_DBLE_CMPLX_ARG); - lwork = work[0].real (); - work.reserve (lwork); + lwork = work[0].real (); + work.reserve (lwork); - GESDD_COMPLEX_STEP (zgesdd, ZGESDD, F77_DBLE_CMPLX_ARG); -} + GESDD_COMPLEX_STEP (zgesdd, ZGESDD, F77_DBLE_CMPLX_ARG); + } -// CGESDD -template<> -void -svd<FloatComplexMatrix>::gesdd (char& jobz, octave_idx_type m, - octave_idx_type n, - FloatComplex* tmp_data, octave_idx_type m1, - float* s_vec, FloatComplex* u, - FloatComplex* vt, octave_idx_type nrow_vt1, - std::vector<FloatComplex>& work, - octave_idx_type& lwork, octave_idx_type* iwork, - octave_idx_type& info) -{ - octave_idx_type min_mn = std::min (m, n); - octave_idx_type max_mn = std::max (m, n); + // CGESDD + template<> + void + svd<FloatComplexMatrix>::gesdd (char& jobz, octave_idx_type m, + octave_idx_type n, + FloatComplex* tmp_data, octave_idx_type m1, + float* s_vec, FloatComplex* u, + FloatComplex* vt, octave_idx_type nrow_vt1, + std::vector<FloatComplex>& work, + octave_idx_type& lwork, octave_idx_type* iwork, + octave_idx_type& info) + { + octave_idx_type min_mn = std::min (m, n); + octave_idx_type max_mn = std::max (m, n); - octave_idx_type lrwork; - if (jobz == 'N') - lrwork = 5*min_mn; - else - lrwork = min_mn * std::max (5*min_mn+7, 2*max_mn+2*min_mn+1); - std::vector<float> rwork (lrwork); + octave_idx_type lrwork; + if (jobz == 'N') + lrwork = 5*min_mn; + else + lrwork = min_mn * std::max (5*min_mn+7, 2*max_mn+2*min_mn+1); + std::vector<float> rwork (lrwork); - GESDD_COMPLEX_STEP (cgesdd, CGESDD, F77_CMPLX_ARG); + GESDD_COMPLEX_STEP (cgesdd, CGESDD, F77_CMPLX_ARG); - lwork = work[0].real (); - work.reserve (lwork); + lwork = work[0].real (); + work.reserve (lwork); - GESDD_COMPLEX_STEP (cgesdd, CGESDD, F77_CMPLX_ARG); -} + GESDD_COMPLEX_STEP (cgesdd, CGESDD, F77_CMPLX_ARG); + } #undef GESDD_REAL_STEP #undef GESDD_COMPLEX_STEP -template<typename T> -svd<T>::svd (const T& a, svd::Type type, - svd::Driver driver) - : m_type (type), m_driver (driver), left_sm (), sigma (), right_sm () -{ - octave_idx_type info; + template<typename T> + svd<T>::svd (const T& a, svd::Type type, + svd::Driver driver) + : m_type (type), m_driver (driver), left_sm (), sigma (), right_sm () + { + octave_idx_type info; + + octave_idx_type m = a.rows (); + octave_idx_type n = a.cols (); + + if (m == 0 || n == 0) + { + switch (m_type) + { + case svd::Type::std: + left_sm = T (m, m, 0); + for (octave_idx_type i = 0; i < m; i++) + left_sm.xelem (i, i) = 1; + sigma = DM_T (m, n); + right_sm = T (n, n, 0); + for (octave_idx_type i = 0; i < n; i++) + right_sm.xelem (i, i) = 1; + break; - octave_idx_type m = a.rows (); - octave_idx_type n = a.cols (); + case svd::Type::economy: + left_sm = T (m, 0, 0); + sigma = DM_T (0, 0); + right_sm = T (0, n, 0); + break; + + case svd::Type::sigma_only: + default: + sigma = DM_T (0, 1); + break; + } + return; + } - if (m == 0 || n == 0) - { + T atmp = a; + P* tmp_data = atmp.fortran_vec (); + + octave_idx_type min_mn = m < n ? m : n; + + char jobu = 'A'; + char jobv = 'A'; + + octave_idx_type ncol_u = m; + octave_idx_type nrow_vt = n; + octave_idx_type nrow_s = m; + octave_idx_type ncol_s = n; + switch (m_type) { - case svd::Type::std: - left_sm = T (m, m, 0); - for (octave_idx_type i = 0; i < m; i++) - left_sm.xelem (i, i) = 1; - sigma = DM_T (m, n); - right_sm = T (n, n, 0); - for (octave_idx_type i = 0; i < n; i++) - right_sm.xelem (i, i) = 1; - break; - case svd::Type::economy: - left_sm = T (m, 0, 0); - sigma = DM_T (0, 0); - right_sm = T (0, n, 0); + jobu = jobv = 'S'; + ncol_u = nrow_vt = nrow_s = ncol_s = min_mn; break; case svd::Type::sigma_only: + + // Note: for this case, both jobu and jobv should be 'N', but + // there seems to be a bug in dgesvd from Lapack V2.0. To + // demonstrate the bug, set both jobu and jobv to 'N' and find + // the singular values of [eye(3), eye(3)]. The result is + // [-sqrt(2), -sqrt(2), -sqrt(2)]. + // + // For Lapack 3.0, this problem seems to be fixed. + + jobu = jobv = 'N'; + ncol_u = nrow_vt = 1; + break; + default: - sigma = DM_T (0, 1); break; } - return; - } + + if (! (jobu == 'N' || jobu == 'O')) + left_sm.resize (m, ncol_u); - T atmp = a; - P* tmp_data = atmp.fortran_vec (); + P* u = left_sm.fortran_vec (); - octave_idx_type min_mn = m < n ? m : n; + sigma.resize (nrow_s, ncol_s); + DM_P* s_vec = sigma.fortran_vec (); - char jobu = 'A'; - char jobv = 'A'; + if (! (jobv == 'N' || jobv == 'O')) + right_sm.resize (nrow_vt, n); + + P* vt = right_sm.fortran_vec (); - octave_idx_type ncol_u = m; - octave_idx_type nrow_vt = n; - octave_idx_type nrow_s = m; - octave_idx_type ncol_s = n; + // Query _GESVD for the correct dimension of WORK. + + octave_idx_type lwork = -1; + + std::vector<P> work (1); - switch (m_type) - { - case svd::Type::economy: - jobu = jobv = 'S'; - ncol_u = nrow_vt = nrow_s = ncol_s = min_mn; - break; - - case svd::Type::sigma_only: + octave_idx_type m1 = std::max (m, static_cast<octave_idx_type> (1)); + octave_idx_type nrow_vt1 = std::max (nrow_vt, + static_cast<octave_idx_type> (1)); - // Note: for this case, both jobu and jobv should be 'N', but - // there seems to be a bug in dgesvd from Lapack V2.0. To - // demonstrate the bug, set both jobu and jobv to 'N' and find - // the singular values of [eye(3), eye(3)]. The result is - // [-sqrt(2), -sqrt(2), -sqrt(2)]. - // - // For Lapack 3.0, this problem seems to be fixed. + if (m_driver == svd::Driver::GESVD) + gesvd (jobu, jobv, m, n, tmp_data, m1, s_vec, u, vt, nrow_vt1, + work, lwork, info); + else if (m_driver == svd::Driver::GESDD) + { + assert (jobu == jobv); + char jobz = jobu; - jobu = jobv = 'N'; - ncol_u = nrow_vt = 1; - break; + std::vector<octave_idx_type> iwork (8 * std::min (m, n)); - default: - break; + gesdd (jobz, m, n, tmp_data, m1, s_vec, u, vt, nrow_vt1, + work, lwork, iwork.data (), info); + } + else + abort (); + + if (! (jobv == 'N' || jobv == 'O')) + right_sm = right_sm.transpose (); } - if (! (jobu == 'N' || jobu == 'O')) - left_sm.resize (m, ncol_u); - - P* u = left_sm.fortran_vec (); - - sigma.resize (nrow_s, ncol_s); - DM_P* s_vec = sigma.fortran_vec (); - - if (! (jobv == 'N' || jobv == 'O')) - right_sm.resize (nrow_vt, n); + // Instantiations we need. - P* vt = right_sm.fortran_vec (); - - // Query _GESVD for the correct dimension of WORK. - - octave_idx_type lwork = -1; + template class svd<Matrix>; - std::vector<P> work (1); - - octave_idx_type m1 = std::max (m, static_cast<octave_idx_type> (1)); - octave_idx_type nrow_vt1 = std::max (nrow_vt, - static_cast<octave_idx_type> (1)); + template class svd<FloatMatrix>; - if (m_driver == svd::Driver::GESVD) - gesvd (jobu, jobv, m, n, tmp_data, m1, s_vec, u, vt, nrow_vt1, - work, lwork, info); - else if (m_driver == svd::Driver::GESDD) - { - assert (jobu == jobv); - char jobz = jobu; - - std::vector<octave_idx_type> iwork (8 * std::min (m, n)); - - gesdd (jobz, m, n, tmp_data, m1, s_vec, u, vt, nrow_vt1, - work, lwork, iwork.data (), info); - } - else - abort (); + template class svd<ComplexMatrix>; - if (! (jobv == 'N' || jobv == 'O')) - right_sm = right_sm.transpose (); + template class svd<FloatComplexMatrix>; + } } - -// Instantiations we need. - -template class svd<Matrix>; - -template class svd<FloatMatrix>; - -template class svd<ComplexMatrix>; - -template class svd<FloatComplexMatrix>; - -} -}
--- a/liboctave/numeric/svd.h Wed Aug 17 10:37:57 2016 -0400 +++ b/liboctave/numeric/svd.h Wed Aug 17 10:55:38 2016 -0400 @@ -30,90 +30,87 @@ namespace octave { -namespace math -{ - -template <typename T> -class -svd -{ -public: - - typedef typename T::real_diag_matrix_type DM_T; - - enum class Type - { - std, - economy, - sigma_only - }; - - enum class Driver + namespace math { - GESVD, - GESDD - }; + template <typename T> + class + svd + { + public: + + typedef typename T::real_diag_matrix_type DM_T; - svd (void) - : m_type (), m_driver (), left_sm (), sigma (), right_sm () - { } + enum class Type + { + std, + economy, + sigma_only + }; - svd (const T& a, svd::Type type = svd::Type::std, - svd::Driver driver = svd::Driver::GESVD); + enum class Driver + { + GESVD, + GESDD + }; - svd (const svd& a) - : m_type (a.m_type), m_driver (a.m_driver), left_sm (a.left_sm), - sigma (a.sigma), right_sm (a.right_sm) - { } + svd (void) + : m_type (), m_driver (), left_sm (), sigma (), right_sm () + { } + + svd (const T& a, svd::Type type = svd::Type::std, + svd::Driver driver = svd::Driver::GESVD); + + svd (const svd& a) + : m_type (a.m_type), m_driver (a.m_driver), left_sm (a.left_sm), + sigma (a.sigma), right_sm (a.right_sm) + { } - svd& operator = (const svd& a) - { - if (this != &a) + svd& operator = (const svd& a) { - m_type = a.m_type; - left_sm = a.left_sm; - sigma = a.sigma; - right_sm = a.right_sm; - m_driver = a.m_driver; + if (this != &a) + { + m_type = a.m_type; + left_sm = a.left_sm; + sigma = a.sigma; + right_sm = a.right_sm; + m_driver = a.m_driver; + } + + return *this; } - return *this; - } + ~svd (void) { } + + T left_singular_matrix (void) const; - ~svd (void) { } + DM_T singular_values (void) const { return sigma; } - T left_singular_matrix (void) const; - - DM_T singular_values (void) const { return sigma; } + T right_singular_matrix (void) const; - T right_singular_matrix (void) const; - -private: + private: - typedef typename T::element_type P; - typedef typename DM_T::element_type DM_P; + typedef typename T::element_type P; + typedef typename DM_T::element_type DM_P; - svd::Type m_type; - svd::Driver m_driver; + svd::Type m_type; + svd::Driver m_driver; - T left_sm; - DM_T sigma; - T right_sm; - - void gesvd (char& jobu, char& jobv, octave_idx_type m, octave_idx_type n, - P* tmp_data, octave_idx_type m1, DM_P* s_vec, P* u, P* vt, - octave_idx_type nrow_vt1, std::vector<P>& work, octave_idx_type& lwork, - octave_idx_type& info); + T left_sm; + DM_T sigma; + T right_sm; - void gesdd (char& jobz, octave_idx_type m, octave_idx_type n, - P* tmp_data, octave_idx_type m1, DM_P* s_vec, P* u, P* vt, - octave_idx_type nrow_vt1, std::vector<P>& work, - octave_idx_type& lwork, - octave_idx_type* iwork, octave_idx_type& info); + void gesvd (char& jobu, char& jobv, octave_idx_type m, octave_idx_type n, + P* tmp_data, octave_idx_type m1, DM_P* s_vec, P* u, P* vt, + octave_idx_type nrow_vt1, std::vector<P>& work, + octave_idx_type& lwork, octave_idx_type& info); -}; - -} + void gesdd (char& jobz, octave_idx_type m, octave_idx_type n, + P* tmp_data, octave_idx_type m1, DM_P* s_vec, P* u, P* vt, + octave_idx_type nrow_vt1, std::vector<P>& work, + octave_idx_type& lwork, + octave_idx_type* iwork, octave_idx_type& info); + }; + } } #endif