-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Sparse linear algebra algorithms and datastructures for scientific computation, in native Haskell. Iterative linear solvers, matrix factorizations, linear eigensolvers and related utilities. -- -- Overview -- -- The sparse-linear-algebra library provides iterative linear -- solvers, matrix decompositions, eigenvalue computations and related -- utilities. The user interface is provided by the top-level module -- Numeric.LinearAlgebra.Sparse: -- --
--   import           Numeric.LinearAlgebra.Sparse
--   
-- -- Please refer to the README file for usage examples. @package sparse-linear-algebra @version 0.2.9 -- | Testing for values "near" zero module Numeric.Eps -- | Provides a test to see if a quantity is near zero. -- --
--   >>> nearZero (1e-11 :: Double)
--   False
--   
-- --
--   >>> nearZero (1e-17 :: Double)
--   True
--   
-- --
--   >>> nearZero (1e-5 :: Float)
--   False
--   
-- --
--   >>> nearZero (1e-7 :: Float)
--   True
--   
class (Floating a, Num a) => Epsilon a -- | Determine if a quantity is near zero. nearZero :: Epsilon a => a -> Bool -- | Rounding rule isNz :: Epsilon a => a -> Bool roundZero :: Epsilon a => a -> a roundOne :: Epsilon a => a -> a -- | Round to respectively 0 or 1 roundZeroOne :: Epsilon a => a -> a -- | Rounding rule nearOne :: Epsilon a => a -> Bool instance Numeric.Eps.Epsilon GHC.Types.Float instance Numeric.Eps.Epsilon GHC.Types.Double instance Numeric.Eps.Epsilon Foreign.C.Types.CFloat instance Numeric.Eps.Epsilon Foreign.C.Types.CDouble instance Numeric.Eps.Epsilon (Data.Complex.Complex GHC.Types.Float) instance Numeric.Eps.Epsilon (Data.Complex.Complex GHC.Types.Double) instance Numeric.Eps.Epsilon (Data.Complex.Complex Foreign.C.Types.CFloat) instance Numeric.Eps.Epsilon (Data.Complex.Complex Foreign.C.Types.CDouble) -- | Typeclasses for linear algebra and related concepts module Numeric.LinearAlgebra.Class class (Eq e, Fractional e, Floating e, Num (EltMag e), Ord (EltMag e)) => Elt e where type EltMag e :: * conj = id where { type family EltMag e :: *; } conj :: Elt e => e -> e mag :: Elt e => e -> EltMag e -- | Scale a vector (.*) :: VectorSpace v => Scalar v -> v -> v -- | Scale a vector by the reciprocal of a number (e.g. for normalization) (./) :: (VectorSpace v, Fractional (Scalar v)) => v -> Scalar v -> v -- | Convex combination of two vectors (NB: 0 <= a <= 1). lerp :: (VectorSpace e, Num (Scalar e)) => Scalar e -> e -> e -> e -- | Inner product dot :: InnerSpace v => v -> v -> Scalar v -- | `hilbertDistSq x y = || x - y ||^2` computes the squared L2 distance -- between two vectors hilbertDistSq :: InnerSpace v => v -> v -> Scalar v class (InnerSpace v, Num (RealScalar v), Eq (RealScalar v), Epsilon (Magnitude v), Show (Magnitude v), Ord (Magnitude v)) => Normed v where type Magnitude v :: * type RealScalar v :: * normalize2' x = x ./ norm2' x norm2 x = sqrt (norm2Sq x) norm2' x = sqrt $ x <.> x norm p v | p == 1 = norm1 v | p == 2 = norm2 v | otherwise = normP p v where { type family Magnitude v :: *; type family RealScalar v :: *; } norm1 :: Normed v => v -> Magnitude v norm2Sq :: Normed v => v -> Magnitude v normP :: Normed v => RealScalar v -> v -> Magnitude v normalize :: Normed v => RealScalar v -> v -> v normalize2 :: Normed v => v -> v normalize2' :: (Normed v, Floating (Scalar v)) => v -> v norm2 :: (Normed v, Floating (Magnitude v)) => v -> Magnitude v norm2' :: (Normed v, Floating (Scalar v)) => v -> Scalar v norm :: (Normed v, Floating (Magnitude v)) => RealScalar v -> v -> Magnitude v -- | Infinity-norm (Real) normInftyR :: (Foldable t, Ord a) => t a -> a -- | Infinity-norm (Complex) normInftyC :: (Foldable t, RealFloat a, Functor t) => t (Complex a) -> a -- | Lp inner product (p > 0) dotLp :: (Set t, Foldable t, Floating a) => a -> t a -> t a -> a -- | Reciprocal reciprocal :: (Functor f, Fractional b) => f b -> f b -- | Scale scale :: (Num b, Functor f) => b -> f b -> f b -- | A matrix ring is any collection of matrices over some ring R that form -- a ring under matrix addition and matrix multiplication class (AdditiveGroup m, Epsilon (MatrixNorm m)) => MatrixRing m where type MatrixNorm m :: * a #^# b = transpose a ## b where { type family MatrixNorm m :: *; } (##) :: MatrixRing m => m -> m -> m (##^) :: MatrixRing m => m -> m -> m (#^#) :: MatrixRing m => m -> m -> m transpose :: MatrixRing m => m -> m normFrobenius :: MatrixRing m => m -> MatrixNorm m class (VectorSpace v, MatrixRing (MatrixType v)) => LinearVectorSpace v where type MatrixType v :: * where { type family MatrixType v :: *; } (#>) :: LinearVectorSpace v => MatrixType v -> v -> v (<#) :: LinearVectorSpace v => v -> MatrixType v -> v type V v = (LinearVectorSpace v, Normed v) class LinearVectorSpace v => LinearSystem v (<\>) :: (LinearSystem v, MonadIO m, MonadThrow m) => MatrixType v -> v -> m v class Functor f => FiniteDim f where type FDSize f :: * where { type family FDSize f :: *; } dim :: FiniteDim f => f a -> FDSize f class FiniteDim' f where type FDSize' f :: * where { type family FDSize' f :: *; } dim' :: FiniteDim' f => f -> FDSize' f class HasData f a where type HDData f a :: * where { type family HDData f a :: *; } nnz :: HasData f a => f a -> Int dat :: HasData f a => f a -> HDData f a class HasData' f where type HDD f :: * where { type family HDD f :: *; } nnz' :: HasData' f => f -> Int dat' :: HasData' f => f -> HDD f class (FiniteDim f, HasData f a) => Sparse f a spy :: (Sparse f a, Fractional b) => f a -> b class (FiniteDim' f, HasData' f) => Sparse' f spy' :: (Sparse' f, Fractional b) => f -> b class Functor f => Set f -- | union binary lift : apply function on _union_ of two "sets" liftU2 :: Set f => (a -> a -> a) -> f a -> f a -> f a -- | intersection binary lift : apply function on _intersection_ of two -- "sets" liftI2 :: Set f => (a -> a -> b) -> f a -> f a -> f b class Sparse c a => SpContainer c a where type ScIx c :: * where { type family ScIx c :: *; } scInsert :: SpContainer c a => ScIx c -> a -> c a -> c a scLookup :: SpContainer c a => c a -> ScIx c -> Maybe a scToList :: SpContainer c a => c a -> [(ScIx c, a)] (@@) :: SpContainer c a => c a -> ScIx c -> a class SpContainer' c where type ScIx' c :: * where { type family ScIx' c :: *; } scInsert' :: SpContainer' c => ScIx' c -> a -> c -> c scLookup' :: SpContainer' c => c -> ScIx' c -> Maybe a scToList' :: SpContainer' c => c -> [a] class SpContainer v e => SparseVector v e where type SpvIx v :: * where { type family SpvIx v :: *; } svFromList :: SparseVector v e => Int -> [(SpvIx v, e)] -> v e svFromListDense :: SparseVector v e => Int -> [e] -> v e svConcat :: (SparseVector v e, Foldable t) => t (v e) -> v e class SpContainer m e => SparseMatrix m e smFromVector :: SparseMatrix m e => LexOrd -> (Int, Int) -> Vector (IxRow, IxCol, e) -> m e smTranspose :: SparseMatrix m e => m e -> m e encodeIx :: SparseMatrix m e => m e -> LexOrd -> (IxRow, IxCol) -> LexIx decodeIx :: SparseMatrix m e => m e -> LexOrd -> LexIx -> (IxRow, IxCol) -- | Lift a real number onto the complex plane toC :: Num a => a -> Complex a instance Numeric.LinearAlgebra.Class.Elt GHC.Types.Double instance Numeric.LinearAlgebra.Class.Elt GHC.Types.Float instance GHC.Float.RealFloat e => Numeric.LinearAlgebra.Class.Elt (Data.Complex.Complex e) instance Numeric.LinearAlgebra.Class.Normed GHC.Types.Double instance Numeric.LinearAlgebra.Class.Normed (Data.Complex.Complex GHC.Types.Double) module Control.Exception.Common data PartialFunctionError EmptyList :: String -> PartialFunctionError -- | Input error data InputError NonNegError :: String -> Int -> InputError -- | Out of bounds index error data OutOfBoundsIndexError i OOBIxError :: String -> i -> OutOfBoundsIndexError i OOBIxsError :: String -> [i] -> OutOfBoundsIndexError i OOBNoCompatRows :: String -> (i, i) -> OutOfBoundsIndexError i checkIxBound :: MonadThrow m => String -> Int -> UB -> m a -> m a -- | Operand size mismatch errors data OperandSizeMismatch DotSizeMismatch :: Int -> Int -> OperandSizeMismatch NonTriangularException :: String -> OperandSizeMismatch MatVecSizeMismatchException :: String -> (Int, Int) -> Int -> OperandSizeMismatch -- | Matrix exceptions data MatrixException i HugeConditionNumber :: String -> i -> MatrixException i NeedsPivoting :: String -> String -> MatrixException i -- | Numerical iteration errors data IterationException a NotConvergedE :: String -> Int -> a -> IterationException a DivergingE :: String -> Int -> a -> a -> IterationException a instance GHC.Classes.Eq a => GHC.Classes.Eq (Control.Exception.Common.IterationException a) instance GHC.Classes.Eq i => GHC.Classes.Eq (Control.Exception.Common.MatrixException i) instance GHC.Classes.Eq Control.Exception.Common.OperandSizeMismatch instance GHC.Classes.Eq i => GHC.Classes.Eq (Control.Exception.Common.OutOfBoundsIndexError i) instance GHC.Classes.Eq Control.Exception.Common.InputError instance GHC.Classes.Eq Control.Exception.Common.PartialFunctionError instance GHC.Show.Show Control.Exception.Common.PartialFunctionError instance GHC.Exception.Exception Control.Exception.Common.PartialFunctionError instance GHC.Show.Show Control.Exception.Common.InputError instance GHC.Exception.Exception Control.Exception.Common.InputError instance GHC.Show.Show i => GHC.Show.Show (Control.Exception.Common.OutOfBoundsIndexError i) instance (GHC.Show.Show i, Data.Typeable.Internal.Typeable i) => GHC.Exception.Exception (Control.Exception.Common.OutOfBoundsIndexError i) instance GHC.Show.Show Control.Exception.Common.OperandSizeMismatch instance GHC.Exception.Exception Control.Exception.Common.OperandSizeMismatch instance GHC.Show.Show i => GHC.Show.Show (Control.Exception.Common.MatrixException i) instance (GHC.Show.Show i, Data.Typeable.Internal.Typeable i) => GHC.Exception.Exception (Control.Exception.Common.MatrixException i) instance GHC.Show.Show a => GHC.Show.Show (Control.Exception.Common.IterationException a) instance (GHC.Show.Show a, Data.Typeable.Internal.Typeable a) => GHC.Exception.Exception (Control.Exception.Common.IterationException a) module Data.Sparse.SpVector data SpVector a SV :: {-# UNPACK #-} !Int -> !(IntM a) -> SpVector a [svDim] :: SpVector a -> {-# UNPACK #-} !Int [svData] :: SpVector a -> !(IntM a) -- | SpVector sparsity spySV :: Fractional b => SpVector a -> b -- | Number of nonzeros nzSV :: SpVector a -> Int sizeStrSV :: SpVector a -> String -- | SpVectors form a vector space because they can be multiplied by -- a scalar -- -- SpVectors are finite-dimensional vectors -- | SpVectors are sparse containers too, i.e. any specific -- component may be missing (so it is assumed to be 0) dotS :: InnerSpace (IntM t) => SpVector t -> SpVector t -> Scalar (IntM t) dotSSafe :: (InnerSpace (IntM t), MonadThrow m) => SpVector t -> SpVector t -> m (Scalar (IntM t)) -- | Empty sparse vector (length n, no entries) zeroSV :: Int -> SpVector a -- | Singleton sparse vector (length 1) singletonSV :: a -> SpVector a -- | Canonical basis vector in R^n ei :: Num a => Int -> Key -> SpVector a -- | Sparse vector from an association list while discarding all zero -- entries mkSpVector :: Epsilon a => Int -> IntMap a -> SpVector a mkSpVector1 :: Int -> IntMap a -> SpVector a -- | Dense real SpVector (monomorphic Double) mkSpVR :: Int -> [Double] -> SpVector Double -- | Dense complex SpVector (monomorphic Double) mkSpVC :: Int -> [Complex Double] -> SpVector (Complex Double) -- | Create new sparse vector, assumin 0-based, contiguous indexing fromListDenseSV :: Int -> [a] -> SpVector a -- | Map a function over a range of indices and filter the result (indices -- and values) to fit in a n-long SpVector spVectorDenseIx :: Epsilon a => (Int -> a) -> UB -> [Int] -> SpVector a -- | ", using just the integer bounds of the interval spVectorDenseLoHi :: Epsilon a => (Int -> a) -> UB -> Int -> Int -> SpVector a -- | one-hot encoding : `oneHotSV n k` produces a SpVector of length n -- having 1 at the k-th position oneHotSVU :: Num a => Int -> IxRow -> SpVector a oneHotSV :: Num a => Int -> IxRow -> SpVector a -- | DENSE vector of `1`s onesSV :: Num a => Int -> SpVector a -- | DENSE vector of `0`s zerosSV :: Num a => Int -> SpVector a -- | Populate a SpVector with the contents of a Vector. fromVector :: Vector a -> SpVector a -- | Populate a Vector with the entries of a SpVector, discarding the -- indices (NB: loses sparsity information). toVector :: SpVector a -> Vector a -- | toVectorDense :: Num a => SpVector a -> Vector a -- | insert element x at index i in a preexisting -- SpVector; discards out-of-bounds entries insertSpVector :: Key -> a -> SpVector a -> SpVector a insertSpVectorSafe :: MonadThrow m => Int -> a -> SpVector a -> m (SpVector a) fromListSV :: Foldable t => Int -> t (Int, a) -> SpVector a toListSV :: SpVector a -> [(Key, a)] -- | To dense list (default = 0) toDenseListSV :: Num b => SpVector b -> [b] -- | Indexed fold over SpVector ifoldSV :: (Key -> a -> b -> b) -> b -> SpVector a -> b -- | Lookup an index in a SpVector lookupSV :: Key -> SpVector a -> Maybe a -- | Lookup an index, return a default value if lookup fails lookupDefaultSV :: a -> Key -> SpVector a -> a -- | Lookup an index in a SpVector, returns 0 if lookup fails lookupDenseSV :: Num a => Key -> SpVector a -> a -- | Tail elements tailSV :: SpVector a -> SpVector a -- | Head element headSV :: Num a => SpVector a -> a -- | Keep the first n components of the SpVector (like take for -- lists) takeSV :: Int -> SpVector a -> SpVector a -- | Discard the first n components of the SpVector and rebalance the keys -- (like drop for lists) -- -- Keep the first n components of the SpVector (like take for -- lists) dropSV :: Int -> SpVector a -> SpVector a -- | Keep a range of entries rangeSV :: (Key, Key) -> SpVector a -> SpVector a -- | Concatenate two sparse vectors concatSV :: SpVector a -> SpVector a -> SpVector a -- | Filter filterSV :: (a -> Bool) -> SpVector a -> SpVector a -- | Indexed filter ifilterSV :: (Int -> a -> Bool) -> SpVector a -> SpVector a -- | Sparsify an SpVector sparsifySV :: Epsilon a => SpVector a -> SpVector a -- | Generate an arbitrary (not random) vector u such that `v dot -- u = 0` orthogonalSV :: (Scalar (SpVector t) ~ t, InnerSpace (SpVector t), Fractional t) => SpVector t -> SpVector t instance GHC.Classes.Eq a => GHC.Classes.Eq (Data.Sparse.SpVector.SpVector a) instance GHC.Show.Show a => GHC.Show.Show (Data.Sparse.SpVector.SpVector a) instance GHC.Base.Functor Data.Sparse.SpVector.SpVector instance Numeric.LinearAlgebra.Class.Set Data.Sparse.SpVector.SpVector instance Data.Foldable.Foldable Data.Sparse.SpVector.SpVector instance Numeric.LinearAlgebra.Class.FiniteDim Data.Sparse.SpVector.SpVector instance Numeric.LinearAlgebra.Class.HasData Data.Sparse.SpVector.SpVector a instance Numeric.LinearAlgebra.Class.Sparse Data.Sparse.SpVector.SpVector a instance Numeric.LinearAlgebra.Class.Elt a => Numeric.LinearAlgebra.Class.SpContainer Data.Sparse.SpVector.SpVector a instance Data.AdditiveGroup.AdditiveGroup (Data.Sparse.SpVector.SpVector GHC.Types.Double) instance Data.AdditiveGroup.AdditiveGroup (Data.Sparse.SpVector.SpVector (Data.Complex.Complex GHC.Types.Double)) instance Data.VectorSpace.VectorSpace (Data.Sparse.SpVector.SpVector GHC.Types.Double) instance Data.VectorSpace.VectorSpace (Data.Sparse.SpVector.SpVector (Data.Complex.Complex GHC.Types.Double)) instance Data.VectorSpace.InnerSpace (Data.Sparse.SpVector.SpVector GHC.Types.Double) instance Data.VectorSpace.InnerSpace (Data.Sparse.SpVector.SpVector (Data.Complex.Complex GHC.Types.Double)) instance Numeric.LinearAlgebra.Class.Normed (Data.Sparse.SpVector.SpVector GHC.Types.Double) instance Numeric.LinearAlgebra.Class.Normed (Data.Sparse.SpVector.SpVector (Data.Complex.Complex GHC.Types.Double)) module Data.Sparse.SpMatrix data SpMatrix a SM :: {-# UNPACK #-} !(Rows, Cols) -> !(IntM (IntM a)) -> SpMatrix a [smDim] :: SpMatrix a -> {-# UNPACK #-} !(Rows, Cols) [smData] :: SpMatrix a -> !(IntM (IntM a)) sizeStr :: (FDSize f ~ (a1, a2), Sparse f a, Show a2, Show a1) => f a -> String -- | SpMatrixes form an additive group, in that they can have an -- invertible associtative operation (matrix sum) -- | SpMatrixes are maps between finite-dimensional spaces -- | SpMatrixes are sparse containers too, i.e. any specific -- component may be missing (so it is assumed to be 0) -- | `zeroSM m n` : Empty SpMatrix of size (m, n) zeroSM :: Rows -> Cols -> SpMatrix a mkDiagonal :: Int -> [a] -> SpMatrix a -- | `eye n` : identity matrix of rank n eye :: Num a => Int -> SpMatrix a -- | Permutation matrix from a (possibly incomplete) list of row swaps -- starting from row 0 e.g. `permutationSM 5 [1,3]` first swaps rows (0, -- 1) and then rows (1, 3) : -- -- permutationSM :: Num a => Int -> [IxRow] -> SpMatrix a -- | Permutation matrix from a (possibly incomplete) list of row pair swaps -- e.g. `permutPairs 5 [(2,4)]` swaps rows 2 and 4 : -- -- permutPairsSM :: Num a => Int -> [(IxRow, IxRow)] -> SpMatrix a -- | `mkSubDiagonal n o xx` creates a square SpMatrix of size n -- with xx on the oth subdiagonal mkSubDiagonal :: Int -> Int -> [a] -> SpMatrix a -- | Insert an element in a preexisting Spmatrix at the specified indices insertSpMatrix :: IxRow -> IxCol -> a -> SpMatrix a -> SpMatrix a -- | Add to existing SpMatrix using data from list (row, col, value) fromListSM' :: Foldable t => t (IxRow, IxCol, a) -> SpMatrix a -> SpMatrix a -- | Create new SpMatrix using data from list (row, col, value) fromListSM :: Foldable t => (Int, Int) -> t (IxRow, IxCol, a) -> SpMatrix a mkSpMR :: Foldable t => (Int, Int) -> t (IxRow, IxCol, Double) -> SpMatrix Double mkSpMC :: Foldable t => (Int, Int) -> t (IxRow, IxCol, Complex Double) -> SpMatrix (Complex Double) -- | Create new SpMatrix assuming contiguous, 0-based indexing of elements fromListDenseSM :: Int -> [a] -> SpMatrix a -- | Populate list with SpMatrix contents toListSM :: SpMatrix t -> [(IxRow, IxCol, t)] -- | Populate list with SpMatrix contents and populate missing entries with -- 0 toDenseListSM :: Num t => SpMatrix t -> [(IxRow, IxCol, t)] lookupSM :: SpMatrix a -> IxRow -> IxCol -> Maybe a -- | Looks up an element in the matrix with a default (if the element is -- not found, zero is returned) lookupWD_SM :: Num a => SpMatrix a -> (IxRow, IxCol) -> a -- | Zero-default lookup, infix form (no bound checking) -- -- Looks up an element in the matrix with a default (if the element is -- not found, zero is returned) (@@!) :: Num a => SpMatrix a -> (IxRow, IxCol) -> a -- | Indexed filtering function filterSM :: (Key -> Key -> a -> Bool) -> SpMatrix a -> SpMatrix a -- | Diagonal, subdiagonal, superdiagonal partitions of a SpMatrix (useful -- for writing preconditioners) extractDiag :: SpMatrix a -> SpMatrix a -- | Diagonal, subdiagonal, superdiagonal partitions of a SpMatrix (useful -- for writing preconditioners) extractSuperDiag :: SpMatrix a -> SpMatrix a -- | Diagonal, subdiagonal, superdiagonal partitions of a SpMatrix (useful -- for writing preconditioners) extractSubDiag :: SpMatrix a -> SpMatrix a -- | Extract a submatrix given the specified index bounds, rebalancing keys -- with the two supplied functions extractSubmatrixSM :: (Key -> Key) -> (Key -> Key) -> SpMatrix a -> (IxRow, IxRow) -> (IxCol, IxCol) -> SpMatrix a -- | Extract a submatrix given the specified index bounds NB : subtracts -- (i1, j1) from the indices extractSubmatrixRebalanceKeys :: SpMatrix a -> (IxRow, IxRow) -> (IxCol, IxCol) -> SpMatrix a -- | Extract a submatrix given the specified index bounds NB : submatrix -- indices are _preserved_ extractSubmatrix :: SpMatrix a -> (IxRow, IxRow) -> (IxCol, IxCol) -> SpMatrix a takeRows :: IxRow -> SpMatrix a -> SpMatrix a takeCols :: IxCol -> SpMatrix a -> SpMatrix a -- | Extract whole column extractColSM :: SpMatrix a -> IxCol -> SpMatrix a -- | Extract column within a row range extractSubColSM :: SpMatrix a -> IxCol -> (IxRow, IxRow) -> SpMatrix a -- | Extract column within a row range, rebalance keys extractSubColSM_RK :: SpMatrix a -> IxCol -> (IxRow, IxRow) -> SpMatrix a -- | Are the supplied indices within matrix bounds? isValidIxSM :: SpMatrix a -> (Int, Int) -> Bool -- | Is the matrix square? isSquareSM :: SpMatrix a -> Bool -- | Is the matrix diagonal? isDiagonalSM :: SpMatrix a -> Bool -- | Is the matrix lower/upper triangular? isLowerTriSM :: Eq a => SpMatrix a -> Bool -- | Is the matrix lower/upper triangular? isUpperTriSM :: Eq a => SpMatrix a -> Bool isOrthogonalSM :: (Epsilon a, Eq a, MatrixRing (SpMatrix a)) => SpMatrix a -> Bool -- | Data in internal representation (do not export) immSM :: SpMatrix t -- -> IM.IntMap (IM.IntMap t) immSM :: SpMatrix t -> IntM (IntM t) -- | (Number of rows, Number of columns) dimSM :: SpMatrix t -> (Rows, Cols) -- | Number of rows times number of columns nelSM :: SpMatrix t -> Int -- | Number of rows nrows :: SpMatrix a -> Rows -- | Number of columns ncols :: SpMatrix a -> Cols data SMInfo SMInfo :: Int -> Double -> SMInfo [smNz] :: SMInfo -> Int [smSpy] :: SMInfo -> Double infoSM :: SpMatrix a -> SMInfo nzSM :: SpMatrix a -> Int spySM :: Fractional b => SpMatrix a -> b nzRow :: SpMatrix a -> Key -> Int bwMinSM :: SpMatrix a -> Int bwMaxSM :: SpMatrix a -> Int bwBoundsSM :: SpMatrix a -> (Int, Int) -- | Vertical stacking vertStackSM :: SpMatrix a -> SpMatrix a -> SpMatrix a -- | Vertical stacking (-=-) :: SpMatrix a -> SpMatrix a -> SpMatrix a -- | Horizontal stacking horizStackSM :: SpMatrix a -> SpMatrix a -> SpMatrix a -- | Horizontal stacking (-||-) :: SpMatrix a -> SpMatrix a -> SpMatrix a -- | Assembles a square matrix from a list of square matrices, arranging -- these along the main diagonal fromBlocksDiag :: [SpMatrix a] -> SpMatrix a -- | Indexed filter over SpMatrix ifilterSM :: (Key -> Key -> a -> Bool) -> SpMatrix a -> SpMatrix a -- | Left fold over SpMatrix foldlSM :: (a -> b -> b) -> b -> SpMatrix a -> b -- | Indexed left fold over SpMatrix ifoldlSM :: (Key -> Key -> a -> b -> b) -> b -> SpMatrix a -> b -- | Count sub-diagonal nonzeros countSubdiagonalNZSM :: SpMatrix a -> Int -- | Filter the index subset that lies below the diagonal (used in the QR -- decomposition, for example) subdiagIndicesSM :: SpMatrix a -> [(IxRow, IxCol)] sparsifyIM2 :: Epsilon a => IntM (IntM a) -> IntM (IntM a) -- | Sparsify an SpMatrix sparsifySM :: Epsilon a => SpMatrix a -> SpMatrix a -- | Round almost-0 and almost-1 to 0 and 1 respectively roundZeroOneSM :: Epsilon a => SpMatrix a -> SpMatrix a -- | Modify (row, column) keys, leaving data intact. Be careful when using -- this! modifyKeysSM' :: (IxRow -> IxRow) -> (IxCol -> IxCol) -- -> SpMatrix a -> SpMatrix a modifyKeysSM' :: (IxRow -> a) -> (IxCol -> b) -> SpMatrix c -> [(a, b, c)] modifyKeysSM :: (IxRow -> IxRow) -> (IxCol -> IxCol) -> SpMatrix a -> SpMatrix a -- | Swap two rows of a SpMatrix (bounds not checked) swapRows :: IxRow -> IxRow -> SpMatrix a -> SpMatrix a -- | Swap two rows of a SpMatrix (bounds checked) swapRowsSafe :: IxRow -> IxRow -> SpMatrix a -> SpMatrix a -- | transposeSM : Matrix transpose transposeSM :: SpMatrix a -> SpMatrix a -- | Hermitian conjugate hermitianConj :: Num a => SpMatrix (Complex a) -> SpMatrix (Complex a) matScale :: Num a => a -> SpMatrix a -> SpMatrix a trace :: Num b => SpMatrix b -> b normFrobeniusSM :: (MatrixRing (SpMatrix a), Floating a) => SpMatrix a -> a normFrobeniusSMC :: (MatrixRing (SpMatrix (Complex a)), RealFloat a) => SpMatrix (Complex a) -> a -- | Internal implementation data MatProd_ AB :: MatProd_ ABt :: MatProd_ matMat_ :: Num a => MatProd_ -> SpMatrix a -> SpMatrix a -> SpMatrix a -- | Matrix product without dimension checks matMatUnsafeWith :: Num a => (IntM (IntM a1) -> IntM (IntM a)) -> SpMatrix a -> SpMatrix a1 -> SpMatrix a -- | Removes all elements x for which `| x | <= eps`) matMatSparsified :: (MatrixRing (SpMatrix a), Epsilon a) => SpMatrix a -> SpMatrix a -> SpMatrix a -- | Removes all elements x for which `| x | <= eps`) (#~#) :: (MatrixRing (SpMatrix a), Epsilon a) => SpMatrix a -> SpMatrix a -> SpMatrix a -- | A^T B (#~#^) :: (MatrixRing (SpMatrix a), Epsilon a) => SpMatrix a -> SpMatrix a -> SpMatrix a -- | A B^T (#~^#) :: (MatrixRing (SpMatrix a), Epsilon a) => SpMatrix a -> SpMatrix a -> SpMatrix a -- | Contract row i of A with column j of B up to an -- index n, i.e. summing over repeated indices: Aij Bjk , for j -- in [0 .. n] contractSub :: Elt a => SpMatrix a -> SpMatrix a -> IxRow -> IxCol -> Int -> a instance GHC.Show.Show Data.Sparse.SpMatrix.MatProd_ instance GHC.Classes.Eq Data.Sparse.SpMatrix.MatProd_ instance GHC.Show.Show Data.Sparse.SpMatrix.SMInfo instance GHC.Classes.Eq Data.Sparse.SpMatrix.SMInfo instance Data.Foldable.Foldable Data.Sparse.SpMatrix.SpMatrix instance GHC.Base.Functor Data.Sparse.SpMatrix.SpMatrix instance GHC.Classes.Eq a => GHC.Classes.Eq (Data.Sparse.SpMatrix.SpMatrix a) instance GHC.Show.Show a => GHC.Show.Show (Data.Sparse.SpMatrix.SpMatrix a) instance Numeric.LinearAlgebra.Class.Set Data.Sparse.SpMatrix.SpMatrix instance GHC.Num.Num a => Data.AdditiveGroup.AdditiveGroup (Data.Sparse.SpMatrix.SpMatrix a) instance Numeric.LinearAlgebra.Class.FiniteDim Data.Sparse.SpMatrix.SpMatrix instance Numeric.LinearAlgebra.Class.HasData Data.Sparse.SpMatrix.SpMatrix a instance Numeric.LinearAlgebra.Class.Sparse Data.Sparse.SpMatrix.SpMatrix a instance GHC.Num.Num a => Numeric.LinearAlgebra.Class.SpContainer Data.Sparse.SpMatrix.SpMatrix a instance Numeric.LinearAlgebra.Class.MatrixRing (Data.Sparse.SpMatrix.SpMatrix GHC.Types.Double) instance Numeric.LinearAlgebra.Class.MatrixRing (Data.Sparse.SpMatrix.SpMatrix (Data.Complex.Complex GHC.Types.Double)) module Data.Sparse.Common -- | Insert row , using the provided row index transformation function insertRowWith :: (IxCol -> IxCol) -> SpMatrix a -> SpVector a -> Key -> SpMatrix a -- | Insert row insertRow :: SpMatrix a -> SpVector a -> Key -> SpMatrix a -- | Insert column, using the provided row index transformation function insertColWith :: (IxRow -> IxRow) -> SpMatrix a -> SpVector a -> IxCol -> SpMatrix a -- | Insert column insertCol :: SpMatrix a -> SpVector a -> IxCol -> SpMatrix a -- | Fill the diagonal of a SpMatrix with the components of a SpVector diagonalSM :: SpVector a -> SpMatrix a -- | Outer product (all-with-all matrix) outerProdSV :: Num a => SpVector a -> SpVector a -> SpMatrix a -- | Outer product (all-with-all matrix) (><) :: Num a => SpVector a -> SpVector a -> SpMatrix a -- | Demote (n x 1) or (1 x n) SpMatrix to SpVector toSV :: SpMatrix a -> SpVector a -- | promote a SV to SM svToSM :: SpVector a -> SpMatrix a -- | Lookup a row in a SpMatrix; returns an SpVector with the row, if this -- is non-empty lookupRowSM :: SpMatrix a -> IxRow -> Maybe (SpVector a) -- | Extract jth column extractCol :: SpMatrix a -> IxCol -> SpVector a -- | Extract ith row extractRow :: SpMatrix a -> IxRow -> SpVector a -- | Generic extraction function extractVectorDenseWith :: Num a => (Int -> (IxRow, IxCol)) -> SpMatrix a -> SpVector a -- | Extract ith row (dense) extractRowDense :: Num a => SpMatrix a -> IxRow -> SpVector a -- | Extract jth column extractColDense :: Num a => SpMatrix a -> IxCol -> SpVector a -- | Extract the diagonal extractDiagDense :: Num a => SpMatrix a -> SpVector a -- | extract row interval (all entries between columns j1 and j2, INCLUDED, -- are returned) extractSubRow :: SpMatrix a -> IxRow -> (IxCol, -- IxCol) -> SpVector a extractSubRow m i (j1, j2) = case lookupRowSM -- m i of Nothing -> zeroSV (ncols m) Just rv -> ifilterSV (j _ -- -> j >= j1 && j <= j2) rv -- -- ", returning in Maybe extractSubRow :: SpMatrix a -> IxRow -> -- (Int, Int) -> Maybe (SpVector a) extractSubRow m i (j1, j2) = -- resizeSV (j2 - j1) . ifilterSV (j _ -> j >= j1 && j -- j2) <$ lookupRowSM m i -- -- Extract an interval of SpVector components, changing accordingly the -- resulting SpVector size. Keys are _not_ rebalanced, i.e. components -- are still labeled according with respect to the source matrix. extractSubRow :: SpMatrix a -> IxRow -> (Int, Int) -> SpVector a -- | extract column interval extractSubCol :: SpMatrix a -> IxCol -> (IxRow, IxRow) -> SpVector a -- | extract row interval, rebalance keys by subtracting lowest one extractSubRow_RK :: SpMatrix a -> IxRow -> (IxCol, IxCol) -> SpVector a -- | extract column interval, rebalance keys by subtracting lowest one extractSubCol_RK :: SpMatrix a -> IxCol -> (IxRow, IxRow) -> SpVector a -- | Pack a V.Vector of SpVectors as columns of an SpMatrix fromCols :: Vector (SpVector a) -> SpMatrix a -- | Pack a list of SpVectors into an SpMatrix fromColsL :: [SpVector a] -> SpMatrix a -- | Unpack an SpMatrix into a list of SpVectors toCols :: SpMatrix a -> [SpVector a] instance Numeric.LinearAlgebra.Class.LinearVectorSpace (Data.Sparse.SpVector.SpVector GHC.Types.Double) instance Numeric.LinearAlgebra.Class.LinearVectorSpace (Data.Sparse.SpVector.SpVector (Data.Complex.Complex GHC.Types.Double)) instance (GHC.Show.Show a, GHC.Num.Num a, Numeric.Eps.Epsilon a) => Data.Sparse.PPrint.PrintDense (Data.Sparse.SpVector.SpVector a) instance (GHC.Show.Show a, GHC.Num.Num a, Numeric.Eps.Epsilon a) => Data.Sparse.PPrint.PrintDense (Data.Sparse.SpMatrix.SpMatrix a) -- | This module exposes the high-level functionality of the library. module Numeric.LinearAlgebra.Sparse -- | Interface method to individual linear solvers linSolve0 :: ((~#) * * (Scalar (SpVector t)) t, (~#) * * (MatrixType (SpVector t)) (SpMatrix t), Show t, Epsilon t, MonadThrow m, MonadIO m, LinearVectorSpace (SpVector t), Typeable * (Magnitude (SpVector t)), Typeable * t, Normed (SpVector t), Elt t) => LinSolveMethod -> SpMatrix t -> SpVector t -> SpVector t -> m (SpVector t) data LinSolveMethod GMRES_ :: LinSolveMethod CGNE_ :: LinSolveMethod BCG_ :: LinSolveMethod CGS_ :: LinSolveMethod BICGSTAB_ :: LinSolveMethod (<\>) :: (LinearSystem v, MonadIO m, MonadThrow m) => MatrixType v -> v -> m v -- | Least-squares approximation of a rectangular system of equaitons. Uses -- \ for the linear solve pinv :: (MatrixType v ~ SpMatrix a, LinearSystem v, Epsilon a, MonadThrow m, MonadIO m) => SpMatrix a -> v -> m v -- | The Jacobi preconditioner is just the reciprocal of the diagonal jacobiPre :: Fractional a => SpMatrix a -> SpMatrix a -- | Used for Incomplete LU : remove entries in m corresponding to -- zero entries in m2 (this is called ILU(0) in the -- preconditioner literature) ilu0 :: (Scalar (SpVector t) ~ t, Elt t, VectorSpace (SpVector t), Epsilon t, MonadThrow m) => SpMatrix t -> m (SpMatrix t, SpMatrix t) -- | Symmetric Successive Over-Relaxation. `mSsor aa omega` : if `omega = -- 1` it returns the symmetric Gauss-Seidel preconditioner. When ω = 1, -- the SOR reduces to Gauss-Seidel; when ω > 1 and ω < 1, it -- corresponds to over-relaxation and under-relaxation, respectively. mSsor :: (MatrixRing (SpMatrix b), Fractional b) => SpMatrix b -> b -> (SpMatrix b, SpMatrix b) -- | Direct solver based on a triangular factorization of the system -- matrix. luSolve :: (Scalar (SpVector t) ~ t, MonadThrow m, Elt t, InnerSpace (SpVector t), Epsilon t) => SpMatrix t -> SpMatrix t -> SpVector t -> m (SpVector t) -- | Forward substitution solver triLowerSolve :: (Scalar (SpVector t) ~ t, Elt t, InnerSpace (SpVector t), Epsilon t, MonadThrow m) => SpMatrix t -> SpVector t -> m (SpVector t) -- | Backward substitution solver triUpperSolve :: (Scalar (SpVector t) ~ t, Elt t, InnerSpace (SpVector t), Epsilon t, MonadThrow m) => SpMatrix t -> SpVector t -> m (SpVector t) -- | `eigsQR n mm` performs n iterations of the QR algorithm on -- matrix mm, and returns a SpVector containing all eigenvalues eigsQR :: (MonadThrow m, MonadIO m, Elt a, Normed (SpVector a), MatrixRing (SpMatrix a), Epsilon a, Typeable (Magnitude (SpVector a)), Typeable a, Show a) => Int -> Bool -> SpMatrix a -> m (SpVector a) -- | `eigsRayleigh n mm` performs n iterations of the Rayleigh -- algorithm on matrix mm and returns the eigenpair closest to -- the initialization. It displays cubic-order convergence, but it also -- requires an educated guess on the initial eigenpair. eigRayleigh :: ((~#) * * (MatrixType b) (SpMatrix (Scalar b)), Show b, Show (Scalar b), Floating (Scalar b), LinearSystem b, MonadIO m, MonadThrow m, Normed b, Typeable * (Magnitude b), Typeable * b, Typeable * (Scalar b)) => Int -> Bool -> (b -> IO ()) -> SpMatrix (Scalar b) -> (b, Scalar b) -> m (b, Scalar b) -- | Given a matrix A, returns a pair of matrices (Q, R) such that Q R = A, -- where Q is orthogonal and R is upper triangular. Applies Givens -- rotation iteratively to zero out sub-diagonal elements. qr :: (Elt a, MatrixRing (SpMatrix a), Epsilon a, MonadThrow m) => SpMatrix a -> m (SpMatrix a, SpMatrix a) -- | Given a matrix A, returns a pair of matrices (L, U) where L is lower -- triangular and U is upper triangular such that L U = A lu :: (Scalar (SpVector t) ~ t, Elt t, VectorSpace (SpVector t), Epsilon t, MonadThrow m) => SpMatrix t -> m (SpMatrix t, SpMatrix t) -- | Given a positive semidefinite matrix A, returns a lower-triangular -- matrix L such that L L^T = A . This is an implementation of the -- Cholesky–Banachiewicz algorithm, i.e. proceeding row by row from the -- upper-left corner. chol :: (Elt a, Epsilon a, MonadThrow m) => SpMatrix a -> m (SpMatrix a) -- | Given a matrix A, a vector b and a positive integer n, this -- procedure finds the basis of an order n Krylov subspace (as -- the columns of matrix Q), along with an upper Hessenberg matrix H, -- such that A = Q^T H Q. At the i`th iteration, it finds (i + 1) -- coefficients (the i`th column of the Hessenberg matrix H) and the (i + -- 1)`th Krylov vector. arnoldi :: (MatrixType (SpVector a) ~ SpMatrix a, V (SpVector a), Scalar (SpVector a) ~ a, Epsilon a, MonadThrow m) => SpMatrix a -> SpVector a -> Int -> m (SpMatrix a, SpMatrix a) -- | Partition a matrix into strictly subdiagonal, diagonal and strictly -- superdiagonal parts diagPartitions :: SpMatrix a -> (SpMatrix a, SpMatrix a, SpMatrix a) -- | Givens method, row version: choose other row index i' s.t. i' is : * -- below the diagonal * corresponding element is nonzero -- -- QR.C1 ) To zero out entry A(i, j) we must find row k such that A(k, j) -- is non-zero but A has zeros in row k for all columns less than j. -- -- NB: the current version is quite inefficient in that: 1. the Givens' -- matrix G_i is different from Identity only in 4 entries 2. at -- each iteration i we multiply G_i by the previous -- partial result M. Since this corresponds to a rotation, and -- the givensCoef function already computes the value of the -- resulting non-zero component (output r), `G_i ## M` can be -- simplified by just changing two entries of M (i.e. zeroing -- one out and changing the other into r). givens :: (Elt a, MonadThrow m) => SpMatrix a -> Int -> Int -> m (SpMatrix a) -- | uses the R matrix from the QR factorization conditionNumberSM :: (MonadThrow m, MatrixRing (SpMatrix a), Num' a, Typeable a) => SpMatrix a -> m a hhMat :: Num a => a -> SpVector a -> SpMatrix a -- | Householder reflection: a vector x uniquely defines an -- orthogonal plane; the Householder operator reflects any point -- v with respect to this plane: v' = (I - 2 x >< x) v hhRefl :: Num a => SpVector a -> SpMatrix a fromListSV :: Foldable t => Int -> t (Int, a) -> SpVector a toListSV :: SpVector a -> [(Key, a)] -- | Create new SpMatrix using data from list (row, col, value) fromListSM :: Foldable t => (Int, Int) -> t (IxRow, IxCol, a) -> SpMatrix a -- | Populate list with SpMatrix contents toListSM :: SpMatrix t -> [(IxRow, IxCol, t)] -- | untilConvergedG0 is a special case of untilConvergedG -- that assesses convergence based on the L2 distance to a known solution -- xKnown untilConvergedG0 :: (Normed v, MonadThrow m, MonadIO m, Typeable (Magnitude v), Typeable s, Show s) => String -> IterationConfig s v -> v -> (s -> s) -> s -> m s -- | This function makes some default choices on the -- modifyInspectGuarded machinery: convergence is assessed using -- the squared L2 distance between consecutive states, and divergence is -- detected when this function is increasing between pairs of -- measurements. untilConvergedG :: (Normed v, MonadThrow m, MonadIO m, Typeable (Magnitude v), Typeable s, Show s) => String -> IterationConfig s v -> (v -> Bool) -> (s -> s) -> s -> m s -- | ", monadic version untilConvergedGM :: (Normed v, MonadThrow m, MonadIO m, Typeable (Magnitude v), Typeable s, Show s) => String -> IterationConfig s v -> (v -> Bool) -> (s -> m s) -> s -> m s -- | modifyInspectGuarded is a high-order abstraction of a numerical -- iterative process. It accumulates a rolling window of 3 states and -- compares a summary q of the latest 2 with that of the -- previous two in order to assess divergence (e.g. if `q latest2 > q -- prev2` then it). The process ends when either we hit an iteration -- budget or relative convergence is verified. The function then assesses -- the final state with a predicate qfinal (e.g. against a known -- solution; if this is not known, the user can just supply `const True`) modifyInspectGuarded :: (MonadThrow m, MonadIO m, Typeable s, Typeable a, Show s, Show a) => String -> IterationConfig s v -> ([v] -> a) -> (a -> Bool) -> (a -> a -> Bool) -> (v -> Bool) -> (s -> s) -> s -> m s -- | ", monadic version modifyInspectGuardedM :: (MonadThrow m, MonadIO m, Typeable s, Show s, Typeable a, Show a) => String -> IterationConfig s v -> ([v] -> a) -> (a -> Bool) -> (a -> a -> Bool) -> (v -> Bool) -> (s -> m s) -> s -> m s data IterationConfig a b IterConf :: Int -> Bool -> (a -> b) -> (b -> IO ()) -> IterationConfig a b [numIterationsMax] :: IterationConfig a b -> Int [printDebugInfo] :: IterationConfig a b -> Bool [iterationView] :: IterationConfig a b -> a -> b [printDebugIO] :: IterationConfig a b -> b -> IO () modifyUntil :: MonadState s m => (s -> Bool) -> (s -> s) -> m s modifyUntilM :: MonadState s m => (s -> Bool) -> (s -> m s) -> m s instance GHC.Show.Show Numeric.LinearAlgebra.Sparse.LinSolveMethod instance GHC.Classes.Eq Numeric.LinearAlgebra.Sparse.LinSolveMethod instance GHC.Classes.Eq a => GHC.Classes.Eq (Numeric.LinearAlgebra.Sparse.BICGSTAB a) instance GHC.Classes.Eq a => GHC.Classes.Eq (Numeric.LinearAlgebra.Sparse.CGS a) instance GHC.Classes.Eq a => GHC.Classes.Eq (Numeric.LinearAlgebra.Sparse.BCG a) instance GHC.Classes.Eq a => GHC.Classes.Eq (Numeric.LinearAlgebra.Sparse.CGNE a) instance GHC.Show.Show a => GHC.Show.Show (Numeric.LinearAlgebra.Sparse.CGNE a) instance GHC.Show.Show a => GHC.Show.Show (Numeric.LinearAlgebra.Sparse.BCG a) instance GHC.Show.Show a => GHC.Show.Show (Numeric.LinearAlgebra.Sparse.CGS a) instance GHC.Show.Show a => GHC.Show.Show (Numeric.LinearAlgebra.Sparse.BICGSTAB a) instance Numeric.LinearAlgebra.Class.LinearSystem (Data.Sparse.SpVector.SpVector GHC.Types.Double) instance Numeric.LinearAlgebra.Class.LinearSystem (Data.Sparse.SpVector.SpVector (Data.Complex.Complex GHC.Types.Double))