Copyright | 2014 Edward Kmett Charles Durham [2015..2020] Trevor L. McDonell |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | Trevor L. McDonell <trevor.mcdonell@gmail.com> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
Simple matrix operations for low-dimensional primitives
Synopsis
- (!*!) :: (Functor m, Foldable t, Additive t, Additive n, Num a, Box2 m t a, Box2 t n a, Box2 m n a) => Exp (m (t a)) -> Exp (t (n a)) -> Exp (m (n a))
- (!+!) :: (Additive m, Additive n, Num a, Box2 m n a) => Exp (m (n a)) -> Exp (m (n a)) -> Exp (m (n a))
- (!-!) :: (Additive m, Additive n, Num a, Box2 m n a) => Exp (m (n a)) -> Exp (m (n a)) -> Exp (m (n a))
- (!*) :: (Functor m, Foldable r, Additive r, Num a, Box2 m r a, Box m a) => Exp (m (r a)) -> Exp (r a) -> Exp (m a)
- (*!) :: (Foldable t, Additive f, Additive t, Num a, Box t a, Box f a, Box2 t f a) => Exp (t a) -> Exp (t (f a)) -> Exp (f a)
- (!!*) :: (Functor m, Functor r, Num a, Box2 m r a) => Exp (m (r a)) -> Exp a -> Exp (m (r a))
- (*!!) :: (Functor m, Functor r, Num a, Box2 m r a) => Exp a -> Exp (m (r a)) -> Exp (m (r a))
- (!!/) :: (Functor m, Functor r, Floating a, Box2 m r a) => Exp (m (r a)) -> Exp a -> Exp (m (r a))
- type M22 a = V2 (V2 a)
- type M23 a = V2 (V3 a)
- type M24 a = V2 (V4 a)
- type M32 a = V3 (V2 a)
- type M33 a = V3 (V3 a)
- type M34 a = V3 (V4 a)
- type M42 a = V4 (V2 a)
- type M43 a = V4 (V3 a)
- type M44 a = V4 (V4 a)
- m33_to_m44 :: Num a => Exp (M33 a) -> Exp (M44 a)
- m43_to_m44 :: Num a => Exp (M43 a) -> Exp (M44 a)
- det22 :: Num a => Exp (M22 a) -> Exp a
- det33 :: Num a => Exp (M33 a) -> Exp a
- det44 :: Num a => Exp (M44 a) -> Exp a
- inv22 :: Fractional a => Exp (M22 a) -> Exp (M22 a)
- inv33 :: Fractional a => Exp (M33 a) -> Exp (M33 a)
- inv44 :: Fractional a => Exp (M44 a) -> Exp (M44 a)
- identity :: forall t a. (Traversable t, Applicative t, Num a, Box2 t t a) => Exp (t (t a))
- transpose :: (Distributive g, Functor f, Box2 f g a, Box2 g f a) => Exp (f (g a)) -> Exp (g (f a))
- class Trace m => Trace m where
- fromQuaternion :: forall a. Num a => Exp (Quaternion a) -> Exp (M33 a)
- mkTransformation :: forall a. Num a => Exp (Quaternion a) -> Exp (V3 a) -> Exp (M44 a)
- mkTransformationMat :: Num a => Exp (M33 a) -> Exp (V3 a) -> Exp (M44 a)
Documentation
(!*!) :: (Functor m, Foldable t, Additive t, Additive n, Num a, Box2 m t a, Box2 t n a, Box2 m n a) => Exp (m (t a)) -> Exp (t (n a)) -> Exp (m (n a)) infixl 7 Source #
Matrix product. This can compute any combination of sparse and dense multiplication.
>>>
test $ (V2_ (V3_ 1 2 3) (V3_ 4 5 6) :: Exp (M23 Int)) !*! (V3_ (V2_ 1 2) (V2_ 3 4) (V2_ 4 5) :: Exp (M32 Int))
V2 (V2 19 25) (V2 43 58)
(!+!) :: (Additive m, Additive n, Num a, Box2 m n a) => Exp (m (n a)) -> Exp (m (n a)) -> Exp (m (n a)) infixl 6 Source #
Entry-wise matrix addition.
>>>
test $ (V2_ (V3_ 1 2 3) (V3_ 4 5 6) :: Exp (M23 Int)) !+! (V2_ (V3_ 7 8 9) (V3_ 1 2 3) :: Exp (M23 Int))
V2 (V3 8 10 12) (V3 5 7 9)
(!-!) :: (Additive m, Additive n, Num a, Box2 m n a) => Exp (m (n a)) -> Exp (m (n a)) -> Exp (m (n a)) infixl 6 Source #
Entry-wise matrix subtraction.
>>>
test $ (V2_ (V3_ 1 2 3) (V3_ 4 5 6) :: Exp (M23 Int)) !-! (V2_ (V3_ 7 8 9) (V3_ 1 2 3) :: Exp (M23 Int))
V2 (V3 (-6) (-6) (-6)) (V3 3 3 3)
(!*) :: (Functor m, Foldable r, Additive r, Num a, Box2 m r a, Box m a) => Exp (m (r a)) -> Exp (r a) -> Exp (m a) infixl 7 Source #
Matrix * column vector
>>>
test $ (V2_ (V3_ 1 2 3) (V3_ 4 5 6) :: Exp (M23 Int)) !* (V3_ 7 8 9 :: Exp (V3 Int))
V2 50 122
(*!) :: (Foldable t, Additive f, Additive t, Num a, Box t a, Box f a, Box2 t f a) => Exp (t a) -> Exp (t (f a)) -> Exp (f a) infixl 7 Source #
Row vector * matrix
>>>
test $ (V2_ 1 2 :: Exp (V2 Int)) *! (V2_ (V3_ 3 4 5) (V3_ 6 7 8) :: Exp (M23 Int))
V3 15 18 21
(!!*) :: (Functor m, Functor r, Num a, Box2 m r a) => Exp (m (r a)) -> Exp a -> Exp (m (r a)) infixl 7 Source #
Matrix-scalar product
>>>
test $ (V2_ (V2_ 1 2) (V2_ 3 4) :: Exp (M22 Int)) !!* 5
V2 (V2 5 10) (V2 15 20)
(*!!) :: (Functor m, Functor r, Num a, Box2 m r a) => Exp a -> Exp (m (r a)) -> Exp (m (r a)) infixl 7 Source #
Scalar-matrix product
>>>
test $ 5 *!! (V2_ (V2_ 1 2) (V2_ 3 4) :: Exp (M22 Int))
V2 (V2 5 10) (V2 15 20)
(!!/) :: (Functor m, Functor r, Floating a, Box2 m r a) => Exp (m (r a)) -> Exp a -> Exp (m (r a)) infixl 7 Source #
Matrix-scalar division
m33_to_m44 :: Num a => Exp (M33 a) -> Exp (M44 a) Source #
Convert a 3x3 matrix to a 4x4 matrix extending it with zeros in the new row and column.
m43_to_m44 :: Num a => Exp (M43 a) -> Exp (M44 a) Source #
Convert a 4x3 matrix to a 4x4 matrix, extending it with [ 0 0 0 1 ]
column vector
identity :: forall t a. (Traversable t, Applicative t, Num a, Box2 t t a) => Exp (t (t a)) Source #
The identity matrix for any dimension vector.
>>>
test $ (identity :: Exp (M44 Int))
V4 (V4 1 0 0 0) (V4 0 1 0 0) (V4 0 0 1 0) (V4 0 0 0 1)
>>>
test $ (identity :: Exp (V3 (V3 Int)))
V3 (V3 1 0 0) (V3 0 1 0) (V3 0 0 1)
transpose :: (Distributive g, Functor f, Box2 f g a, Box2 g f a) => Exp (f (g a)) -> Exp (g (f a)) Source #
transpose
is just an alias for distribute
>>>
test $ transpose $ (V3_ (V2_ 1 2) (V2_ 3 4) (V2_ 5 6) :: Exp (M32 Int))
V2 (V3 1 3 5) (V3 2 4 6)
class Trace m => Trace m where Source #
Nothing
trace :: (Num a, Box2 m m a) => Exp (m (m a)) -> Exp a Source #
Compute the trace of a matrix
diagonal :: Box2 m m a => Exp (m (m a)) -> Exp (m a) Source #
Compute the diagonal of a matrix
Instances
Trace Complex Source # | |
Trace Plucker Source # | |
Trace Quaternion Source # | |
Defined in Data.Array.Accelerate.Linear.Trace trace :: (Num a, Box2 Quaternion Quaternion a) => Exp (Quaternion (Quaternion a)) -> Exp a Source # diagonal :: Box2 Quaternion Quaternion a => Exp (Quaternion (Quaternion a)) -> Exp (Quaternion a) Source # | |
Trace V0 Source # | |
Trace V4 Source # | |
Trace V3 Source # | |
Trace V2 Source # | |
Trace V1 Source # | |
fromQuaternion :: forall a. Num a => Exp (Quaternion a) -> Exp (M33 a) Source #
Build a rotation matrix from a unit Quaternion
mkTransformation :: forall a. Num a => Exp (Quaternion a) -> Exp (V3 a) -> Exp (M44 a) Source #
Build a transformation matrix from a rotation expressed as a Quaternion
and a translation vector.