Copyright | (c) Alberto Ruiz 2006-7 |
---|---|
License | GPL-style |
Maintainer | Alberto Ruiz (aruiz at um dot es) |
Stability | provisional |
Portability | portable (uses FFI) |
Safe Haskell | None |
Language | Haskell98 |
Functional interface to selected LAPACK functions (http://www.netlib.org/lapack).
- multiplyR :: Matrix Double -> Matrix Double -> Matrix Double
- multiplyC :: Matrix (Complex Double) -> Matrix (Complex Double) -> Matrix (Complex Double)
- multiplyF :: Matrix Float -> Matrix Float -> Matrix Float
- multiplyQ :: Matrix (Complex Float) -> Matrix (Complex Float) -> Matrix (Complex Float)
- linearSolveR :: Matrix Double -> Matrix Double -> Matrix Double
- linearSolveC :: Matrix (Complex Double) -> Matrix (Complex Double) -> Matrix (Complex Double)
- lusR :: Matrix Double -> [Int] -> Matrix Double -> Matrix Double
- lusC :: Matrix (Complex Double) -> [Int] -> Matrix (Complex Double) -> Matrix (Complex Double)
- cholSolveR :: Matrix Double -> Matrix Double -> Matrix Double
- cholSolveC :: Matrix (Complex Double) -> Matrix (Complex Double) -> Matrix (Complex Double)
- linearSolveLSR :: Matrix Double -> Matrix Double -> Matrix Double
- linearSolveLSC :: Matrix (Complex Double) -> Matrix (Complex Double) -> Matrix (Complex Double)
- linearSolveSVDR :: Maybe Double -> Matrix Double -> Matrix Double -> Matrix Double
- linearSolveSVDC :: Maybe Double -> Matrix (Complex Double) -> Matrix (Complex Double) -> Matrix (Complex Double)
- svR :: Matrix Double -> Vector Double
- svRd :: Matrix Double -> Vector Double
- svC :: Matrix (Complex Double) -> Vector Double
- svCd :: Matrix (Complex Double) -> Vector Double
- svdR :: Matrix Double -> (Matrix Double, Vector Double, Matrix Double)
- svdRd :: Matrix Double -> (Matrix Double, Vector Double, Matrix Double)
- svdC :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double, Matrix (Complex Double))
- svdCd :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double, Matrix (Complex Double))
- thinSVDR :: Matrix Double -> (Matrix Double, Vector Double, Matrix Double)
- thinSVDRd :: Matrix Double -> (Matrix Double, Vector Double, Matrix Double)
- thinSVDC :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double, Matrix (Complex Double))
- thinSVDCd :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double, Matrix (Complex Double))
- rightSVR :: Matrix Double -> (Vector Double, Matrix Double)
- rightSVC :: Matrix (Complex Double) -> (Vector Double, Matrix (Complex Double))
- leftSVR :: Matrix Double -> (Matrix Double, Vector Double)
- leftSVC :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double)
- eigR :: Matrix Double -> (Vector (Complex Double), Matrix (Complex Double))
- eigC :: Matrix (Complex Double) -> (Vector (Complex Double), Matrix (Complex Double))
- eigS :: Matrix Double -> (Vector Double, Matrix Double)
- eigS' :: Matrix Double -> (Vector Double, Matrix Double)
- eigH :: Matrix (Complex Double) -> (Vector Double, Matrix (Complex Double))
- eigH' :: Matrix (Complex Double) -> (Vector Double, Matrix (Complex Double))
- eigOnlyR :: Matrix Double -> Vector (Complex Double)
- eigOnlyC :: Matrix (Complex Double) -> Vector (Complex Double)
- eigOnlyS :: Matrix Double -> Vector Double
- eigOnlyH :: Matrix (Complex Double) -> Vector Double
- luR :: Matrix Double -> (Matrix Double, [Int])
- luC :: Matrix (Complex Double) -> (Matrix (Complex Double), [Int])
- cholS :: Matrix Double -> Matrix Double
- cholH :: Matrix (Complex Double) -> Matrix (Complex Double)
- mbCholS :: Matrix Double -> Maybe (Matrix Double)
- mbCholH :: Matrix (Complex Double) -> Maybe (Matrix (Complex Double))
- qrR :: Matrix Double -> (Matrix Double, Vector Double)
- qrC :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector (Complex Double))
- hessR :: Matrix Double -> (Matrix Double, Vector Double)
- hessC :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector (Complex Double))
- schurR :: Matrix Double -> (Matrix Double, Matrix Double)
- schurC :: Matrix (Complex Double) -> (Matrix (Complex Double), Matrix (Complex Double))
Matrix product
multiplyR :: Matrix Double -> Matrix Double -> Matrix Double Source
Matrix product based on BLAS's dgemm.
multiplyC :: Matrix (Complex Double) -> Matrix (Complex Double) -> Matrix (Complex Double) Source
Matrix product based on BLAS's zgemm.
multiplyF :: Matrix Float -> Matrix Float -> Matrix Float Source
Matrix product based on BLAS's sgemm.
multiplyQ :: Matrix (Complex Float) -> Matrix (Complex Float) -> Matrix (Complex Float) Source
Matrix product based on BLAS's cgemm.
Linear systems
linearSolveR :: Matrix Double -> Matrix Double -> Matrix Double Source
Solve a real linear system (for square coefficient matrix and several right-hand sides) using the LU decomposition, based on LAPACK's dgesv. For underconstrained or overconstrained systems use linearSolveLSR
or linearSolveSVDR
. See also lusR
.
linearSolveC :: Matrix (Complex Double) -> Matrix (Complex Double) -> Matrix (Complex Double) Source
Solve a complex linear system (for square coefficient matrix and several right-hand sides) using the LU decomposition, based on LAPACK's zgesv. For underconstrained or overconstrained systems use linearSolveLSC
or linearSolveSVDC
. See also lusC
.
lusR :: Matrix Double -> [Int] -> Matrix Double -> Matrix Double Source
Solve a real linear system from a precomputed LU decomposition (luR
), using LAPACK's dgetrs.
lusC :: Matrix (Complex Double) -> [Int] -> Matrix (Complex Double) -> Matrix (Complex Double) Source
Solve a real linear system from a precomputed LU decomposition (luC
), using LAPACK's zgetrs.
cholSolveR :: Matrix Double -> Matrix Double -> Matrix Double Source
Solves a symmetric positive definite system of linear equations using a precomputed Cholesky factorization obtained by cholS
.
cholSolveC :: Matrix (Complex Double) -> Matrix (Complex Double) -> Matrix (Complex Double) Source
Solves a Hermitian positive definite system of linear equations using a precomputed Cholesky factorization obtained by cholH
.
linearSolveLSR :: Matrix Double -> Matrix Double -> Matrix Double Source
Least squared error solution of an overconstrained real linear system, or the minimum norm solution of an underconstrained system, using LAPACK's dgels. For rank-deficient systems use linearSolveSVDR
.
linearSolveLSC :: Matrix (Complex Double) -> Matrix (Complex Double) -> Matrix (Complex Double) Source
Least squared error solution of an overconstrained complex linear system, or the minimum norm solution of an underconstrained system, using LAPACK's zgels. For rank-deficient systems use linearSolveSVDC
.
:: Maybe Double | rcond |
-> Matrix Double | coefficient matrix |
-> Matrix Double | right hand sides (as columns) |
-> Matrix Double | solution vectors (as columns) |
Minimum norm solution of a general real linear least squares problem Ax=B using the SVD, based on LAPACK's dgelss. Admits rank-deficient systems but it is slower than linearSolveLSR
. The effective rank of A is determined by treating as zero those singular valures which are less than rcond times the largest singular value. If rcond == Nothing machine precision is used.
:: Maybe Double | rcond |
-> Matrix (Complex Double) | coefficient matrix |
-> Matrix (Complex Double) | right hand sides (as columns) |
-> Matrix (Complex Double) | solution vectors (as columns) |
Minimum norm solution of a general complex linear least squares problem Ax=B using the SVD, based on LAPACK's zgelss. Admits rank-deficient systems but it is slower than linearSolveLSC
. The effective rank of A is determined by treating as zero those singular valures which are less than rcond times the largest singular value. If rcond == Nothing machine precision is used.
SVD
svR :: Matrix Double -> Vector Double Source
Singular values of a real matrix, using LAPACK's dgesvd with jobu == jobvt == 'N'.
svRd :: Matrix Double -> Vector Double Source
Singular values of a real matrix, using LAPACK's dgesdd with jobz == 'N'.
svC :: Matrix (Complex Double) -> Vector Double Source
Singular values of a complex matrix, using LAPACK's zgesvd with jobu == jobvt == 'N'.
svCd :: Matrix (Complex Double) -> Vector Double Source
Singular values of a complex matrix, using LAPACK's zgesdd with jobz == 'N'.
svdR :: Matrix Double -> (Matrix Double, Vector Double, Matrix Double) Source
Full SVD of a real matrix using LAPACK's dgesvd.
svdRd :: Matrix Double -> (Matrix Double, Vector Double, Matrix Double) Source
Full SVD of a real matrix using LAPACK's dgesdd.
svdC :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double, Matrix (Complex Double)) Source
Full SVD of a complex matrix using LAPACK's zgesvd.
svdCd :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double, Matrix (Complex Double)) Source
Full SVD of a complex matrix using LAPACK's zgesdd.
thinSVDR :: Matrix Double -> (Matrix Double, Vector Double, Matrix Double) Source
Thin SVD of a real matrix, using LAPACK's dgesvd with jobu == jobvt == 'S'.
thinSVDRd :: Matrix Double -> (Matrix Double, Vector Double, Matrix Double) Source
Thin SVD of a real matrix, using LAPACK's dgesdd with jobz == 'S'.
thinSVDC :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double, Matrix (Complex Double)) Source
Thin SVD of a complex matrix, using LAPACK's zgesvd with jobu == jobvt == 'S'.
thinSVDCd :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double, Matrix (Complex Double)) Source
Thin SVD of a complex matrix, using LAPACK's zgesdd with jobz == 'S'.
rightSVR :: Matrix Double -> (Vector Double, Matrix Double) Source
Singular values and all right singular vectors of a real matrix, using LAPACK's dgesvd with jobu == 'N' and jobvt == 'A'.
rightSVC :: Matrix (Complex Double) -> (Vector Double, Matrix (Complex Double)) Source
Singular values and all right singular vectors of a complex matrix, using LAPACK's zgesvd with jobu == 'N' and jobvt == 'A'.
leftSVR :: Matrix Double -> (Matrix Double, Vector Double) Source
Singular values and all left singular vectors of a real matrix, using LAPACK's dgesvd with jobu == 'A' and jobvt == 'N'.
leftSVC :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double) Source
Singular values and all left singular vectors of a complex matrix, using LAPACK's zgesvd with jobu == 'A' and jobvt == 'N'.
Eigensystems
eigR :: Matrix Double -> (Vector (Complex Double), Matrix (Complex Double)) Source
Eigenvalues and right eigenvectors of a general real matrix, using LAPACK's dgeev. The eigenvectors are the columns of v. The eigenvalues are not sorted.
eigC :: Matrix (Complex Double) -> (Vector (Complex Double), Matrix (Complex Double)) Source
Eigenvalues and right eigenvectors of a general complex matrix, using LAPACK's zgeev. The eigenvectors are the columns of v. The eigenvalues are not sorted.
eigS :: Matrix Double -> (Vector Double, Matrix Double) Source
Eigenvalues and right eigenvectors of a symmetric real matrix, using LAPACK's dsyev.
The eigenvectors are the columns of v.
The eigenvalues are sorted in descending order (use eigS'
for ascending order).
eigH :: Matrix (Complex Double) -> (Vector Double, Matrix (Complex Double)) Source
Eigenvalues and right eigenvectors of a hermitian complex matrix, using LAPACK's zheev.
The eigenvectors are the columns of v.
The eigenvalues are sorted in descending order (use eigH'
for ascending order).
eigH' :: Matrix (Complex Double) -> (Vector Double, Matrix (Complex Double)) Source
eigH
in ascending order
eigOnlyR :: Matrix Double -> Vector (Complex Double) Source
Eigenvalues of a general real matrix, using LAPACK's dgeev with jobz == 'N'. The eigenvalues are not sorted.
eigOnlyC :: Matrix (Complex Double) -> Vector (Complex Double) Source
Eigenvalues of a general complex matrix, using LAPACK's zgeev with jobz == 'N'. The eigenvalues are not sorted.
eigOnlyS :: Matrix Double -> Vector Double Source
Eigenvalues of a symmetric real matrix, using LAPACK's dsyev with jobz == 'N'. The eigenvalues are sorted in descending order.
eigOnlyH :: Matrix (Complex Double) -> Vector Double Source
Eigenvalues of a hermitian complex matrix, using LAPACK's zheev with jobz == 'N'. The eigenvalues are sorted in descending order.
LU
luR :: Matrix Double -> (Matrix Double, [Int]) Source
LU factorization of a general real matrix, using LAPACK's dgetrf.
luC :: Matrix (Complex Double) -> (Matrix (Complex Double), [Int]) Source
LU factorization of a general complex matrix, using LAPACK's zgetrf.
Cholesky
cholS :: Matrix Double -> Matrix Double Source
Cholesky factorization of a real symmetric positive definite matrix, using LAPACK's dpotrf.
cholH :: Matrix (Complex Double) -> Matrix (Complex Double) Source
Cholesky factorization of a complex Hermitian positive definite matrix, using LAPACK's zpotrf.
mbCholS :: Matrix Double -> Maybe (Matrix Double) Source
Cholesky factorization of a real symmetric positive definite matrix, using LAPACK's dpotrf (Maybe
version).
mbCholH :: Matrix (Complex Double) -> Maybe (Matrix (Complex Double)) Source
Cholesky factorization of a complex Hermitian positive definite matrix, using LAPACK's zpotrf (Maybe
version).
QR
qrR :: Matrix Double -> (Matrix Double, Vector Double) Source
QR factorization of a real matrix, using LAPACK's dgeqr2.
qrC :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector (Complex Double)) Source
QR factorization of a complex matrix, using LAPACK's zgeqr2.
Hessenberg
hessR :: Matrix Double -> (Matrix Double, Vector Double) Source
Hessenberg factorization of a square real matrix, using LAPACK's dgehrd.
hessC :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector (Complex Double)) Source
Hessenberg factorization of a square complex matrix, using LAPACK's zgehrd.