Copyright | (c) Wanja Chresta 2018 |
---|---|
License | BSD-3 |
Maintainer | wanja dot hs at chrummibei dot ch |
Stability | experimental |
Portability | POSIX |
Safe Haskell | None |
Language | Haskell2010 |
Data.Matrix.Static wraps matrix
's Data.Matrix functions and adds size
information on the type level. The name of the functions are mostly the same as
in Data.Matrix
. Exceptions are, when there is a safer version of a function
due to the additional type-level information. In that case, there may be an
unsafe variant of the function with the postfix Unsafe
.
Synopsis
- data Matrix (m :: Nat) (n :: Nat) (a :: Type)
- prettyMatrix :: forall m n a. Show a => Matrix m n a -> String
- nrows :: forall m n a. KnownNat m => Matrix m n a -> Int
- ncols :: forall m n a. KnownNat n => Matrix m n a -> Int
- forceMatrix :: forall m n a. Matrix m n a -> Matrix m n a
- matrix :: forall m n a. (KnownNat m, KnownNat n) => ((Int, Int) -> a) -> Matrix m n a
- rowVector :: forall m a. KnownNat m => Vector a -> Maybe (RowVector m a)
- colVector :: forall n a. KnownNat n => Vector a -> Maybe (ColumnVector n a)
- zero :: forall m n a. (Num a, KnownNat n, KnownNat m) => Matrix m n a
- identity :: forall n a. (Num a, KnownNat n) => Matrix n n a
- diagonal :: forall n a. KnownNat n => a -> Vector a -> Maybe (Matrix n n a)
- diagonalUnsafe :: forall n a. a -> Vector a -> Matrix n n a
- permMatrix :: forall n i j a. (Num a, KnownNat n, KnownNat i, KnownNat j, 1 <= i, i <= n, 1 <= j, j <= n) => Matrix n n a
- permMatrixUnsafe :: forall n a. (Num a, KnownNat n) => Int -> Int -> Matrix n n a
- fromList :: forall m n a. (KnownNat m, KnownNat n) => [a] -> Maybe (Matrix m n a)
- fromListUnsafe :: forall m n a. (KnownNat m, KnownNat n) => [a] -> Matrix m n a
- fromLists :: forall m n a. (KnownNat m, KnownNat n) => [[a]] -> Maybe (Matrix m n a)
- fromListsUnsafe :: [[a]] -> Matrix m n a
- toList :: forall m n a. Matrix m n a -> [a]
- toLists :: forall m n a. Matrix m n a -> [[a]]
- getElem :: forall i j m n a. (KnownNat i, KnownNat j, 1 <= i, i <= m, 1 <= j, j <= n) => Matrix m n a -> a
- (!) :: Matrix m n a -> (Int, Int) -> a
- unsafeGet :: Int -> Int -> Matrix m n a -> a
- (!.) :: Matrix m n a -> (Int, Int) -> a
- safeGet :: forall m n a. (KnownNat n, KnownNat m) => Int -> Int -> Matrix m n a -> Maybe a
- safeSet :: forall m n a. a -> (Int, Int) -> Matrix m n a -> Maybe (Matrix m n a)
- getRow :: Int -> Matrix m n a -> Vector a
- getCol :: Int -> Matrix m n a -> Vector a
- safeGetRow :: Int -> Matrix m n a -> Maybe (Vector a)
- safeGetCol :: Int -> Matrix m n a -> Maybe (Vector a)
- getDiag :: Matrix m n a -> Vector a
- getMatrixAsVector :: Matrix m n a -> Vector a
- (.*) :: forall m k n a. Num a => Matrix m k a -> Matrix k n a -> Matrix m n a
- (^*) :: forall m n a. Num a => a -> Matrix m n a -> Matrix m n a
- setElem :: forall i j m n a. (KnownNat i, KnownNat j, 1 <= i, i <= m, 1 <= j, j <= n) => a -> Matrix m n a -> Matrix m n a
- unsafeSet :: a -> (Int, Int) -> Matrix m n a -> Matrix m n a
- transpose :: forall m n a. Matrix m n a -> Matrix n m a
- setSize :: forall newM newN m n a. (KnownNat newM, KnownNat newN, 1 <= newM, 1 <= newN) => a -> Matrix m n a -> Matrix newM newN a
- extendTo :: forall newM newN m n a. (KnownNat newM, KnownNat newN, n <= newN, m <= newM) => a -> Matrix m n a -> Matrix newM newN a
- inverse :: forall n a. (Fractional a, Eq a) => Matrix n n a -> Either String (Matrix n n a)
- rref :: (Fractional a, Eq a) => Matrix m n a -> Either String (Matrix m n a)
- mapRow :: forall i m n a. (KnownNat i, KnownNat m, 1 <= i, i <= m) => (Int -> a -> a) -> Matrix m n a -> Matrix m n a
- mapRowUnsafe :: forall m n a. (Int -> a -> a) -> Int -> Matrix m n a -> Matrix m n a
- mapCol :: forall j m n a. (KnownNat j, KnownNat m, 1 <= j, j <= n) => (Int -> a -> a) -> Matrix m n a -> Matrix m n a
- mapColUnsafe :: forall m n a. (Int -> a -> a) -> Int -> Matrix m n a -> Matrix m n a
- mapPos :: ((Int, Int) -> a -> b) -> Matrix m n a -> Matrix m n b
- submatrix :: forall iFrom jFrom iTo jTo m n a. (KnownNat iFrom, KnownNat iTo, KnownNat jFrom, KnownNat jTo, 1 <= iFrom, 1 <= ((iTo - iFrom) + 1), ((iTo - iFrom) + 1) <= m, 1 <= jFrom, 1 <= ((jTo - jFrom) + 1), ((jTo - jFrom) + 1) <= n) => Matrix m n a -> Matrix ((iTo - iFrom) + 1) ((jTo - jFrom) + 1) a
- submatrixUnsafe :: forall rows cols m n a. (KnownNat rows, KnownNat cols, 1 <= rows, rows <= m, 1 <= cols, cols <= n) => Int -> Int -> Matrix m n a -> Matrix rows cols a
- minorMatrix :: forall delRow delCol m n a. (KnownNat delRow, KnownNat delCol, 1 <= delRow, 1 <= delCol, delRow <= m, delCol <= n, 2 <= n, 2 <= m) => Matrix m n a -> Matrix (m - 1) (n - 1) a
- minorMatrixUnsafe :: (2 <= n, 2 <= m) => Int -> Int -> Matrix m n a -> Matrix (m - 1) (n - 1) a
- splitBlocks :: forall i j m n a. (KnownNat i, KnownNat j, 1 <= i, (i + 1) <= m, 1 <= j, (j + 1) <= n) => Matrix m n a -> (Matrix i j a, Matrix i (n - j) a, Matrix (n - i) j a, Matrix (m - i) (n - j) a)
- (<|>) :: forall m n k a. Matrix m n a -> Matrix m k a -> Matrix m (k + n) a
- (<->) :: forall m k n a. Matrix m n a -> Matrix k n a -> Matrix (m + k) n a
- joinBlocks :: forall mt mb nl nr a. (1 <= mt, 1 <= mb, 1 <= nl, 1 <= nr) => (Matrix mt nl a, Matrix mt nr a, Matrix mb nl a, Matrix mb nr a) -> Matrix (mt + mb) (nl + nr) a
- elementwise :: forall m n a b c. (a -> b -> c) -> Matrix m n a -> Matrix m n b -> Matrix m n c
- multStd :: forall m k n a. Num a => Matrix m k a -> Matrix k n a -> Matrix m n a
- multStd2 :: forall m k n a. Num a => Matrix m k a -> Matrix k n a -> Matrix m n a
- multStrassen :: forall m k n a. Num a => Matrix m k a -> Matrix k n a -> Matrix m n a
- multStrassenMixed :: forall m k n a. Num a => Matrix m k a -> Matrix k n a -> Matrix m n a
- scaleMatrix :: Num a => a -> Matrix m n a -> Matrix m n a
- scaleRow :: forall i m n a. (KnownNat i, Num a) => a -> Matrix m n a -> Matrix m n a
- scaleRowUnsafe :: Num a => a -> Int -> Matrix m n a -> Matrix m n a
- combineRows :: forall i k m n a. (KnownNat i, KnownNat k, Num a) => a -> Matrix m n a -> Matrix m n a
- combineRowsUnsafe :: Num a => Int -> a -> Int -> Matrix m n a -> Matrix m n a
- switchRows :: forall i k m n a. (KnownNat i, KnownNat k, 1 <= i, i <= m, 1 <= k, k <= m) => Matrix m n a -> Matrix m n a
- switchRowsUnsafe :: Int -> Int -> Matrix m n a -> Matrix m n a
- switchCols :: forall i k m n a. (KnownNat i, KnownNat k, 1 <= i, i <= n, 1 <= k, k <= n) => Matrix m n a -> Matrix m n a
- switchColsUnsafe :: Int -> Int -> Matrix m n a -> Matrix m n a
- luDecomp :: (Ord a, Fractional a) => Matrix m n a -> Maybe (Matrix m n a, Matrix m n a, Matrix m n a, a)
- luDecompUnsafe :: (Ord a, Fractional a) => Matrix m n a -> (Matrix m n a, Matrix m n a, Matrix m n a, a)
- luDecomp' :: (Ord a, Fractional a) => Matrix m n a -> Maybe (Matrix m n a, Matrix m m a, Matrix m m a, Matrix n n a, a, a)
- luDecompUnsafe' :: (Ord a, Fractional a) => Matrix m n a -> (Matrix m n a, Matrix m m a, Matrix m m a, Matrix n n a, a, a)
- cholDecomp :: Floating a => Matrix n n a -> Matrix n n a
- trace :: Num a => Matrix m n a -> a
- diagProd :: Num a => Matrix m n a -> a
- detLaplace :: Num a => Matrix n n a -> a
- detLU :: (Ord a, Fractional a) => Matrix n n a -> a
- flatten :: forall m' n' m n a. Matrix m' n' (Matrix m n a) -> Matrix (m' * m) (n' * n) a
- applyUnary :: forall m n m' n' a b. (Matrix a -> Matrix b) -> Matrix m n a -> Matrix m' n' b
- applyBinary :: forall m n m' n' m'' n'' a b. (Matrix a -> Matrix a -> Matrix b) -> Matrix m n a -> Matrix m' n' a -> Matrix m'' n'' b
- unpackStatic :: forall m n a. Matrix m n a -> Matrix a
Matrix type
data Matrix (m :: Nat) (n :: Nat) (a :: Type) Source #
A matrix over the type f
with m
rows and n
columns. This just wraps
the Matrix
constructor and adds size information to
the type
Instances
Functor (Matrix m n) Source # | |
Applicative (Matrix m n) Source # | |
Defined in Data.Matrix.Static | |
Foldable (Matrix m n) Source # | |
Defined in Data.Matrix.Static fold :: Monoid m0 => Matrix m n m0 -> m0 # foldMap :: Monoid m0 => (a -> m0) -> Matrix m n a -> m0 # foldr :: (a -> b -> b) -> b -> Matrix m n a -> b # foldr' :: (a -> b -> b) -> b -> Matrix m n a -> b # foldl :: (b -> a -> b) -> b -> Matrix m n a -> b # foldl' :: (b -> a -> b) -> b -> Matrix m n a -> b # foldr1 :: (a -> a -> a) -> Matrix m n a -> a # foldl1 :: (a -> a -> a) -> Matrix m n a -> a # toList :: Matrix m n a -> [a] # null :: Matrix m n a -> Bool # length :: Matrix m n a -> Int # elem :: Eq a => a -> Matrix m n a -> Bool # maximum :: Ord a => Matrix m n a -> a # minimum :: Ord a => Matrix m n a -> a # | |
Traversable (Matrix m n) Source # | |
Defined in Data.Matrix.Static | |
Eq a => Eq (Matrix m n a) Source # | |
Num f => Num (Matrix m n f) Source # | |
Defined in Data.Matrix.Static (+) :: Matrix m n f -> Matrix m n f -> Matrix m n f # (-) :: Matrix m n f -> Matrix m n f -> Matrix m n f # (*) :: Matrix m n f -> Matrix m n f -> Matrix m n f # negate :: Matrix m n f -> Matrix m n f # abs :: Matrix m n f -> Matrix m n f # signum :: Matrix m n f -> Matrix m n f # fromInteger :: Integer -> Matrix m n f # | |
Ord f => Ord (Matrix m n f) Source # | |
Defined in Data.Matrix.Static | |
Show f => Show (Matrix m n f) Source # | |
Monoid a => Semigroup (Matrix m n a) Source # | |
Monoid a => Monoid (Matrix m n a) Source # | |
NFData a => NFData (Matrix m n a) Source # | |
Defined in Data.Matrix.Static |
forceMatrix :: forall m n a. Matrix m n a -> Matrix m n a Source #
O(rows*cols). Similar to force
. It copies the matrix content
dropping any extra memory.
Useful when using submatrix
from a big matrix.
Builders
O(rows*cols). Generate a matrix from a generator function.
| The elements are 1-indexed, i.e. top-left element is (1,1)
.
Example of usage:
matrix (\(i,j) -> 2*i - j) :: Matrix 2 4 Int ( 1 0 -1 -2 ) ( 3 2 1 0 )
rowVector :: forall m a. KnownNat m => Vector a -> Maybe (RowVector m a) Source #
O(1). Represent a vector as a one row matrix.
colVector :: forall n a. KnownNat n => Vector a -> Maybe (ColumnVector n a) Source #
O(1). Represent a vector as a one row matrix.
Special matrices
zero :: forall m n a. (Num a, KnownNat n, KnownNat m) => Matrix m n a Source #
O(rows*cols). The zero matrix This produces a zero matrix of the size given by the type. Often, the correct dimensions can be inferred by the compiler. If you want a specific size, give a type.
zero :: Matrix 2 2 Int ( 0 0 ) ( 0 0 )
identity :: forall n a. (Num a, KnownNat n) => Matrix n n a Source #
O(rows*cols). Identity matrix
identitiy @n = ( 1 0 0 ... 0 0 ) ( 0 1 0 ... 0 0 ) ( ... ) ( 0 0 0 ... 1 0 ) ( 0 0 0 ... 0 1 )
Similar to diagonalList
, but using Vector
, which
should be more efficient.
The size of the vector is not checked and will lead to an exception
if it's not of size n.
:: a | Default element |
-> Vector a | Diagonal vector |
-> Matrix n n a |
Similar to diagonalList
, but using Vector
, which
should be more efficient.
The size of the vector is not checked and will lead to an exception
if it's not of size n.
permMatrix :: forall n i j a. (Num a, KnownNat n, KnownNat i, KnownNat j, 1 <= i, i <= n, 1 <= j, j <= n) => Matrix n n a Source #
O(rows*cols). Permutation matrix.
The parameters are given as type level Nats. To use this, use -XDataKinds
and -XTypeApplications
.
The first type parameter gives the matrix' size, the two following
give the rows (or columns) to permute.
permMatrix @n @i @j = i j n 1 ( 1 0 ... 0 ... 0 ... 0 0 ) 2 ( 0 1 ... 0 ... 0 ... 0 0 ) ( ... ... ... ) i ( 0 0 ... 0 ... 1 ... 0 0 ) ( ... ... ... ) j ( 0 0 ... 1 ... 0 ... 0 0 ) ( ... ... ... ) ( 0 0 ... 0 ... 0 ... 1 0 ) n ( 0 0 ... 0 ... 0 ... 0 1 )
When i == j
it reduces to identity
n
.
O(rows*cols). Permutation matrix. The values of the row and column identifiers are not checked and if they are out of range (not between 1 and n) an exception will be thrown.
permMatrixUnsafe @n i j = i j n 1 ( 1 0 ... 0 ... 0 ... 0 0 ) 2 ( 0 1 ... 0 ... 0 ... 0 0 ) ( ... ... ... ) i ( 0 0 ... 0 ... 1 ... 0 0 ) ( ... ... ... ) j ( 0 0 ... 1 ... 0 ... 0 0 ) ( ... ... ... ) ( 0 0 ... 0 ... 0 ... 1 0 ) n ( 0 0 ... 0 ... 0 ... 0 1 )
When i == j
it reduces to identity
n
.
List conversions
fromList :: forall m n a. (KnownNat m, KnownNat n) => [a] -> Maybe (Matrix m n a) Source #
Create a matrix from a list of elements.
The list must have exactly length n*m
or this returns Nothing.
An example:
fromList [1..9] :: Maybe (Matrix 3 3 Int) Just ( 1 2 3 ) ( 4 5 6 ) ( 7 8 9 )
Create a matrix from a non-empty list given the desired size. The list must have at least rows*cols elements. An example:
fromListUnsafe [1..9] :: Matrix 3 3 Int ( 1 2 3 ) ( 4 5 6 ) ( 7 8 9 )
fromLists :: forall m n a. (KnownNat m, KnownNat n) => [[a]] -> Maybe (Matrix m n a) Source #
Create a matrix from a list of rows. The list must have exactly m
lists of length n
. Nothing is returned otherwise
Example:
fromLists [ [1,2,3] ( 1 2 3 ) , [4,5,6] ( 4 5 6 ) , [7,8,9] ] = ( 7 8 9 )
fromListsUnsafe :: [[a]] -> Matrix m n a Source #
Create a matrix from a list of rows. The list must have exactly m
lists of length n
. If this does not hold, the resulting Matrix will have
different static dimensions that the runtime dimension and will result
in hard to debug errors. Use fromLists
whenever you're unsure.
Example:
fromListsUnsafe [ [1,2,3] ( 1 2 3 ) , [4,5,6] ( 4 5 6 ) , [7,8,9] ] = ( 7 8 9 )
toList :: forall m n a. Matrix m n a -> [a] Source #
Get the elements of a matrix stored in a list.
( 1 2 3 ) ( 4 5 6 ) toList ( 7 8 9 ) = [1..9]
toLists :: forall m n a. Matrix m n a -> [[a]] Source #
Get the elements of a matrix stored in a list of lists, where each list contains the elements of a single row.
( 1 2 3 ) [ [1,2,3] ( 4 5 6 ) , [4,5,6] toLists ( 7 8 9 ) = , [7,8,9] ]
Accessing
O(1). Get an element of a matrix. Indices range from (1,1) to (m,n).
The parameters are given as type level Nats. To use this, use -XDataKinds
and -XTypeApplications
.
The type parameters are: row, column
Example:
( 1 2 ) getElem @2 @1 ( 3 4 ) = 3
(!) :: Matrix m n a -> (Int, Int) -> a Source #
Short alias for unsafeGet
. Careful: This has no bounds checking
This deviates from Data.Matrix
, where (!) does check bounds on runtime.
O(1). Unsafe variant of getElem
. This will do no bounds checking
(!.) :: Matrix m n a -> (Int, Int) -> a Source #
Alias for '(!)'. This exists to keep the interface similar to Data.Matrix
but serves no other purpose. Use '(!)' (or even better getElem
) instead.
safeGet :: forall m n a. (KnownNat n, KnownNat m) => Int -> Int -> Matrix m n a -> Maybe a Source #
Variant of unsafeGet
that returns Maybe instead of an error.
safeSet :: forall m n a. a -> (Int, Int) -> Matrix m n a -> Maybe (Matrix m n a) Source #
Variant of setElem
that returns Maybe instead of an error.
getRow :: Int -> Matrix m n a -> Vector a Source #
O(1). Get a row of a matrix as a vector. The range of the input is not checked and must be between 1 and m
getCol :: Int -> Matrix m n a -> Vector a Source #
O(1). Get a column of a matrix as a vector. The range of the input is not checked and must be between 1 and n
safeGetRow :: Int -> Matrix m n a -> Maybe (Vector a) Source #
Varian of getRow
that returns a maybe instead of an error
Only available when used with matrix >= 0.3.6
!
safeGetCol :: Int -> Matrix m n a -> Maybe (Vector a) Source #
Variant of getCol
that returns a maybe instead of an error
Only available when used with matrix >= 0.3.6
!
getDiag :: Matrix m n a -> Vector a Source #
O(min rows cols). Diagonal of a not necessarily square matrix.
getMatrixAsVector :: Matrix m n a -> Vector a Source #
Manipulating matrices
(.*) :: forall m k n a. Num a => Matrix m k a -> Matrix k n a -> Matrix m n a Source #
Type safe matrix multiplication
This is called (*)
in matrix
. Since the dimensions of the input
matrices differ, they are not the same type and we cannot use Num
's (*)
(^*) :: forall m n a. Num a => a -> Matrix m n a -> Matrix m n a Source #
Type safe scalar multiplication
:: (KnownNat i, KnownNat j, 1 <= i, i <= m, 1 <= j, j <= n) | |
=> a | New value. |
-> Matrix m n a | Original matrix. |
-> Matrix m n a | Matrix with the given position replaced with the given value. |
Replace the value of a cell in a matrix.
The position to be replaced is given by TypeLevel Nats. To use this, use
-XDataKinds
and -XTypeApplications
.
Example:
setElem 1
2 0 (1 2 3) = (1 0 3)
:: a | New value. |
-> (Int, Int) | Position to replace. |
-> Matrix m n a | Original matrix. |
-> Matrix m n a | Matrix with the given position replaced with the given value. |
Unsafe variant of setElem
, without bounds checking.
transpose :: forall m n a. Matrix m n a -> Matrix n m a Source #
O(rows*cols). The transpose of a matrix. Example:
( 1 2 3 ) ( 1 4 7 ) ( 4 5 6 ) ( 2 5 8 ) transpose ( 7 8 9 ) = ( 3 6 9 )
:: (KnownNat newM, KnownNat newN, 1 <= newM, 1 <= newN) | |
=> a | Default element. |
-> Matrix m n a | |
-> Matrix newM newN a |
Set the size of a matrix to given parameters. Use a default element for undefined entries if the matrix has been extended.
:: (KnownNat newM, KnownNat newN, n <= newN, m <= newM) | |
=> a | Element to add when extending. |
-> Matrix m n a | |
-> Matrix newM newN a |
Extend a matrix to the expected size adding a default element. If the matrix already has the required size, nothing happens. Example:
( 1 2 3 0 0 ) ( 1 2 3 ) ( 4 5 6 0 0 ) ( 4 5 6 ) ( 7 8 9 0 0 ) extendTo @4 @5 0 ( 7 8 9 ) = ( 0 0 0 0 0 )
inverse :: forall n a. (Fractional a, Eq a) => Matrix n n a -> Either String (Matrix n n a) Source #
O(rows^4). The inverse of a square matrix Uses naive Gaussian elimination formula.
rref :: (Fractional a, Eq a) => Matrix m n a -> Either String (Matrix m n a) Source #
O(rows*rows*cols*cols). Converts a matrix to reduced row echelon form, thus solving a linear system of equations. This requires that (cols > rows) if cols < rows, then there are fewer variables than equations and the problem cannot be solved consistently. If rows = cols, then it is basically a homogenous system of equations, so it will be reduced to identity or an error depending on whether the marix is invertible (this case is allowed for robustness).
:: (KnownNat i, KnownNat m, 1 <= i, i <= m) | |
=> (Int -> a -> a) | Function takes the current column as additional argument. |
-> Matrix m n a | |
-> Matrix m n a |
O(rows*cols). Map a function over a row.
The row to map is given by a TypeLevel Nat. To use this, use -XDataKinds
and -XTypeApplications
.
Example:
( 1 2 3 ) ( 1 2 3 ) ( 4 5 6 ) ( 5 6 7 ) mapRow @2 (\_ x -> x + 1) ( 7 8 9 ) = ( 7 8 9 )
:: (Int -> a -> a) | Function takes the current column as additional argument. |
-> Int | Row to map. |
-> Matrix m n a | |
-> Matrix m n a |
O(rows*cols). Map a function over a row. The bounds of the row parameter is not checked and might throw an error. Example:
( 1 2 3 ) ( 1 2 3 ) ( 4 5 6 ) ( 5 6 7 ) mapRowUnsafe (\_ x -> x + 1) 2 ( 7 8 9 ) = ( 7 8 9 )
:: (KnownNat j, KnownNat m, 1 <= j, j <= n) | |
=> (Int -> a -> a) | Function takes the current column as additional argument. |
-> Matrix m n a | |
-> Matrix m n a |
O(rows*cols). Map a function over a column.
The row to map is given by a TypeLevel Nat. To use this, use -XDataKinds
and -XTypeApplications
.
Example:
( 1 2 3 ) ( 1 3 3 ) ( 4 5 6 ) ( 4 6 6 ) mapCol @2 (\_ x -> x + 1) ( 7 8 9 ) = ( 7 9 9 )
:: (Int -> a -> a) | Function takes the current column as additional argument. |
-> Int | Row to map. |
-> Matrix m n a | |
-> Matrix m n a |
O(rows*cols). Map a function over a column. The bounds of the row parameter is not checked and might throw an error. Example:
( 1 2 3 ) ( 1 3 3 ) ( 4 5 6 ) ( 4 6 6 ) mapColUnsafe (\_ x -> x + 1) 2 ( 7 8 9 ) = ( 7 9 9 )
:: ((Int, Int) -> a -> b) | Function takes the current Position as additional argument. |
-> Matrix m n a | |
-> Matrix m n b |
O(rows*cols). Map a function over elements. Example:
( 1 2 3 ) ( 0 -1 -2 ) ( 4 5 6 ) ( 1 0 -1 ) mapPos (\(r,c) _ -> r - c) ( 7 8 9 ) = ( 2 1 0 )
Only available when used with matrix >= 0.3.6
!
Submatrices
Splitting blocks
submatrix :: forall iFrom jFrom iTo jTo m n a. (KnownNat iFrom, KnownNat iTo, KnownNat jFrom, KnownNat jTo, 1 <= iFrom, 1 <= ((iTo - iFrom) + 1), ((iTo - iFrom) + 1) <= m, 1 <= jFrom, 1 <= ((jTo - jFrom) + 1), ((jTo - jFrom) + 1) <= n) => Matrix m n a -> Matrix ((iTo - iFrom) + 1) ((jTo - jFrom) + 1) a Source #
O(1). Extract a submatrix from the given position. The type parameters expected are the starting and ending indices of row and column elements.
:: (KnownNat rows, KnownNat cols, 1 <= rows, rows <= m, 1 <= cols, cols <= n) | |
=> Int | Starting row |
-> Int | Starting column |
-> Matrix m n a | |
-> Matrix rows cols a |
O(1). Extract a submatrix from the given position. The type parameters are the dimension of the returned matrix, the run-time indices are the indiced of the top-left element of the new matrix. Example:
( 1 2 3 ) ( 4 5 6 ) ( 2 3 ) submatrixUnsafe @2 @2 1 2 ( 7 8 9 ) = ( 5 6 )
:: (KnownNat delRow, KnownNat delCol, 1 <= delRow, 1 <= delCol, delRow <= m, delCol <= n, 2 <= n, 2 <= m) | |
=> Matrix m n a | Original matrix. |
-> Matrix (m - 1) (n - 1) a | Matrix with row |
O(rows*cols). Remove a row and a column from a matrix. Example:
( 1 2 3 ) ( 4 5 6 ) ( 1 3 ) minorMatrix @2 @2 ( 7 8 9 ) = ( 7 9 )
:: (2 <= n, 2 <= m) | |
=> Int | Row |
-> Int | Column |
-> Matrix m n a | Original matrix. |
-> Matrix (m - 1) (n - 1) a | Matrix with row |
O(rows*cols). Remove a row and a column from a matrix. Example:
( 1 2 3 ) ( 4 5 6 ) ( 1 3 ) minorMatrixUnsafe 2 2 ( 7 8 9 ) = ( 7 9 )
:: (KnownNat i, KnownNat j, 1 <= i, (i + 1) <= m, 1 <= j, (j + 1) <= n) | |
=> Matrix m n a | Matrix to split. |
-> (Matrix i j a, Matrix i (n - j) a, Matrix (n - i) j a, Matrix (m - i) (n - j) a) | (TL,TR,BL,BR) |
O(1). Make a block-partition of a matrix using a given element as reference. The element will stay in the bottom-right corner of the top-left corner matrix. This means, the ranges of the pivot elements positions are \[ i <- [1..m-1], j <- [1..n-1] \]
( ) ( TR | TL ) ( ) ( ... | ... ) ( x ) ( x | ) splitBlocks @i @j ( ) = (-------------) , where x = a_{i,j} ( ) ( BL | BR ) ( ) ( ... | ... ) ( ) ( | )
Note that contrary to the matrix
version of this function, blocks will
never be empty.
Also, because of TypeLits not providing proper dependent types, there is
no way to have a type safe variant of this functon where the pivot element
is given at run-time.
Joining blocks
(<|>) :: forall m n k a. Matrix m n a -> Matrix m k a -> Matrix m (k + n) a Source #
Horizontally join two matrices. Visually:
( A ) <|> ( B ) = ( A | B )
(<->) :: forall m k n a. Matrix m n a -> Matrix k n a -> Matrix (m + k) n a Source #
Horizontally join two matrices. Visually:
( A ) ( A ) <-> ( B ) = ( - ) ( B )
joinBlocks :: forall mt mb nl nr a. (1 <= mt, 1 <= mb, 1 <= nl, 1 <= nr) => (Matrix mt nl a, Matrix mt nr a, Matrix mb nl a, Matrix mb nr a) -> Matrix (mt + mb) (nl + nr) a Source #
Join blocks of the form detailed in splitBlocks
. Precisely:
joinBlocks (tl,tr,bl,br) = (tl <|> tr) <-> (bl <|> br)
Matrix operations
elementwise :: forall m n a b c. (a -> b -> c) -> Matrix m n a -> Matrix m n b -> Matrix m n c Source #
Perform an operation element-wise.
This uses matrix
's elementwiseUnsafe
since we can guarantee proper
dimensions at compile time.
Matrix multiplication
About matrix multiplication
Four methods are provided for matrix multiplication.
multStd
: Matrix multiplication following directly the definition. This is the best choice when you know for sure that your matrices are small.multStd2
: Matrix multiplication following directly the definition. However, using a different definition frommultStd
. According to our benchmarks with this version,multStd2
is around 3 times faster thanmultStd
.multStrassen
: Matrix multiplication following the Strassen's algorithm. Complexity grows slower but also some work is added partitioning the matrix. Also, it only works on square matrices of order2^n
, so if this condition is not a) met, it is zero-padded until this is accomplished. Therefore, its use is not recommended.multStrassenMixed
: This function mixes the previous methods. It provides a better performance in general. Method(
*
)
of theNum
class uses this function because it gives the best average performance. However, if you know for sure that your matrices are small (size less than 500x500), you should usemultStd
ormultStd2
instead, sincemultStrassenMixed
is going to switch to those functions anyway.
We keep researching how to get better performance for matrix multiplication.
If you want to be on the safe side, use (*
).
Functions
multStd :: forall m k n a. Num a => Matrix m k a -> Matrix k n a -> Matrix m n a Source #
Standard matrix multiplication by definition.
multStd2 :: forall m k n a. Num a => Matrix m k a -> Matrix k n a -> Matrix m n a Source #
Standard matrix multiplication by definition.
multStrassen :: forall m k n a. Num a => Matrix m k a -> Matrix k n a -> Matrix m n a Source #
Strassen's matrix multiplication.
multStrassenMixed :: forall m k n a. Num a => Matrix m k a -> Matrix k n a -> Matrix m n a Source #
Mixed Strassen's matrix multiplication.
Linear transformations
scaleMatrix :: Num a => a -> Matrix m n a -> Matrix m n a Source #
Scale a matrix by a given factor. Example:
( 1 2 3 ) ( 2 4 6 ) ( 4 5 6 ) ( 8 10 12 ) scaleMatrix 2 ( 7 8 9 ) = ( 14 16 18 )
scaleRow :: forall i m n a. (KnownNat i, Num a) => a -> Matrix m n a -> Matrix m n a Source #
Scale a row by a given factor. The input row is not checked for validity. Example:
( 1 2 3 ) ( 1 2 3 ) ( 4 5 6 ) ( 12 15 18 ) scaleRow @2 3 ( 7 8 9 ) = ( 7 8 9 )
scaleRowUnsafe :: Num a => a -> Int -> Matrix m n a -> Matrix m n a Source #
Scale a row by a given factor. The input row is not checked for validity. Example:
( 1 2 3 ) ( 1 2 3 ) ( 4 5 6 ) ( 12 15 18 ) scaleRowUnsafe 3 2 ( 7 8 9 ) = ( 7 8 9 )
combineRows :: forall i k m n a. (KnownNat i, KnownNat k, Num a) => a -> Matrix m n a -> Matrix m n a Source #
Add to one row a scalar multiple of another row. Example:
( 1 2 3 ) ( 1 2 3 ) ( 4 5 6 ) ( 6 9 12 ) combineRows @2 @1 2 ( 7 8 9 ) = ( 7 8 9 )
combineRowsUnsafe :: Num a => Int -> a -> Int -> Matrix m n a -> Matrix m n a Source #
Add to one row a scalar multiple of another row. Example:
( 1 2 3 ) ( 1 2 3 ) ( 4 5 6 ) ( 6 9 12 ) combineRowsUnsafe 2 2 1 ( 7 8 9 ) = ( 7 8 9 )
:: (KnownNat i, KnownNat k, 1 <= i, i <= m, 1 <= k, k <= m) | |
=> Matrix m n a | Original matrix. |
-> Matrix m n a | Matrix with rows 1 and 2 switched. |
Switch two rows of a matrix. Example:
( 1 2 3 ) ( 4 5 6 ) ( 4 5 6 ) ( 1 2 3 ) switchRows @1 @2 ( 7 8 9 ) = ( 7 8 9 )
:: Int | Row 1. |
-> Int | Row 2. |
-> Matrix m n a | Original matrix. |
-> Matrix m n a | Matrix with rows 1 and 2 switched. |
Switch two rows of a matrix. The validity of the input row numbers is not checked Example:
( 1 2 3 ) ( 4 5 6 ) ( 4 5 6 ) ( 1 2 3 ) switchRowsUnsafe 1 2 ( 7 8 9 ) = ( 7 8 9 )
:: (KnownNat i, KnownNat k, 1 <= i, i <= n, 1 <= k, k <= n) | |
=> Matrix m n a | Original matrix. |
-> Matrix m n a | Matrix with cols 1 and 2 switched. |
Switch two coumns of a matrix. Example:
( 1 2 3 ) ( 2 1 3 ) ( 4 5 6 ) ( 5 4 6 ) switchCols @1 @2 ( 7 8 9 ) = ( 8 7 9 )
:: Int | Col 1. |
-> Int | Col 2. |
-> Matrix m n a | Original matrix. |
-> Matrix m n a | Matrix with cols 1 and 2 switched. |
Switch two coumns of a matrix. The validity of the input column numbers is not checked. Example:
( 1 2 3 ) ( 2 1 3 ) ( 4 5 6 ) ( 5 4 6 ) switchColsUnsafe 1 2 ( 7 8 9 ) = ( 8 7 9 )
Decompositions
luDecomp :: (Ord a, Fractional a) => Matrix m n a -> Maybe (Matrix m n a, Matrix m n a, Matrix m n a, a) Source #
Matrix LU decomposition with partial pivoting. The result for a matrix M is given in the format (U,L,P,d) where:
- U is an upper triangular matrix.
- L is an unit lower triangular matrix.
- P is a permutation matrix.
- d is the determinant of P.
- PM = LU.
These properties are only guaranteed when the input matrix is invertible. An additional property matches thanks to the strategy followed for pivoting:
- L_(i,j) <= 1, for all i,j.
This follows from the maximal property of the selected pivots, which also leads to a better numerical stability of the algorithm.
Example:
( 1 2 0 ) ( 2 0 2 ) ( 1 0 0 ) ( 0 0 1 ) ( 0 2 1 ) ( 0 2 -1 ) ( 1/2 1 0 ) ( 1 0 0 ) luDecomp ( 2 0 2 ) = ( ( 0 0 2 ) , ( 0 1 1 ) , ( 0 1 0 ) , 1 )
Nothing
is returned if no LU decomposition exists.
luDecompUnsafe :: (Ord a, Fractional a) => Matrix m n a -> (Matrix m n a, Matrix m n a, Matrix m n a, a) Source #
Unsafe version of luDecomp
. It fails when the input matrix is singular.
luDecomp' :: (Ord a, Fractional a) => Matrix m n a -> Maybe (Matrix m n a, Matrix m m a, Matrix m m a, Matrix n n a, a, a) Source #
Matrix LU decomposition with complete pivoting. The result for a matrix M is given in the format (U,L,P,Q,d,e) where:
- U is an upper triangular matrix.
- L is an unit lower triangular matrix.
- P,Q are permutation matrices.
- d,e are the determinants of P and Q respectively.
- PMQ = LU.
These properties are only guaranteed when the input matrix is invertible. An additional property matches thanks to the strategy followed for pivoting:
- L_(i,j) <= 1, for all i,j.
This follows from the maximal property of the selected pivots, which also leads to a better numerical stability of the algorithm.
Example:
( 1 0 ) ( 2 1 ) ( 1 0 0 ) ( 0 0 1 ) ( 0 2 ) ( 0 2 ) ( 0 1 0 ) ( 0 1 0 ) ( 1 0 ) luDecomp' ( 2 1 ) = (( 0 0 ), ( 1/2 -1/4 1 ), ( 1 0 0 ), ( 0 1 ), -1 , 1 )
Nothing
is returned if no LU decomposition exists.
luDecompUnsafe' :: (Ord a, Fractional a) => Matrix m n a -> (Matrix m n a, Matrix m m a, Matrix m m a, Matrix n n a, a, a) Source #
Unsafe version of luDecomp'
. It fails when the input matrix is singular.
cholDecomp :: Floating a => Matrix n n a -> Matrix n n a Source #
Simple Cholesky decomposition of a symmetric, positive definite matrix. The result for a matrix M is a lower triangular matrix L such that:
- M = LL^T.
Example:
( 2 -1 0 ) ( 1.41 0 0 ) ( -1 2 -1 ) ( -0.70 1.22 0 ) cholDecomp ( 0 -1 2 ) = ( 0.00 -0.81 1.15 )
Properties
trace :: Num a => Matrix m n a -> a Source #
Sum of the elements in the diagonal. See also getDiag
.
Example:
( 1 2 3 ) ( 4 5 6 ) trace ( 7 8 9 ) = 15
diagProd :: Num a => Matrix m n a -> a Source #
Product of the elements in the diagonal. See also getDiag
.
Example:
( 1 2 3 ) ( 4 5 6 ) diagProd ( 7 8 9 ) = 45
Determinants
detLaplace :: Num a => Matrix n n a -> a Source #
Matrix determinant using Laplace expansion.
If the elements of the Matrix
are instance of Ord
and Fractional
consider to use detLU
in order to obtain better performance.
Function detLaplace
is extremely slow.
detLU :: (Ord a, Fractional a) => Matrix n n a -> a Source #
Matrix determinant using LU decomposition. It works even when the input matrix is singular.
flatten :: forall m' n' m n a. Matrix m' n' (Matrix m n a) -> Matrix (m' * m) (n' * n) a Source #
Flatten a matrix of matrices.
Helper functions
applyUnary :: forall m n m' n' a b. (Matrix a -> Matrix b) -> Matrix m n a -> Matrix m' n' b Source #
Apply a map function to the unsafe inner matrix type.
applyBinary :: forall m n m' n' m'' n'' a b. (Matrix a -> Matrix a -> Matrix b) -> Matrix m n a -> Matrix m' n' a -> Matrix m'' n'' b Source #
Transform a binary unstatic function to a binary static function.
unpackStatic :: forall m n a. Matrix m n a -> Matrix a Source #
Forget static information about a matrix. This converts
this converts the Matrix
type to Data.Matrix.Matrix