easytensor-2.1.1.0: Pure, type-indexed haskell vector, matrix, and tensor library.
Safe HaskellNone
LanguageHaskell2010

Numeric.Subroutine.SolveTriangular

Description

A few ways to solve a system of linear equations in ST monad. The tesult is always computed inplace.

Synopsis

Documentation

solveUpperTriangularR Source #

Arguments

:: forall (s :: Type) (t :: Type) (n :: Nat) (m :: Nat) (ds :: [Nat]). (PrimBytes t, Fractional t, Eq t, KnownDim m, m <= n) 
=> DataFrame t '[n, m]

\(R\)

-> STDataFrame s t (m :+ ds)

Current state of \(b_m\) (first m rows of b)

-> ST s () 

Solve a system of linear equations \( Rx = b \) or a linear least squares problem \( \min {|| Rx - b ||}^2 \), where \( R \) is an upper-triangular matrix.

DataFrame \( b \) is modified in-place; by the end of the process \( b_m = x \).

NB: you can use subDataFrameView to truncate b without performing a copy.

solveUpperTriangularL Source #

Arguments

:: forall (s :: Type) (t :: Type) (n :: Nat) (m :: Nat) (ds :: [Nat]). (PrimBytes t, Fractional t, Eq t, KnownDim m, m <= n) 
=> STDataFrame s t (ds +: m)

Current state of \(b\) (first m "columns" of x)

-> DataFrame t '[n, m]

\(R\)

-> ST s () 

Solve a system of linear equations \( xR = b \), where \( R \) is an upper-triangular matrix.

DataFrame \( b \) is modified in-place; by the end of the process \( b = x_m \). The \( (n - m) \) rows of \(R\) are not used. Pad each dimension of \(x\) with \( (n - m) \) zeros if you want to get the full solution.

solveLowerTriangularR Source #

Arguments

:: forall (s :: Type) (t :: Type) (n :: Nat) (m :: Nat) (ds :: [Nat]). (PrimBytes t, Fractional t, Eq t, KnownDim n, KnownDim m, n <= m) 
=> DataFrame t '[n, m]

\(L\)

-> STDataFrame s t (n :+ ds)

Current state of \(b\) (first n elements of x)

-> ST s () 

Solve a system of linear equations \( Lx = b \), where \( L \) is a lower-triangular matrix.

DataFrame \( b \) is modified in-place; by the end of the process \( b = x_n \). The \( (m - n) \) columns of \(L\) are not used. Pad \(x\) with \( (m - n) \) zero elements if you want to get the full solution.

solveLowerTriangularL Source #

Arguments

:: forall (s :: Type) (t :: Type) (n :: Nat) (m :: Nat) (ds :: [Nat]). (PrimBytes t, Fractional t, Eq t, KnownDim n, KnownDim m, n <= m) 
=> STDataFrame s t (ds +: m)

Current state of \(b\)

-> DataFrame t '[n, m]

\(L\)

-> ST s () 

Solve a system of linear equations \( xL = b \) or a linear least squares problem \( \min {|| xL - b ||}^2 \), where \( L \) is a lower-triangular matrix.

DataFrame \( b \) is modified in-place; by the end of the process \( b_n = x \). The last \( (m - n) \) columns of \(L\) and \(b\) and are not touched.