nuha-0.3.0.0: Multidimensional arrays, Linear algebra, Numerical analysis
Copyright(c) Johannes Kropp
LicenseBSD 3-Clause
MaintainerJohannes Kropp <jodak932@gmail.com>
Safe HaskellNone
LanguageHaskell2010

Math.Nuha.Algorithms

Description

 
Synopsis

Solvers

solveLin :: (Unbox a, Real a, Floating a) => Holor a -> Holor a -> Either Error (Holor a) Source #

Solves the linear system A*x=b with A as a square matrix. The possible errors that can happen are NoSquareMatrixError, UnderdeterminedSystemError and DimensionMismatchError

_A = matrix [[1,1,2],[2,-3,0],[2,4,-4]]
b = vector [2,5,3]
x = case solveLin _A b of
    Left err -> error $ "solveLin : " ++ show err
    Right x -> x

solveLinLS :: (Unbox a, Real a, Floating a) => Holor a -> Holor a -> Either Error (Holor a) Source #

Solves the linear least squares problem, i.e. finds the least squares solution of the overdetermined linear equation system A*x=b. Possible errors are UnderdeterminedSystemError and DimensionMismatchError

_A = matrix [[1,1,2],[2,-3,0],[2,4,-4],[2,4,-4.3]]
b = vector [2,3,4,5]
x = case solveLinLS _A b of
    Left err -> error $ "solveLinLS : " ++ show err
    Right x -> x

solveLinBack :: (Unbox a, Real a, Floating a) => Holor a -> Holor a -> Either Error (Holor a) Source #

Backward substitution for solving R*x=b with an upper triangular matrix R. Possible errors are DimensionMismatchError and NoUpperTriError

Factorizations

facQR :: (Unbox a, Real a, Floating a) => Holor a -> Either Error (Holor a, Holor a) Source #

Factorization of a rectangular matrix A with shape [m,n] where m>=n into the matrices (Q,R) with A=Q*R where Q is orthogonal and R is of shape [m,n] with the first n rows in upper triangular form and the last m-n rows filled with zeros. Possible errors are TooFewRowsError and NoMatrixError

_A = matrix [[1,1,2],[2,-3,0],[2,4,-4],[2,4,-5]]
(_Q,_R) = case facQR _A of
    Left err -> error $ "facQR : " ++ show err
    Right (_Q,_R) -> (_Q,_R)

facPreQR :: (Unbox a, Real a, Floating a) => Holor a -> Either Error ([Holor a], Holor a) Source #

Pre step of the QR factorization of a rectangular matrix A. The outputs of this function are a the list of the householder reflection vectors and the matrix R which is the same as in the full QR factorization. The matrix Q is implicitly stored in the householder reflection vectors by the rule: transpose(Q) = S_m * ... * S_1. For the matrices S_i applies: S_i = I - 2*(dot v_i v_i) where I is the Identity matrix and v_i the i-th householder vector. This function is sometimes useful where the Q Matrix isn't explicitly needed. Possible errors are TooFewRowsError and NoMatrixError

_A = matrix [[1,1,2],[2,-3,0],[2,4,-4],[2,4,-5]]
(reflectionVectors,_R) = case facPreQR _A of
    Left err -> error $ "facPreQR : " ++ show err
    Right (reflectionVectors,_R) -> (reflectionVectors,_R)