| Copyright | (C) 2013 Edward Kmett |
|---|---|
| License | BSD-style (see the file LICENSE) |
| Maintainer | Edward Kmett <ekmett@gmail.com> |
| Stability | experimental |
| Portability | non-portable |
| Safe Haskell | None |
| Language | Haskell98 |
Sparse.Matrix
Description
Sparse Matrices in Morton order
The design of this library is described in the series "Revisiting Matrix Multiplication" on FP Complete's School of Haskell.
https://www.fpcomplete.com/user/edwardk/revisiting-matrix-multiplication/
- data Mat a = Mat !Int !(Vector Word) !(Vector Word) !(Array a)
- data Key = Key !Word !Word
- fromList :: Arrayed a => [(Key, a)] -> Mat a
- singleton :: Arrayed a => Key -> a -> Mat a
- transpose :: Arrayed a => Mat a -> Mat a
- ident :: (Arrayed a, Num a) => Int -> Mat a
- empty :: Arrayed a => Mat a
- size :: Mat a -> Int
- null :: Mat a -> Bool
- class (Arrayed a, Num a) => Eq0 a where
- addWith :: Arrayed a => (a -> a -> a) -> Mat a -> Mat a -> Mat a
- multiplyWith :: Arrayed a => (a -> a -> a) -> (Maybe (Heap a) -> Stream (Key, a)) -> Mat a -> Mat a -> Mat a
- class (Vector (Arr a) a, Monoid (Arr a a)) => Arrayed a where
- type Arr a :: * -> *
- _Mat :: Arrayed a => Iso' (Mat a) (Vector Vector (Arr a) (Key, a))
- keys :: Lens' (Mat a) (Vector Key)
- values :: Lens (Mat a) (Mat b) (Array a) (Array b)
Sparse Matrices
Instances
| (Arrayed a, Eq (Array a)) => Eq (Mat a) | |
| (Arrayed a, Eq0 a) => Num (Mat a) | |
| (Arrayed a, Ord (Array a)) => Ord (Mat a) | |
| (Arrayed a, Read a) => Read (Mat a) | |
| (Arrayed a, Show a) => Show (Mat a) | |
| NFData (Array a) => NFData (Mat a) | |
| Arrayed a => Ixed (Mat a) | |
| Arrayed a => Arrayed (Mat a) | |
| (Arrayed a, Eq0 a) => Eq0 (Mat a) | |
| (Arrayed a, (~) * a b) => Each (Mat a) (Mat b) a b | |
| type Index (Mat a) = Key | |
| type IxValue (Mat a) = a | |
| type Arr (Mat a) = Vector |
Keys
Key i j logically orders the keys as if the bits of the keys i and j
were interleaved. This is equivalent to storing the keys in "Morton Order".
>>>Key 100 200 ^. _1100
>>>Key 100 200 ^. _2200
Instances
| Eq Key | |
| Ord Key | |
| Read Key | |
| Show Key | |
| Unbox Key | |
| Arrayed Key | |
| Vector Vector Key | |
| FunctorWithIndex Key Heap | |
| FoldableWithIndex Key Heap | |
| TraversableWithIndex Key Heap | |
| MVector MVector Key | |
| ((~) * a Word, (~) * b Word) => Field1 Key Key a b | |
| ((~) * a Word, (~) * b Word) => Field2 Key Key a b | |
| data Vector Key = V_Key !Int !(Vector Word) !(Vector Word) | |
| type Arr Key = Vector | |
| data MVector s Key = MV_Key !Int !(MVector s Word) !(MVector s Word) |
Construction
singleton :: Arrayed a => Key -> a -> Mat a Source
singleton makes a matrix with a singleton value at a given location
ident :: (Arrayed a, Num a) => Int -> Mat a Source
ident n makes an n x n identity matrix
>>>ident 4fromList [(Key 0 0,1),(Key 1 1,1),(Key 2 2,1),(Key 3 3,1)]
Consumption
Distinguishable Zero
class (Arrayed a, Num a) => Eq0 a where Source
Minimal complete definition
Nothing
Methods
Return whether or not the element is 0.
It may be okay to never return True, but you won't be
able to thin spurious zeroes introduced into your matrix.
nonZero :: (x -> y -> a) -> x -> y -> Maybe a Source
Remove results that are equal to zero from a simpler function.
When used with addWith or multiplyWith's additive argument
this can help retain the sparsity of the matrix.
addMats :: Mat a -> Mat a -> Mat a Source
Add two matrices. By default this assumes isZero can
possibly return True after an addition. For some
ring-like structures, this doesn't hold. There you can
use:
addMats=addWith(+)
By default this will use
addMats=addWith0$nonZero(+)
addHeap :: Maybe (Heap a) -> Stream (Key, a) Source
Convert from a Heap to a Stream.
If addition of non-zero valus in your ring-like structure cannot yield zero, then you can use
addHeap=streamHeapWith(+)
instead of the default definition:
addHeap=streamHeapWith0$nonZero(+)
Customization
addWith :: Arrayed a => (a -> a -> a) -> Mat a -> Mat a -> Mat a Source
Merge two matrices where the indices coincide into a new matrix. This provides for generalized addition, but where the summation of two non-zero entries is necessarily non-zero.
multiplyWith :: Arrayed a => (a -> a -> a) -> (Maybe (Heap a) -> Stream (Key, a)) -> Mat a -> Mat a -> Mat a Source
Multiply two matrices using the specified multiplication and addition operation.
Storage
class (Vector (Arr a) a, Monoid (Arr a a)) => Arrayed a Source
Instances
| Arrayed Double | |
| Arrayed Float | |
| Arrayed Int | |
| Arrayed Int8 | |
| Arrayed Int16 | |
| Arrayed Int32 | |
| Arrayed Int64 | |
| Arrayed Integer | |
| Arrayed Word | |
| Arrayed Word8 | |
| Arrayed Word16 | |
| Arrayed Word32 | |
| Arrayed Word64 | |
| Arrayed () | |
| Arrayed Key | |
| (Arrayed a, RealFloat a) => Arrayed (Complex a) | |
| Arrayed a => Arrayed (Mat a) | |
| (Arrayed a, Arrayed b) => Arrayed (a, b) |