hmatrix-static-0.3: hmatrix with vector and matrix sizes encoded in typesSource codeContentsIndex
Data.Packed.Static.Matrix
Portabilityportable
Stabilityexperimental
MaintainerReiner Pope <reiner.pope@gmail.com>
Contents
Shaping
By-index construction
To/from lists
Tofrom rowscolumn vectors
Other operations
Conversions / file input
Description
Statically-dimensioned 2D matrices.
Synopsis
data Matrix mn t
refineMat :: forall m n t a. Matrix (m, n) t -> (forall m' n'. (PositiveT m', PositiveT n') => Matrix (m', n') t -> a) -> a
forgetRowsU :: Matrix (m, n) t -> Matrix (Unknown, n) t
forgetColsU :: Matrix (m, n) t -> Matrix (m, Unknown) t
atRows :: Matrix (m, n) t -> m -> Matrix (m, n) t
atCols :: Matrix (m, n) t -> n -> Matrix (m, n) t
withShape :: forall m n t. (PositiveT m, PositiveT n) => (Int -> Int -> Matrix (m, n) t) -> Matrix (m, n) t
withRows :: forall m n t. PositiveT m => (Int -> Matrix (m, n) t) -> Matrix (m, n) t
withCols :: forall m n t. PositiveT n => (Int -> Matrix (m, n) t) -> Matrix (m, n) t
withSquare :: forall n t. PositiveT n => (Int -> Matrix (n, n) t) -> Matrix (n, n) t
buildMatrix :: (PositiveT m, PositiveT n, Element a) => ((Int, Int) -> a) -> Matrix (m, n) a
(><) :: (PositiveT m, PositiveT n, Element t) => m -> n -> [t] -> Matrix (m, n) t
matFromList :: (Element t, PositiveT m, PositiveT n) => [t] -> Matrix (m, n) t
fromListsU :: Element t => [[t]] -> Matrix (Unknown, Unknown) t
toLists :: Element t => Matrix (m, n) t -> [[t]]
fromRowsU :: Element t => [Vector n t] -> Matrix (Unknown, n) t
toRows :: Element t => Matrix (m, n) t -> [Vector n t]
fromColumnsU :: Element t => [Vector n t] -> Matrix (n, Unknown) t
toColumns :: Element t => Matrix (m, n) t -> [Vector m t]
fromBlocksU :: Element t => [[Matrix (Unknown, Unknown) t]] -> Matrix (Unknown, Unknown) t
asRow :: Element a => Vector n a -> Matrix (D1, n) a
asColumn :: Element a => Vector n a -> Matrix (n, D1) a
rows :: Matrix (m, n) t -> Int
cols :: Matrix (m, n) t -> Int
trans :: Matrix (m, n) t -> Matrix (n, m) t
reshapeU :: Element t => Int -> Vector n t -> Matrix (Unknown, Unknown) t
flatten :: Element t => Matrix (m, n) t -> Vector (m :*: n) t
(@@>) :: Storable t => Matrix (m, n) t -> (Int, Int) -> t
repmatU :: Element t => Matrix (m, n) t -> Int -> Int -> Matrix (Unknown, Unknown) t
flipud :: Element t => Matrix (m, n) t -> Matrix (m, n) t
fliprl :: Element t => Matrix (m, n) t -> Matrix (m, n) t
subMatrixU :: Element a => (Int, Int) -> (Int, Int) -> Matrix (m, n) a -> Matrix (Unknown, Unknown) a
takeRows :: (PositiveT m', Element t, m' :<=: m ~ True) => Matrix (m, n) t -> Matrix (m', n) t
dropRows :: (PositiveT m', Element t, m' :<=: m ~ True) => Matrix (m, n) t -> Matrix (m', n) t
takeColumns :: (PositiveT n', Element t, n' :<=: n ~ True) => Matrix (m, n) t -> Matrix (m, n') t
dropColumns :: (PositiveT n', Element t, n' :<=: n ~ True) => Matrix (m, n) t -> Matrix (m, n') t
extractRowsU :: Element t => [Int] -> Matrix (m, n) t -> Matrix (Unknown, n) t
ident :: (Element t, PositiveT n) => Matrix (n, n) t
diag :: Element a => Vector n a -> Matrix (n, n) a
diagRect :: (Element a, PositiveT m, PositiveT n) => Vector (Min m n) a -> Matrix (m, n) a
takeDiag :: Element t => Matrix (m, n) t -> Vector (Min m n) t
liftMatrix :: (Element a, Element b) => (Vector (m :*: n) a -> Vector (m :*: n) b) -> Matrix (m, n) a -> Matrix (m, n) b
format :: Element t => String -> (t -> String) -> Matrix (m, n) t -> String
readMatrix :: String -> Matrix (Unknown, Unknown) Double
fromFile :: FilePath -> (Int, Int) -> IO (Matrix (Unknown, Unknown) Double)
fromArray2D :: Element t => Array (Int, Int) t -> Matrix (Unknown, Unknown) t
Documentation
data Matrix mn t Source
A matrix with m rows, n columns.
show/hide Instances
ShapedContainer Matrix
JoinableH (Matrix ((,) m n)) (Vector m)
JoinableH (Matrix ((,) m n)) (Matrix ((,) m p))
JoinableH (Vector m) (Matrix ((,) m n))
JoinableV (Matrix ((,) m n)) (Vector n)
JoinableV (Matrix ((,) m n)) (Matrix ((,) p n))
JoinableV (Vector n) (Matrix ((,) m n))
n ~ n' => Mul (Matrix ((,) m n)) (Vector n')
n ~ n' => Mul (Matrix ((,) m n)) (Matrix ((,) n' p))
m ~ m' => Mul (Vector m) (Matrix ((,) m' n))
(Element e, Show e) => Show (Matrix ((,) m n) e)
Shaping
refineMat :: forall m n t a. Matrix (m, n) t -> (forall m' n'. (PositiveT m', PositiveT n') => Matrix (m', n') t -> a) -> aSource
forgetRowsU :: Matrix (m, n) t -> Matrix (Unknown, n) tSource
forgetColsU :: Matrix (m, n) t -> Matrix (m, Unknown) tSource
atRows :: Matrix (m, n) t -> m -> Matrix (m, n) tSource

Fixes a matrix's static row length. Essentially a mechanism for partial type signatures: you can specify the row length without specifying the rest of matrix's type.

>ident `atRows` d5
[$mat| 1.0, 0.0, 0.0, 0.0, 0.0;
       0.0, 1.0, 0.0, 0.0, 0.0;
       0.0, 0.0, 1.0, 0.0, 0.0;
       0.0, 0.0, 0.0, 1.0, 0.0;
       0.0, 0.0, 0.0, 0.0, 1.0 |]
atCols :: Matrix (m, n) t -> n -> Matrix (m, n) tSource

Fixes a matrix's static column length.

> ident `atCols` d4
[$mat| 1.0, 0.0, 0.0, 0.0;
       0.0, 1.0, 0.0, 0.0;
       0.0, 0.0, 1.0, 0.0;
       0.0, 0.0, 0.0, 1.0 |]
withShape :: forall m n t. (PositiveT m, PositiveT n) => (Int -> Int -> Matrix (m, n) t) -> Matrix (m, n) tSource
withRows :: forall m n t. PositiveT m => (Int -> Matrix (m, n) t) -> Matrix (m, n) tSource
withCols :: forall m n t. PositiveT n => (Int -> Matrix (m, n) t) -> Matrix (m, n) tSource
withSquare :: forall n t. PositiveT n => (Int -> Matrix (n, n) t) -> Matrix (n, n) tSource
By-index construction
buildMatrix :: (PositiveT m, PositiveT n, Element a) => ((Int, Int) -> a) -> Matrix (m, n) aSource

Constructs a matrix using the function from row/column index. The first of the pair is the row; the second is the column. Indexing is 0-based.

> buildMatrix (fromIntegral . uncurry (^)) `atShape` (d3,d4)
[$mat| 1.0, 0.0, 0.0, 0.0;
       1.0, 1.0, 1.0, 1.0;
       1.0, 2.0, 4.0, 8.0 |]
To/from lists
(><) :: (PositiveT m, PositiveT n, Element t) => m -> n -> [t] -> Matrix (m, n) tSource

Constructs a matrix from a list. The size in the matrix's type and the list's length must agree or else a runtime error will be raised.

> (d2 >< d3)[1,2,3,4,5,6]
[$mat| 1.0, 2.0, 3.0;
       4.0, 5.0, 6.0 |]
matFromList :: (Element t, PositiveT m, PositiveT n) => [t] -> Matrix (m, n) tSource

Constructs a matrix from a list. The size in the matrix's type and the list's length must agree or else a runtime error will be raised.

> matFromList [1,2,3,4,5,6] `atShape` (d2,d3)
[$mat| 1.0, 2.0, 3.0;
       4.0, 5.0, 6.0 |]
fromListsU :: Element t => [[t]] -> Matrix (Unknown, Unknown) tSource

Constructs a matrix from a list of lists of elements. Each sublist must be of equal size or a runtime error will be raised.

> fromListsU [[1,2,3],[4,5,6]]
[$mat| 1.0, 2.0, 3.0;
       4.0, 5.0, 6.0 |]
toLists :: Element t => Matrix (m, n) t -> [[t]]Source

Converts a matrix to a list of its rows, each as a list.

> toLists [$mat|1,2,3;4,5,6|]
[[1.0,2.0,3.0],[4.0,5.0,6.0]]
Tofrom rowscolumn vectors
fromRowsU :: Element t => [Vector n t] -> Matrix (Unknown, n) tSource

Constructs a matrix from a list of rows.

> fromRowsU [[$vec|1,2,3|],[$vec|4,5,6|]]
[$mat| 1.0, 2.0, 3.0;
       4.0, 5.0, 6.0 |]
toRows :: Element t => Matrix (m, n) t -> [Vector n t]Source

Converts a matrix to a list of its rows.

> toRows [$mat|1,2,3;4,5,6|]
[[$vec| 1.0, 2.0, 3.0 |],[$vec| 4.0, 5.0, 6.0 |]]
fromColumnsU :: Element t => [Vector n t] -> Matrix (n, Unknown) tSource

Constructs a matrix from a list of columns.

> fromColumnsU [[$vec|1,2,3|],[$vec|4,5,6|]]
[$mat| 1.0, 4.0;
       2.0, 5.0;
       3.0, 6.0 |]
toColumns :: Element t => Matrix (m, n) t -> [Vector m t]Source

Converts a matrix to a list of its columns.

> toColumns [$mat|1,2,3;4,5,6|]
[[$vec| 1.0, 4.0 |],[$vec| 2.0, 5.0 |],[$vec| 3.0, 6.0 |]]
fromBlocksU :: Element t => [[Matrix (Unknown, Unknown) t]] -> Matrix (Unknown, Unknown) tSource

Constructs a matrix from blocks.

> fromBlocksU [[[$matU|1,2,3;4,5,6|],  [$matU|7,8,9;10,11,12|]],
               [[$matU|11,12,13;14,15,16|],[$matU|21,22,23;24,25,26|]]]
[$mat|  1.0,  2.0,  3.0,  7.0,  8.0,  9.0;
        4.0,  5.0,  6.0, 10.0, 11.0, 12.0;
       11.0, 12.0, 13.0, 21.0, 22.0, 23.0;
       14.0, 15.0, 16.0, 24.0, 25.0, 26.0 |]
asRow :: Element a => Vector n a -> Matrix (D1, n) aSource

Interprets a vector as a 1-row matrix.

> asRow [$vec|1,2,3|]
[$mat| 1.0, 2.0, 3.0 |]
asColumn :: Element a => Vector n a -> Matrix (n, D1) aSource

Interprets a vector as a 1-column matrix.

> asColumn [$vec|1,2,3|]
[$mat| 1.0;
       2.0;
       3.0 |]
Other operations
rows :: Matrix (m, n) t -> IntSource

Returns the number of rows of the matrix.

> rows [$mat|1::Double,2,3;4,5,6|]
2
cols :: Matrix (m, n) t -> IntSource

Returns the number of columns of the matrix.

> cols [$mat|1::Double,2,3;4,5,6|]
3
trans :: Matrix (m, n) t -> Matrix (n, m) tSource

Matrix transpose.

> trans [$mat|1,2,3;4,5,6|]
[$mat| 1.0, 4.0;
       2.0, 5.0;
       3.0, 6.0 |]
reshapeU :: Element t => Int -> Vector n t -> Matrix (Unknown, Unknown) tSource

Reshapes a vector into a matrix, with the specified number of columns. If the vector's length is not a multiple of the required columns, a runtime error is raised.

> reshapeU 3 [$vecU|1,2,3,4,5,6|]
[$mat| 1.0, 2.0, 3.0;
       4.0, 5.0, 6.0 |]
flatten :: Element t => Matrix (m, n) t -> Vector (m :*: n) tSource

Flattens a matrix into a vector.

> flatten [$mat|1,2,3;4,5,6|]
[$vec| 1.0, 2.0, 3.0, 4.0, 5.0, 6.0 |]
(@@>) :: Storable t => Matrix (m, n) t -> (Int, Int) -> tSource

Indexes a matrix.

> [$mat|1,2,3;4,5,6|] @@> (1,2)
6.0
repmatU :: Element t => Matrix (m, n) t -> Int -> Int -> Matrix (Unknown, Unknown) tSource

replicate for matrices.

> repmatU [$mat|1;2|] 2 3
[$mat| 1.0, 1.0, 1.0;
       2.0, 2.0, 2.0;
       1.0, 1.0, 1.0;
       2.0, 2.0, 2.0 |]
flipud :: Element t => Matrix (m, n) t -> Matrix (m, n) tSource

Vertically flips a matrix.

> flipud [$mat|1,2,3;4,5,6|]
[$mat| 4.0, 5.0, 6.0;
       1.0, 2.0, 3.0 |]
fliprl :: Element t => Matrix (m, n) t -> Matrix (m, n) tSource

Horizonatlly flips a matrix.

> fliprl [$mat|1,2,3;4,5,6|]
[$mat| 3.0, 2.0, 1.0;
       6.0, 5.0, 4.0 |]
subMatrixU :: Element a => (Int, Int) -> (Int, Int) -> Matrix (m, n) a -> Matrix (Unknown, Unknown) aSource

Extracts a submatrix.

> subMatrixU (0,1) (2,2) [$mat|1,2,3,4;5,6,7,8;9,10,11,12|]
[$mat| 2.0, 3.0;
       6.0, 7.0 |]
takeRows :: (PositiveT m', Element t, m' :<=: m ~ True) => Matrix (m, n) t -> Matrix (m', n) tSource

Takes rows from the top of the matrix until the required size is reached.

> takeRows [$mat|1,2;3,4;5,6|] `atRows` d2
[$mat| 1.0, 2.0;
       3.0, 4.0 |]
dropRows :: (PositiveT m', Element t, m' :<=: m ~ True) => Matrix (m, n) t -> Matrix (m', n) tSource

Takes rows from the bottom of the matrix until the required size is reached.

> dropRows [$mat|1,2;3,4;5,6|] `atRows` d2
[$mat| 3.0, 4.0;
       5.0, 6.0 |]
takeColumns :: (PositiveT n', Element t, n' :<=: n ~ True) => Matrix (m, n) t -> Matrix (m, n') tSource

Takes columns from the left of the matrix until the required size is reached.

> takeColumns [$mat|1,2,3;4,5,6|] `atCols` d2
[$mat| 1.0, 2.0;
       4.0, 5.0 |]
dropColumns :: (PositiveT n', Element t, n' :<=: n ~ True) => Matrix (m, n) t -> Matrix (m, n') tSource

Takes columns from the right of the matrix until the required size is reached.

> dropColumns [$mat|1,2,3;4,5,6|] `atCols` d2
[$mat| 2.0, 3.0;
       5.0, 6.0 |]
extractRowsU :: Element t => [Int] -> Matrix (m, n) t -> Matrix (Unknown, n) tSource

Extracts the given rows from a matrix.

> extractRowsU [1,0] [$mat|1,2;3,4;5,6|]
[$mat| 3.0, 4.0;
       1.0, 2.0 |]
ident :: (Element t, PositiveT n) => Matrix (n, n) tSource

Constructs the identity matrix of any given size.

> ident `atRows` d3
[$mat| 1.0, 0.0, 0.0;
       0.0, 1.0, 0.0;
       0.0, 0.0, 1.0 |]
diag :: Element a => Vector n a -> Matrix (n, n) aSource

Constructs a square matrix with the given vector as its diagonal.

> diag (linspace (1,3)) `atRows` d3
[$mat| 1.0, 0.0, 0.0;
       0.0, 2.0, 0.0;
       0.0, 0.0, 3.0 |]
diagRect :: (Element a, PositiveT m, PositiveT n) => Vector (Min m n) a -> Matrix (m, n) aSource

Constructs a rectangular matrix with the given vector as its diagonal.

> diagRect (linspace (1,3)) `atShape` (d3,d4)
[$mat| 1.0, 0.0, 0.0, 0.0;
       0.0, 2.0, 0.0, 0.0;
       0.0, 0.0, 3.0, 0.0 |]

> diagRect (linspace (1,3)) `atShape` (d4,d3)
[$mat| 1.0, 0.0, 0.0;
       0.0, 2.0, 0.0;
       0.0, 0.0, 3.0;
       0.0, 0.0, 0.0 |]
takeDiag :: Element t => Matrix (m, n) t -> Vector (Min m n) tSource

Takes the diagonal from a matrix.

> takeDiag [$mat|1,2,3;4,5,6|]
[$vec| 1.0, 5.0 |]
liftMatrix :: (Element a, Element b) => (Vector (m :*: n) a -> Vector (m :*: n) b) -> Matrix (m, n) a -> Matrix (m, n) bSource

Operations on matrices viewed as operations on the vector of their elements

> liftMatrix (+constant 2) [$mat|1,2,3;4,5,6|]
[$mat| 3.0, 4.0, 5.0;
       6.0, 7.0, 8.0 |]
Conversions / file input
format :: Element t => String -> (t -> String) -> Matrix (m, n) t -> StringSource
See hmatrix's format.
readMatrix :: String -> Matrix (Unknown, Unknown) DoubleSource
See hmatrix's readMatrix.
fromFile :: FilePath -> (Int, Int) -> IO (Matrix (Unknown, Unknown) Double)Source
See hmatrix's fromFile.
fromArray2D :: Element t => Array (Int, Int) t -> Matrix (Unknown, Unknown) tSource
See hmatrix's fromArray2D.
Produced by Haddock version 2.4.2