Safe Haskell | None |
---|
Generic API for vectors with fixed length.
For encoding of vector size library uses Peano naturals defined in the library. At come point in the future it would make sense to switch to new GHC type level numerals.
- type family Dim v
- data Z
- data S n
- type N1 = S Z
- type N2 = S N1
- type N3 = S N2
- type N4 = S N3
- type N5 = S N4
- type N6 = S N5
- class Arity (Dim v) => Vector v a where
- class (Vector (v n) a, Dim (v n) ~ n) => VectorN v n a
- class Arity n
- newtype Fun n a b = Fun {}
- length :: forall v a. Arity (Dim v) => v a -> Int
- mk0 :: (Vector v a, Dim v ~ Z) => v a
- mk1 :: (Vector v a, Dim v ~ N1) => a -> v a
- mk2 :: (Vector v a, Dim v ~ N2) => a -> a -> v a
- mk3 :: (Vector v a, Dim v ~ N3) => a -> a -> a -> v a
- mk4 :: (Vector v a, Dim v ~ N4) => a -> a -> a -> a -> v a
- mk5 :: (Vector v a, Dim v ~ N5) => a -> a -> a -> a -> a -> v a
- data ContVec n a
- empty :: ContVec Z a
- vector :: (Vector v a, Dim v ~ n) => ContVec n a -> v a
- (<|) :: a -> ContVec n a -> ContVec (S n) a
- class Make n a r
- mkN :: Make (S Z) a r => a -> r
- replicate :: Vector v a => a -> v a
- replicateM :: (Vector v a, Monad m) => m a -> m (v a)
- generate :: Vector v a => (Int -> a) -> v a
- generateM :: (Monad m, Vector v a) => (Int -> m a) -> m (v a)
- unfoldr :: Vector v a => (b -> (a, b)) -> b -> v a
- basis :: (Vector v a, Num a) => Int -> v a
- head :: (Vector v a, Dim v ~ S n) => v a -> a
- tail :: (Vector v a, Vector w a, Dim v ~ S (Dim w)) => v a -> w a
- cons :: (Vector v a, Vector w a, S (Dim v) ~ Dim w) => a -> v a -> w a
- snoc :: (Vector v a, Vector w a, S (Dim v) ~ Dim w) => a -> v a -> w a
- reverse :: Vector v a => v a -> v a
- class Index k n
- (!) :: Vector v a => v a -> Int -> a
- index :: (Vector v a, Index k (Dim v)) => v a -> k -> a
- element :: (Vector v a, Functor f) => Int -> (a -> f a) -> v a -> f (v a)
- elementTy :: (Vector v a, Index k (Dim v), Functor f) => k -> (a -> f a) -> v a -> f (v a)
- eq :: (Vector v a, Eq a) => v a -> v a -> Bool
- ord :: (Vector v a, Ord a) => v a -> v a -> Ordering
- map :: (Vector v a, Vector v b) => (a -> b) -> v a -> v b
- mapM :: (Vector v a, Vector v b, Monad m) => (a -> m b) -> v a -> m (v b)
- mapM_ :: (Vector v a, Monad m) => (a -> m b) -> v a -> m ()
- imap :: (Vector v a, Vector v b) => (Int -> a -> b) -> v a -> v b
- imapM :: (Vector v a, Vector v b, Monad m) => (Int -> a -> m b) -> v a -> m (v b)
- imapM_ :: (Vector v a, Monad m) => (Int -> a -> m b) -> v a -> m ()
- sequence :: (Vector v a, Vector v (m a), Monad m) => v (m a) -> m (v a)
- sequence_ :: (Vector v (m a), Monad m) => v (m a) -> m ()
- sequenceA :: (Vector v a, Vector v (f a), Applicative f) => v (f a) -> f (v a)
- traverse :: (Vector v a, Vector v b, Applicative f) => (a -> f b) -> v a -> f (v b)
- foldl :: Vector v a => (b -> a -> b) -> b -> v a -> b
- foldr :: Vector v a => (a -> b -> b) -> b -> v a -> b
- foldl1 :: (Vector v a, Dim v ~ S n) => (a -> a -> a) -> v a -> a
- fold :: (Vector v m, Monoid m) => v m -> m
- foldMap :: (Vector v a, Monoid m) => (a -> m) -> v a -> m
- ifoldl :: Vector v a => (b -> Int -> a -> b) -> b -> v a -> b
- ifoldr :: Vector v a => (Int -> a -> b -> b) -> b -> v a -> b
- foldM :: (Vector v a, Monad m) => (b -> a -> m b) -> b -> v a -> m b
- ifoldM :: (Vector v a, Monad m) => (b -> Int -> a -> m b) -> b -> v a -> m b
- sum :: (Vector v a, Num a) => v a -> a
- maximum :: (Vector v a, Dim v ~ S n, Ord a) => v a -> a
- minimum :: (Vector v a, Dim v ~ S n, Ord a) => v a -> a
- and :: Vector v Bool => v Bool -> Bool
- or :: Vector v Bool => v Bool -> Bool
- all :: Vector v a => (a -> Bool) -> v a -> Bool
- any :: Vector v a => (a -> Bool) -> v a -> Bool
- zipWith :: (Vector v a, Vector v b, Vector v c) => (a -> b -> c) -> v a -> v b -> v c
- zipWithM :: (Vector v a, Vector v b, Vector v c, Monad m) => (a -> b -> m c) -> v a -> v b -> m (v c)
- izipWith :: (Vector v a, Vector v b, Vector v c) => (Int -> a -> b -> c) -> v a -> v b -> v c
- izipWithM :: (Vector v a, Vector v b, Vector v c, Monad m) => (Int -> a -> b -> m c) -> v a -> v b -> m (v c)
- convert :: (Vector v a, Vector w a, Dim v ~ Dim w) => v a -> w a
- toList :: Vector v a => v a -> [a]
- fromList :: Vector v a => [a] -> v a
- fromList' :: Vector v a => [a] -> v a
- fromListM :: Vector v a => [a] -> Maybe (v a)
- fromFoldable :: (Vector v a, Foldable f) => f a -> Maybe (v a)
- data VecList n a where
- newtype Only a = Only a
- data Empty a = Empty
- type Tuple2 a = (a, a)
- type Tuple3 a = (a, a, a)
- type Tuple4 a = (a, a, a, a)
- type Tuple5 a = (a, a, a, a, a)
Vector type class
Vector size
Successor of n
Synonyms for small numerals
Type class
class Arity (Dim v) => Vector v a whereSource
Type class for vectors with fixed length. Instance should provide two functions: one to create vector and another for vector deconstruction. They must obey following law:
inspect v construct = v
construct :: Fun (Dim v) a (v a)Source
N-ary function for creation of vectors.
inspect :: v a -> Fun (Dim v) a b -> bSource
Deconstruction of vector.
basicIndex :: v a -> Int -> aSource
Optional more efficient implementation of indexing. Shouldn't
be used directly, use !
instead.
RealFloat a => Vector Complex a | |
Vector Empty a | |
Vector Only a | |
~ * b a => Vector ((,) b) a | Note this instance (and other instances for tuples) is
essentially monomorphic in element type. Vector type v of 2
element tuple |
Arity n => Vector (ContVec n) a | |
Arity n => Vector (VecList n) a | |
Arity n => Vector (Vec n) a | |
(Arity n, Prim a) => Vector (Vec n) a | |
Unbox n a => Vector (Vec n) a | |
(Arity n, Storable a) => Vector (Vec n) a | |
(~ * b a, ~ * c a) => Vector ((,,) b c) a | |
(~ * b a, ~ * c a, ~ * d a) => Vector ((,,,) b c d) a | |
(~ * b a, ~ * c a, ~ * d a, ~ * e a) => Vector ((,,,,) b c d e) a | |
(~ * b a, ~ * c a, ~ * d a, ~ * e a, ~ * f a) => Vector ((,,,,,) b c d e f) a | |
(~ * b a, ~ * c a, ~ * d a, ~ * e a, ~ * f a, ~ * g a) => Vector ((,,,,,,) b c d e f g) a |
class (Vector (v n) a, Dim (v n) ~ n) => VectorN v n a Source
Vector parametrized by length. In ideal world it should be:
forall n. (Arity n, Vector (v n) a, Dim (v n) ~ n) => VectorN v a
Alas polymorphic constraints aren't allowed in haskell.
Newtype wrapper which is used to make Fn
injective. It's also a
reader monad.
length :: forall v a. Arity (Dim v) => v a -> IntSource
Length of vector. Function doesn't evaluate its argument.
Constructors
There are several ways to construct fixed vectors except using
their constructor if it's available. For small ones it's possible
to use functions mk1
, mk2
, etc.
>>>
mk3 'a' 'b' 'c' :: (Char,Char,Char)
('a','b','c')
Another option is to create tuple and convert
it to desired
vector type. For example:
v = convert (x,y,z)
It will work on if type of v
is know from elsewhere. Same trick
could be used to pattern match on the vector with opaque
representation using view patterns
function :: Vec N3 Double -> ... function (convert -> (x,y,z)) = ...
Third way is to use variadic function mkN
. It works similarly to
printf
except it produces result of type ContVec
which should be converted to vector of desired type by vector
:
>>>
vector $ mkN 'a' 'b' 'c' :: (Char,Char,Char)
('a','b','c')
Probably most generic way is to cons values to the ContVec
and
convert it vector of desired type using vector
:
>>>
vector $ 'a' <| 'b' <| 'c' <| empty :: (Char,Char,Char)
('a','b','c')
Consing
Vector represented as continuation. Alternative wording: it's Church encoded N-element vector.
Variadic function
Type class for variadic vector constructors.
Functions
replicate :: Vector v a => a -> v aSource
Replicate value n times.
Examples:
>>>
import Data.Vector.Fixed.Boxed (Vec2)
>>>
replicate 1 :: Vec2 Int
fromList [1,1]
>>>
replicate 2 :: (Double,Double,Double)
(2.0,2.0,2.0)
>>>
import Data.Vector.Fixed.Boxed (Vec4)
>>>
replicate "foo" :: Vec4 String
fromList ["foo","foo","foo","foo"]
replicateM :: (Vector v a, Monad m) => m a -> m (v a)Source
Execute monadic action for every element of vector.
Examples:
>>>
import Data.Vector.Fixed.Boxed (Vec2,Vec3)
>>>
replicateM (Just 3) :: Maybe (Vec3 Int)
Just fromList [3,3,3]>>>
replicateM (putStrLn "Hi!") :: IO (Vec2 ())
Hi! Hi! fromList [(),()]
generate :: Vector v a => (Int -> a) -> v aSource
Generate vector from function which maps element's index to its value.
Examples:
>>>
import Data.Vector.Fixed.Unboxed (Vec4)
>>>
generate (^2) :: Vec4 Int
fromList [0,1,4,9]
generateM :: (Monad m, Vector v a) => (Int -> m a) -> m (v a)Source
Generate vector from monadic function which maps element's index to its value.
basis :: (Vector v a, Num a) => Int -> v aSource
Unit vector along Nth axis. If index is larger than vector dimensions returns zero vector.
Examples:
>>>
import Data.Vector.Fixed.Boxed (Vec3)
>>>
basis 0 :: Vec3 Int
fromList [1,0,0]>>>
basis 1 :: Vec3 Int
fromList [0,1,0]>>>
basis 3 :: Vec3 Int
fromList [0,0,0]
Modifying vectors
Transformations
head :: (Vector v a, Dim v ~ S n) => v a -> aSource
First element of vector.
Examples:
>>>
import Data.Vector.Fixed.Boxed (Vec3)
>>>
let x = mk3 1 2 3 :: Vec3 Int
>>>
head x
1
tail :: (Vector v a, Vector w a, Dim v ~ S (Dim w)) => v a -> w aSource
Tail of vector.
Examples:
>>>
import Data.Complex
>>>
tail (1,2,3) :: Complex Double
2.0 :+ 3.0
cons :: (Vector v a, Vector w a, S (Dim v) ~ Dim w) => a -> v a -> w aSource
Cons element to the vector
snoc :: (Vector v a, Vector w a, S (Dim v) ~ Dim w) => a -> v a -> w aSource
Append element to the vector
Indexing & lenses
Type class for indexing of vector when index value is known at compile time.
(!) :: Vector v a => v a -> Int -> aSource
Retrieve vector's element at index. Generic implementation is O(n) but more efficient one is used when possible.
index :: (Vector v a, Index k (Dim v)) => v a -> k -> aSource
Get element from vector at statically known index
element :: (Vector v a, Functor f) => Int -> (a -> f a) -> v a -> f (v a)Source
Twan van Laarhoven's lens for element of vector
elementTy :: (Vector v a, Index k (Dim v), Functor f) => k -> (a -> f a) -> v a -> f (v a)Source
Twan van Laarhoven's lens for element of vector with statically known index.
Comparison
eq :: (Vector v a, Eq a) => v a -> v a -> BoolSource
Test two vectors for equality.
Examples:
>>>
import Data.Vector.Fixed.Boxed (Vec2)
>>>
let v0 = basis 0 :: Vec2 Int
>>>
let v1 = basis 1 :: Vec2 Int
>>>
v0 `eq` v0
True>>>
v0 `eq` v1
False
Maps
mapM :: (Vector v a, Vector v b, Monad m) => (a -> m b) -> v a -> m (v b)Source
Monadic map over vector.
mapM_ :: (Vector v a, Monad m) => (a -> m b) -> v a -> m ()Source
Apply monadic action to each element of vector and ignore result.
imap :: (Vector v a, Vector v b) => (Int -> a -> b) -> v a -> v bSource
Apply function to every element of the vector and its index.
imapM :: (Vector v a, Vector v b, Monad m) => (Int -> a -> m b) -> v a -> m (v b)Source
Apply monadic function to every element of the vector and its index.
imapM_ :: (Vector v a, Monad m) => (Int -> a -> m b) -> v a -> m ()Source
Apply monadic function to every element of the vector and its index and discard result.
sequence :: (Vector v a, Vector v (m a), Monad m) => v (m a) -> m (v a)Source
Evaluate every action in the vector from left to right.
sequence_ :: (Vector v (m a), Monad m) => v (m a) -> m ()Source
Evaluate every action in the vector from left to right and ignore result
sequenceA :: (Vector v a, Vector v (f a), Applicative f) => v (f a) -> f (v a)Source
Analog of sequenceA
from Traversable
.
traverse :: (Vector v a, Vector v b, Applicative f) => (a -> f b) -> v a -> f (v b)Source
Analog of traverse
from Traversable
.
Folding
fold :: (Vector v m, Monoid m) => v m -> mSource
Combine the elements of a structure using a monoid. Similar to
fold
foldMap :: (Vector v a, Monoid m) => (a -> m) -> v a -> mSource
Map each element of the structure to a monoid,
and combine the results. Similar to foldMap
ifoldl :: Vector v a => (b -> Int -> a -> b) -> b -> v a -> bSource
Left fold over vector. Function is applied to each element and its index.
ifoldM :: (Vector v a, Monad m) => (b -> Int -> a -> m b) -> b -> v a -> m bSource
Left monadic fold over vector. Function is applied to each element and its index.
Special folds
maximum :: (Vector v a, Dim v ~ S n, Ord a) => v a -> aSource
Maximal element of vector.
Examples:
>>>
import Data.Vector.Fixed.Boxed (Vec3)
>>>
let x = mk3 1 2 3 :: Vec3 Int
>>>
maximum x
3
minimum :: (Vector v a, Dim v ~ S n, Ord a) => v a -> aSource
Minimal element of vector.
Examples:
>>>
import Data.Vector.Fixed.Boxed (Vec3)
>>>
let x = mk3 1 2 3 :: Vec3 Int
>>>
minimum x
1
all :: Vector v a => (a -> Bool) -> v a -> BoolSource
Determines whether all elements of vector satisfy predicate.
any :: Vector v a => (a -> Bool) -> v a -> BoolSource
Determines whether any of element of vector satisfy predicate.
Zips
zipWith :: (Vector v a, Vector v b, Vector v c) => (a -> b -> c) -> v a -> v b -> v cSource
Zip two vector together using function.
Examples:
>>>
import Data.Vector.Fixed.Boxed (Vec3)
>>>
let b0 = basis 0 :: Vec3 Int
>>>
let b1 = basis 1 :: Vec3 Int
>>>
let b2 = basis 2 :: Vec3 Int
>>>
let vplus x y = zipWith (+) x y
>>>
vplus b0 b1
fromList [1,1,0]>>>
vplus b0 b2
fromList [1,0,1]>>>
vplus b1 b2
fromList [0,1,1]
zipWithM :: (Vector v a, Vector v b, Vector v c, Monad m) => (a -> b -> m c) -> v a -> v b -> m (v c)Source
Zip two vector together using monadic function.
izipWith :: (Vector v a, Vector v b, Vector v c) => (Int -> a -> b -> c) -> v a -> v b -> v cSource
Zip two vector together using function which takes element index as well.
izipWithM :: (Vector v a, Vector v b, Vector v c, Monad m) => (Int -> a -> b -> m c) -> v a -> v b -> m (v c)Source
Zip two vector together using monadic function which takes element index as well..
Conversion
convert :: (Vector v a, Vector w a, Dim v ~ Dim w) => v a -> w aSource
Convert between different vector types
fromList :: Vector v a => [a] -> v aSource
Create vector form list. Will throw error if list is shorter than resulting vector.
fromList' :: Vector v a => [a] -> v aSource
Create vector form list. Will throw error if list has different length from resulting vector.
fromListM :: Vector v a => [a] -> Maybe (v a)Source
Create vector form list. Will return Nothing
if list has different
length from resulting vector.
fromFoldable :: (Vector v a, Foldable f) => f a -> Maybe (v a)Source
Create vector from Foldable
data type. Will return Nothing
if
data type different number of elements that resulting vector.
Data types
Vector based on the lists. Not very useful by itself but is necessary for implementation.
Typeable2 VecList | |
Arity n => VectorN VecList n a | |
Arity n => Functor (VecList n) | |
Arity n => Applicative (VecList n) | |
Arity n => Foldable (VecList n) | |
Arity n => Traversable (VecList n) | |
Arity n => Vector (VecList n) a | |
(Eq a, Arity n) => Eq (VecList n a) | |
(Ord a, Arity n) => Ord (VecList n a) | |
(Show a, Arity n) => Show (VecList n a) |
Single-element tuple.
Only a |
Empty tuple.