accelerate-typelits-0.1.0.0: a typesafe way encode accelerate matrices and vectors

Safe HaskellNone
LanguageHaskell2010

Data.Array.Accelerate.TypeLits

Contents

Synopsis

Types

data AccVector dim a Source

A typesafe way to represent an AccVector and its dimension

Instances

(Serial mm a, KnownNat n, Eq a, Elt a) => Serial mm (AccVector n a) Source 
KnownNat n => AccFunctor (AccVector n) Source 
(KnownNat n, Eq a, Elt a) => Eq (AccVector n a) Source 
Elt a => Show (AccVector dim a) Source 
(KnownNat n, Arbitrary a, Eq a, Elt a) => Arbitrary (AccVector n a) Source 

data AccMatrix rows cols a Source

A typesafe way to represent an AccMatrix and its rows/colums

Instances

(Serial mm a, KnownNat m, KnownNat n, Eq a, Elt a) => Serial mm (AccMatrix m n a) Source 
(KnownNat m, KnownNat n) => AccFunctor (AccMatrix m n) Source 
(KnownNat m, KnownNat n, Eq a, Elt a) => Eq (AccMatrix m n a) Source 
Elt a => Show (AccMatrix rows cols a) Source 
(KnownNat m, KnownNat n, Arbitrary a, Eq a, Elt a) => Arbitrary (AccMatrix m n a) Source 

Classes

class AccFunctor f where Source

a functor like instance for a functor like instance for Accelerate computations instead of working with simple functions `(a -> b)` this uses (Exp a -> Exp b)

Methods

afmap :: forall a b. (Elt a, Elt b) => (Exp a -> Exp b) -> f a -> f b Source

Constructors

mkMatrix :: forall m n a. (KnownNat m, KnownNat n, Elt a) => [a] -> Maybe (AccMatrix m n a) Source

a smart constructor to generate Matrices - returning Nothing if the input list is not as long as the "length" of the Matrix, i.e. rows*colums

mkVector :: forall n a. (KnownNat n, Elt a) => [a] -> Maybe (AccVector n a) Source

a smart constructor to generate Vectors - returning Nothing if the input list is not as long as the dimension of the Vector

mkScalar :: forall a. Elt a => Exp a -> AccScalar a Source

a smart constructor to generate scalars

unsafeMkMatrix :: forall m n a. (KnownNat m, KnownNat n, Elt a) => [a] -> AccMatrix m n a Source

unsafe smart constructor to generate Matrices the length of the input list is not checked

unsafeMkVector :: forall n a. (KnownNat n, Elt a) => [a] -> AccVector n a Source

unsafe smart constructor to generate Vectors the length of the input list is not checked

unMatrix :: AccMatrix rows cols a -> Acc (Array DIM2 a) Source

identityMatrix :: forall n a. (KnownNat n, IsNum a, Elt a) => AccMatrix n n a Source

constructor for the nxn dimensional identity matrix, given by

⎛  1  0  …  0  0  ⎞
⎜  0  1  …  0  0  ⎟
⎜  .    .      .  ⎟
⎜  .     .     .  ⎟
⎜  .      .    .  ⎟
⎜  0  0  …  1  0  ⎟
⎝  0  0  …  0  1  ⎠

zeroV :: forall n a. (KnownNat n, IsNum a, Elt a) => AccVector n a Source

constructor for the n dimensional zero vector, given by

⎛ 0 ⎞
⎜ . ⎟
⎜ . ⎟
⎜ . ⎟
⎜ . ⎟
⎜ . ⎟
⎝ 0 ⎠

zeroM :: forall m n a. (KnownNat m, KnownNat n, IsNum a, Elt a) => AccMatrix m n a Source

constructor for the mxn dimensional zero matrix, given by

⎛  0  0  …  0  0  ⎞
⎜  0  0  …  0  0  ⎟
⎜  .  .     .  .  ⎟
⎜  0  0  …  0  0  ⎟
⎝  0  0  …  0  0  ⎠

Functions

Scalar & X

(.*^) :: forall n a. (KnownNat n, IsNum a, Elt a) => Exp a -> AccVector n a -> AccVector n a infixl 7 Source

the usual multiplication of a scalar with a vector

    ⎛x₁⎞   ⎛ a*x₁ ⎞
    ⎜x₂⎟   ⎜ a*x₂ ⎟
    ⎜. ⎟   ⎜  .   ⎟
a • ⎜. ⎟ = ⎜  .   ⎟
    ⎜. ⎟   ⎜  .   ⎟
    ⎜. ⎟   ⎜  .   ⎟
    ⎝xₙ⎠   ⎝ a*xₙ ⎠

(./^) :: forall n a. (KnownNat n, IsFloating a, Elt a) => Exp a -> AccVector n a -> AccVector n a infixl 7 Source

a convenient helper deviding every element of a vector

    ⎛x₁⎞   ⎛ x₁/a ⎞
    ⎜x₂⎟   ⎜ x₂/a ⎟
    ⎜. ⎟   ⎜  .   ⎟
a / ⎜. ⎟ = ⎜  .   ⎟
    ⎜. ⎟   ⎜  .   ⎟
    ⎜. ⎟   ⎜  .   ⎟
    ⎝xₙ⎠   ⎝ xₙ/a ⎠

(.*#) :: forall m n a. (KnownNat m, KnownNat n, IsNum a, Elt a) => Exp a -> AccMatrix m n a -> AccMatrix m n a infixl 7 Source

the usual multiplication of a scalar with a matrix

    ⎛ w₁₁ w₁₂ … w₁ₙ ⎞    ⎛ a*w₁₁ a*w₁₂ … a*w₁ₙ ⎞
    ⎜ w₂₁ w₂₂ … w₂ₙ ⎟    ⎜ a*w₂₁ a*w₂₂ … a*w₂ₙ ⎟
    ⎜  .   .     .  ⎟    ⎜  .      .      .    ⎟
a • ⎜  .   .     .  ⎟ =  ⎜  .      .      .    ⎟
    ⎜  .   .     .  ⎟    ⎜  .      .      .    ⎟
    ⎜  .   .     .  ⎟    ⎜  .      .      .    ⎟
    ⎝ wₘ₁ wₘ₂ … wₘₙ ⎠    ⎝ a*wₘ₁ a*wₘ₂ … a*wₘₙ ⎠

(./#) :: forall m n a. (KnownNat m, KnownNat n, IsFloating a, Elt a) => Exp a -> AccMatrix m n a -> AccMatrix m n a infixl 7 Source

a convenient helper deviding every element of a matrix

    ⎛ w₁₁ w₁₂ … w₁ₙ ⎞    ⎛ w₁₁/a w₁₂/a … w₁ₙ/a ⎞
    ⎜ w₂₁ w₂₂ … w₂ₙ ⎟    ⎜ w₂₁/a w₂₂/a … w₂ₙ/a ⎟
    ⎜  .   .     .  ⎟    ⎜  .      .      .    ⎟
a / ⎜  .   .     .  ⎟ =  ⎜  .      .      .    ⎟
    ⎜  .   .     .  ⎟    ⎜  .      .      .    ⎟
    ⎜  .   .     .  ⎟    ⎜  .      .      .    ⎟
    ⎝ wₘ₁ wₘ₂ … wₘₙ ⎠    ⎝ wₘ₁/a wₘ₂/a … wₘₙ/a ⎠

AccMatrix & Vector

(#*^) :: forall m n a. (KnownNat m, KnownNat n, IsNum a, Elt a) => AccMatrix m n a -> AccVector n a -> AccVector n a infixl 7 Source

the usual matrix-vector product

⎛ w₁₁ w₁₂ … w₁ₙ ⎞   ⎛x₁⎞   ⎛ w₁₁*x₁ + w₁₂*x₂ + … w₁ₙ*xₙ ⎞
⎜ w₂₁ w₂₂ … w₂ₙ ⎟   ⎜x₂⎟   ⎜ w₂₁*x₁ + w₂₂*x₂ + … w₂ₙ*xₙ ⎟
⎜  .   .     .  ⎟   ⎜. ⎟   ⎜  .          .          .   ⎟
⎜  .   .     .  ⎟ ✕ ⎜. ⎟ = ⎜  .          .          .   ⎟
⎜  .   .     .  ⎟   ⎜. ⎟   ⎜  .          .          .   ⎟
⎜  .   .     .  ⎟   ⎜. ⎟   ⎜  .          .          .   ⎟
⎝ wₘ₁ wₘ₂ … wₘₙ ⎠   ⎝xₙ⎠   ⎝ wₘ₁*x₁ + wₘ₂*x₂ + … wₘₙ*xₙ ⎠

(^*#) :: forall m n a. (KnownNat m, KnownNat n, IsNum a, Elt a) => AccVector m a -> AccMatrix m n a -> AccVector n a infixr 7 Source

the usual vector-matrix product

⎛x₁⎞T  ⎛w₁₁ w₁₂ … w₁ₙ ⎞   ⎛ x₁*w₁₁ + x₂*w₁₂ + … xₙ*w₁ₙ ⎞
⎜x₂⎟   ⎜w₂₁ w₂₂ … w₂ₙ ⎟   ⎜ x₁*w₂₁ + x₂*w₂₂ + … xₙ*w₂ₙ ⎟
⎜. ⎟   ⎜ .   .     .  ⎟   ⎜  .         .           .   ⎟
⎜. ⎟ ✕ ⎜ .   .     .  ⎟ = ⎜  .         .           .   ⎟
⎜. ⎟   ⎜ .   .     .  ⎟   ⎜  .         .           .   ⎟
⎜. ⎟   ⎜ .   .     .  ⎟   ⎜  .         .           .   ⎟
⎝xₘ⎠   ⎝wₘ₁ wₘ₂ … wₘₙ ⎠   ⎝ x₁*wₘ₁ + x₂*wₘ₂ + … xₙ*wₘₙ ⎠

AccVector & Vector

(^+^) :: forall n a. (KnownNat n, IsNum a, Elt a) => AccVector n a -> AccVector n a -> AccVector n a infixl 6 Source

the usual vector addition

⎛v₁⎞   ⎛w₁⎞   ⎛ v₁+w₁ ⎞
⎜v₂⎟   ⎜w₂⎟   ⎜ v₂+w₁ ⎟
⎜. ⎟   ⎜. ⎟   ⎜   .   ⎟
⎜. ⎟ + ⎜. ⎟ = ⎜   .   ⎟
⎜. ⎟   ⎜. ⎟   ⎜   .   ⎟
⎜. ⎟   ⎜. ⎟   ⎜   .   ⎟
⎝vₙ⎠   ⎝wₙ⎠   ⎝ vₙ+wₙ ⎠

(^-^) :: forall n a. (KnownNat n, IsNum a, Elt a) => AccVector n a -> AccVector n a -> AccVector n a infixl 6 Source

the usual vector subtraction

⎛v₁⎞   ⎛w₁⎞   ⎛ v₁-w₁ ⎞
⎜v₂⎟   ⎜w₂⎟   ⎜ v₂-w₁ ⎟
⎜. ⎟   ⎜. ⎟   ⎜   .   ⎟
⎜. ⎟ - ⎜. ⎟ = ⎜   .   ⎟
⎜. ⎟   ⎜. ⎟   ⎜   .   ⎟
⎜. ⎟   ⎜. ⎟   ⎜   .   ⎟
⎝vₙ⎠   ⎝wₙ⎠   ⎝ vₙ-wₙ ⎠

(^*^) :: forall n a. (KnownNat n, IsNum a, Elt a) => AccVector n a -> AccVector n a -> AccScalar a infixl 7 Source

the usual inner product of two vectors

⎛v₁⎞   ⎛w₁⎞
⎜v₂⎟   ⎜w₂⎟
⎜. ⎟   ⎜. ⎟
⎜. ⎟ * ⎜. ⎟ = v₁*w₁ + v₂*w₁ + … + vₙ*wₙ
⎜. ⎟   ⎜. ⎟
⎜. ⎟   ⎜. ⎟
⎝vₙ⎠   ⎝wₙ⎠

AccMatrix & Matrix

(#+#) :: forall m n a. (KnownNat m, KnownNat n, IsNum a, Elt a) => AccMatrix m n a -> AccMatrix m n a -> AccMatrix m n a infixl 6 Source

the usual matrix addition/subtraction

⎛ v₁₁ v₁₂ … v₁ₙ ⎞     ⎛ w₁₁ w₁₂ … w₁ₙ ⎞     ⎛ v₁₁+w₁₁ v₁₂+w₁₂ … v₁ₙ+w₁ₙ ⎞
⎜ v₂₁ v₂₂ … v₂ₙ ⎟     ⎜ w₂₁ w₂₂ … w₂ₙ ⎟     ⎜ v₂₁+w₂₁ v₂₂+w₂₂ … v₂ₙ+w₂ₙ ⎟
⎜  .   .     .  ⎟     ⎜  .   .     .  ⎟     ⎜    .       .         .    ⎟
⎜  .   .     .  ⎟  +  ⎜  .   .     .  ⎟  =  ⎜    .       .         .    ⎟
⎜  .   .     .  ⎟     ⎜  .   .     .  ⎟     ⎜    .       .         .    ⎟
⎜  .   .     .  ⎟     ⎜  .   .     .  ⎟     ⎜    .       .         .    ⎟
⎝ vₘ₁ vₘ₂ … vₘₙ ⎠     ⎝ wₘ₁ wₘ₂ … wₘₙ ⎠     ⎝ vₘ₁+wₘ₁ wₘ₂+vₘ₂ … vₘₙ+wₘₙ ⎠

(#-#) :: forall m n a. (KnownNat m, KnownNat n, IsNum a, Elt a) => AccMatrix m n a -> AccMatrix m n a -> AccMatrix m n a infixl 6 Source

the usual matrix addition/subtraction

⎛ v₁₁ v₁₂ … v₁ₙ ⎞     ⎛ w₁₁ w₁₂ … w₁ₙ ⎞     ⎛ v₁₁+w₁₁ v₁₂+w₁₂ … v₁ₙ+w₁ₙ ⎞
⎜ v₂₁ v₂₂ … v₂ₙ ⎟     ⎜ w₂₁ w₂₂ … w₂ₙ ⎟     ⎜ v₂₁+w₂₁ v₂₂+w₂₂ … v₂ₙ+w₂ₙ ⎟
⎜  .   .     .  ⎟     ⎜  .   .     .  ⎟     ⎜    .       .         .    ⎟
⎜  .   .     .  ⎟  +  ⎜  .   .     .  ⎟  =  ⎜    .       .         .    ⎟
⎜  .   .     .  ⎟     ⎜  .   .     .  ⎟     ⎜    .       .         .    ⎟
⎜  .   .     .  ⎟     ⎜  .   .     .  ⎟     ⎜    .       .         .    ⎟
⎝ vₘ₁ vₘ₂ … vₘₙ ⎠     ⎝ wₘ₁ wₘ₂ … wₘₙ ⎠     ⎝ vₘ₁+wₘ₁ wₘ₂+vₘ₂ … vₘₙ+wₘₙ ⎠

(#*#) :: forall k m n a. (KnownNat k, KnownNat m, KnownNat n, IsNum a, Elt a) => AccMatrix k m a -> AccMatrix m n a -> AccMatrix k n a infixl 7 Source

the usual matrix multiplication

⎛ v₁₁ v₁₂ … v₁ₘ ⎞     ⎛ w₁₁ w₁₂ … w₁ₙ ⎞     ⎛ (v₁₁*w₁₁+v₁₂*w₂₁+…+v₁ₘ*wₘ₁) . . . (v₁₁*w₁ₙ+v₁₂*w₂ₙ+…+v₁ₘ*wₘₙ) ⎞
⎜ v₂₁ v₂₂ … v₂ₘ ⎟     ⎜ w₂₁ w₂₂ … w₂ₙ ⎟     ⎜            .                                  .               ⎟
⎜  .   .     .  ⎟     ⎜  .   .     .  ⎟     ⎜            .                                  .               ⎟
⎜  .   .     .  ⎟  *  ⎜  .   .     .  ⎟  =  ⎜            .                                  .               ⎟
⎜  .   .     .  ⎟     ⎜  .   .     .  ⎟     ⎜            .                                  .               ⎟
⎜  .   .     .  ⎟     ⎜  .   .     .  ⎟     ⎜            .                                  .               ⎟
⎝ vₖ₁ vₖ₂ … vₖₘ ⎠     ⎝ wₘ₁ wₘ₂ … wₘₙ ⎠     ⎝ (vₖ₁*w₁₁+vₖ₂*w₂₁+…+vₖₘ*wₘ₁) . . . (vₖ₁*w₁ₙ+vₖ₂*w₂ₙ+…+vₖₘ*wₘₙ) ⎠

(#**.) :: forall n a. (KnownNat n, IsNum a, Elt a) => AccMatrix n n a -> Int -> AccMatrix n n a infixr 8 Source

the exponentiation of a square matrix with an Int. Negative exponents raise an error - as inverse matrices are not yet implemented.

⎛ v₁₁ v₁₂ … v₁ₙ ⎞ k
⎜ v₂₁ v₂₂ … v₂ₙ ⎟
⎜  .   .     .  ⎟
⎜  .   .     .  ⎟
⎜  .   .     .  ⎟
⎜  .   .     .  ⎟
⎝ vₙ₁ vₙ₂ … vₙₙ ⎠

Utility functions

transpose :: forall m n a. (KnownNat m, KnownNat n, Elt a) => AccMatrix m n a -> AccMatrix n m a Source

transpose for matrices - note the dimension of the matrix change.

zipWithV :: forall n a b c. (KnownNat n, Elt a, Elt b, Elt c) => (Exp a -> Exp b -> Exp c) -> AccVector n a -> AccVector n b -> AccVector n c Source

the pendant of the usual zipWith function for vectors, but can only be used with the same dimensions for both input

zipWithM :: forall m n a b c. (KnownNat m, KnownNat n, Elt a, Elt b, Elt c) => (Exp a -> Exp b -> Exp c) -> AccMatrix m n a -> AccMatrix m n b -> AccMatrix m n c Source

the pendant of the usual zipWith function for matrices, but can only be used with the same dimensions for both input