linear 0.5 → 0.6
raw patch · 13 files changed
+361/−87 lines, 13 filesdep +simple-reflectdep −template-haskelldep ~lens
Dependencies added: simple-reflect
Dependencies removed: template-haskell
Dependency ranges changed: lens
Files
- linear.cabal +7/−5
- src/Linear.hs +4/−0
- src/Linear/Conjugate.hs +19/−0
- src/Linear/Core.hs +25/−0
- src/Linear/Epsilon.hs +12/−0
- src/Linear/Matrix.hs +87/−26
- src/Linear/Metric.hs +7/−0
- src/Linear/Plucker.hs +69/−9
- src/Linear/Quaternion.hs +32/−18
- src/Linear/V2.hs +44/−8
- src/Linear/V3.hs +13/−9
- src/Linear/V4.hs +17/−9
- src/Linear/Vector.hs +25/−3
linear.cabal view
@@ -1,6 +1,6 @@ name: linear category: Math, Algebra-version: 0.5+version: 0.6 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE@@ -31,13 +31,12 @@ library build-depends: base >= 4.5 && < 5,- distributive >= 0.2.2,- lens >= 3.6 && < 3.8,- template-haskell >= 2.7 && < 2.9+ distributive >= 0.2.2 exposed-modules: Linear Linear.Conjugate+ Linear.Core Linear.Epsilon Linear.Matrix Linear.Metric@@ -59,7 +58,10 @@ base, directory >= 1.0 && < 1.2, doctest >= 0.8 && < 0.10,- filepath >= 1.3 && < 1.4+ filepath >= 1.3 && < 1.4,+ lens >= 3.7,+ simple-reflect >= 0.3.1+ ghc-options: -Wall -Werror -threaded hs-source-dirs: tests
src/Linear.hs view
@@ -13,6 +13,7 @@ ---------------------------------------------------------------------------- module Linear ( module Linear.Conjugate+ , module Linear.Core , module Linear.Epsilon , module Linear.Matrix , module Linear.Metric@@ -25,6 +26,7 @@ ) where import Linear.Conjugate+import Linear.Core import Linear.Epsilon import Linear.Matrix import Linear.Metric@@ -34,3 +36,5 @@ import Linear.V3 import Linear.V4 import Linear.Vector++{-# ANN module "Hlint: ignore Use import/export shortcut" #-}
src/Linear/Conjugate.hs view
@@ -15,13 +15,32 @@ ) where import Data.Complex hiding (conjugate)+import Data.Int+import Data.Word -- | An involutive ring class Num a => Conjugate a where -- | Conjugate a value. This defaults to the trivial involution.+ --+ -- >>> conjugate (1 :+ 2)+ -- 1.0 :+ (-2.0)+ --+ -- >>> conjugate 1+ -- 1 conjugate :: a -> a conjugate = id +instance Conjugate Integer+instance Conjugate Int+instance Conjugate Int64+instance Conjugate Int32+instance Conjugate Int16+instance Conjugate Int8+instance Conjugate Word+instance Conjugate Word64+instance Conjugate Word32+instance Conjugate Word16+instance Conjugate Word8 instance Conjugate Double instance Conjugate Float instance (Conjugate a, RealFloat a) => Conjugate (Complex a) where
+ src/Linear/Core.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE RankNTypes #-}+-----------------------------------------------------------------------------+-- |+-- Module : Linear.Core+-- Copyright : (C) 2012-2013 Edward Kmett,+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- Corepresentable functors as vector spaces+----------------------------------------------------------------------------+module Linear.Core+ ( Core(..)+ ) where++-- |+-- A 'Functor' @f@ is corepresentable if it is isomorphic to @(x -> a)@+-- for some x. Nearly all such functors can be represented by choosing @x@ to be+-- the set of lenses that are polymorphic in the contents of the 'Functor',+-- that is to say @x = 'Rep' f@ is a valid choice of 'x' for (nearly) every+-- 'Representable' 'Functor'.+class Functor f => Core f where+ core :: ((forall g x. Functor g => (x -> g x) -> f x -> g (f x)) -> a) -> f a
src/Linear/Epsilon.hs view
@@ -14,6 +14,18 @@ ) where -- | Provides a fairly subjective 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 Num a => Epsilon a where -- | Determine if a quantity is near zero. nearZero :: a -> Bool
src/Linear/Matrix.hs view
@@ -23,7 +23,7 @@ ) where import Control.Applicative-import Control.Lens+import Control.Monad (join) import Data.Distributive import Data.Foldable as Foldable import Linear.Epsilon@@ -35,49 +35,81 @@ import Linear.Vector ((*^)) import Linear.Conjugate +-- $setup+-- >>> import Data.Complex+-- >>> import Debug.SimpleReflect.Vars+ infixl 7 !*!--- | matrix product+-- | Matrix product+--+-- >>> V2 (V3 1 2 3) (V3 4 5 6) !*! V3 (V2 1 2) (V2 3 4) (V2 4 5)+-- V2 (V2 19 25) (V2 43 58) (!*!) :: (Functor m, Foldable r, Applicative r, Distributive n, Num a) => m (r a) -> r (n a) -> m (n a)-f !*! g = fmap (\r -> Foldable.foldr (+) 0 . liftA2 (*) r <$> g') f+f !*! g = fmap (\r -> Foldable.sum . liftA2 (*) r <$> g') f where g' = distribute g --- | matrix * column vector+-- | Matrix * column vector+--+-- >>> V2 (V3 1 2 3) (V3 4 5 6) !* V3 7 8 9+-- V2 50 122 infixl 7 *! (!*) :: (Functor m, Metric r, Num a) => m (r a) -> r a -> m a m !* v = dot v <$> m infixl 7 !*--- | row vector * matrix++-- | Row vector * matrix+--+-- >>> V2 1 2 *! V2 (V3 3 4 5) (V3 6 7 8)+-- V3 15 18 21 (*!) :: (Metric r, Distributive n, Num a) => r a -> r (n a) -> n a f *! g = dot f <$> distribute g infixl 7 *!!--- |Scalar-matrix product.+-- | Scalar-matrix product+--+-- >>> 5 *!! V2 (V2 1 2) (V2 3 4)+-- V2 (V2 5 10) (V2 15 20) (*!!) :: (Functor m, Functor r, Num a) => a -> m (r a) -> m (r a) s *!! m = fmap (s *^) m {-# INLINE (*!!) #-} infixl 7 !!*--- |Matrix-scalar product.+-- | Matrix-scalar product+--+-- >>> V2 (V2 1 2) (V2 3 4) !!* 5+-- V2 (V2 5 10) (V2 15 20) (!!*) :: (Functor m, Functor r, Num a) => m (r a) -> a -> m (r a) (!!*) = flip (*!!) {-# INLINE (!!*) #-} ---- | hermitian conjugate or conjugate transpose+-- | Hermitian conjugate or conjugate transpose+--+-- >>> adjoint (V2 (V2 (1 :+ 2) (3 :+ 4)) (V2 (5 :+ 6) (7 :+ 8)))+-- V2 (V2 (1.0 :+ (-2.0)) (5.0 :+ (-6.0))) (V2 (3.0 :+ (-4.0)) (7.0 :+ (-8.0))) adjoint :: (Functor m, Distributive n, Conjugate a) => m (n a) -> n (m a) adjoint = collect (fmap conjugate) {-# INLINE adjoint #-} -- | Compute the trace of a matrix+--+-- >>> trace (V2 (V2 a b) (V2 c d))+-- a + d trace :: (Monad f, Foldable f, Num a) => f (f a) -> a-trace m = Foldable.sum (m >>= id)+trace m = Foldable.sum (join m) {-# INLINE trace #-} --- | Matrices use a row-major representation.+-- * Matrices+--+-- Matrices use a row-major representation.++-- | A 2x2 matrix with row-major representation type M22 a = V2 (V2 a)+-- | A 3x3 matrix with row-major representation type M33 a = V3 (V3 a)+-- | A 4x4 matrix with row-major representation type M44 a = V4 (V4 a)+-- | A 4x3 matrix with row-major representation type M43 a = V4 (V3 a) -- | Build a rotation matrix from a unit 'Quaternion'.@@ -92,70 +124,99 @@ mkTransformationMat :: Num a => M33 a -> V3 a -> M44 a mkTransformationMat (V3 r1 r2 r3) (V3 tx ty tz) =- V4 (snoc3 r1 tx) (snoc3 r2 ty) (snoc3 r3 tz) (set _w 1 0)- where snoc3 (V3 x y z) w = V4 x y z w+ V4 (snoc3 r1 tx) (snoc3 r2 ty) (snoc3 r3 tz) (V4 0 0 0 1)+ where snoc3 (V3 x y z) = V4 x y z -- |Build a transformation matrix from a rotation expressed as a -- 'Quaternion' and a translation vector. mkTransformation :: Num a => Quaternion a -> V3 a -> M44 a mkTransformation = mkTransformationMat . fromQuaternion +-- | Convert from a 4x3 matrix to a 4x4 matrix, extending it with the @[ 0 0 0 1 ]@ column vector m43_to_m44 :: Num a => M43 a -> M44 a m43_to_m44 (V4 (V3 a b c) (V3 d e f) (V3 g h i) (V3 j k l)) =- (V4 (V4 a b c 0)- (V4 d e f 0)- (V4 g h i 0)- (V4 j k l 1))+ V4 (V4 a b c 0)+ (V4 d e f 0)+ (V4 g h i 0)+ (V4 j k l 1)+{-# ANN m43_to_m44 "HLint: ignore Use camelCase" #-} +-- | Convert a 3x3 matrix to a 4x4 matrix extending it with 0's in the new row and column. m33_to_m44 :: Num a => M33 a -> M44 a m33_to_m44 (V3 r1 r2 r3) = V4 (vector r1) (vector r2) (vector r3) (point 0)+{-# ANN m33_to_m44 "HLint: ignore Use camelCase" #-} -- |3x3 identity matrix.+--+-- >>> eye3+-- V3 (V3 1 0 0) (V3 0 1 0) (V3 0 0 1) eye3 :: Num a => M33 a-eye3 = V3 (set _x 1 0) (set _y 1 0) (set _z 1 0)+eye3 = V3 (V3 1 0 0)+ (V3 0 1 0)+ (V3 0 0 1) -- |4x4 identity matrix.+--+-- >>> eye4+-- V4 (V4 1 0 0 0) (V4 0 1 0 0) (V4 0 0 1 0) (V4 0 0 0 1) eye4 :: Num a => M44 a-eye4 = V4 (set _x 1 0) (set _y 1 0) (set _z 1 0) (set _w 1 0)+eye4 = V4 (V4 1 0 0 0)+ (V4 0 1 0 0)+ (V4 0 0 1 0)+ (V4 0 0 0 1) + -- |Extract the translation vector (first three entries of the last -- column) from a 3x4 or 4x4 matrix translation :: (R3 t, R4 v, Functor f, Functor t) => (V3 a -> f (V3 a)) -> t (v a) -> f (t a)-translation = (. fmap (^._w)) . _xyz+translation = (. fmap (^._w)) . _xyz where+ x ^. l = getConst (l Const x) -- |2x2 matrix determinant.-det22 :: Num a => V2 (V2 a) -> a+--+-- >>> det22 (V2 (V2 a b) (V2 c d))+-- a * d - b * c+det22 :: Num a => M22 a -> a det22 (V2 (V2 a b) (V2 c d)) = a * d - b * c {-# INLINE det22 #-} -- |3x3 matrix determinant.-det33 :: Num a => V3 (V3 a) -> a+--+-- >>> det33 (V3 (V3 a b c) (V3 d e f) (V3 g h i))+-- a * (e * i - f * h) - d * (b * i - c * h) + g * (b * f - c * e)+det33 :: Num a => M33 a -> a det33 (V3 (V3 a b c) (V3 d e f) (V3 g h i)) = a * (e*i-f*h) - d * (b*i-c*h) + g * (b*f-c*e) {-# INLINE det33 #-} -- |2x2 matrix inverse.+--+-- >>> inv22 $ V2 (V2 1 2) (V2 3 4)+-- Just (V2 (V2 (-2.0) 1.0) (V2 1.5 (-0.5))) inv22 :: (Epsilon a, Floating a) => M22 a -> Maybe (M22 a) inv22 m@(V2 (V2 a b) (V2 c d)) | nearZero det = Nothing- | otherwise = Just $ (1 / det) *!! (V2 (V2 d (-b)) (V2 (-c) a))+ | otherwise = Just $ (1 / det) *!! V2 (V2 d (-b)) (V2 (-c) a) where det = det22 m {-# INLINE inv22 #-} -- |3x3 matrix inverse.+--+-- >>> inv33 $ V3 (V3 1 2 4) (V3 4 2 2) (V3 1 1 1)+-- Just (V3 (V3 0.0 0.5 (-1.0)) (V3 (-0.5) (-0.75) 3.5) (V3 0.5 0.25 (-1.5))) inv33 :: (Epsilon a, Floating a) => M33 a -> Maybe (M33 a) inv33 m@(V3 (V3 a b c) (V3 d e f) (V3 g h i)) | nearZero det = Nothing- | otherwise = Just $ (1 / det) *!! (V3 (V3 a' b' c')- (V3 d' e' f')- (V3 g' h' i'))+ | otherwise = Just $ (1 / det) *!! V3 (V3 a' b' c')+ (V3 d' e' f')+ (V3 g' h' i') where a' = cofactor (e,f,h,i) b' = cofactor (c,b,i,h) c' = cofactor (b,c,e,f)
src/Linear/Metric.hs view
@@ -17,10 +17,17 @@ import Control.Applicative import Linear.Epsilon +-- $setup+-- >>> import Linear+ -- | A free inner product/metric space class Applicative f => Metric f where -- | Compute the inner product of two vectors or (equivalently) -- convert a vector @f a@ into a covector @f a -> a@.+ --+ -- >>> V2 1 2 `dot` V2 3 4+ -- 11+ dot :: Num a => f a -> f a -> a -- | Compute the squared norm. The name quadrance arises from
src/Linear/Plucker.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : Linear.Plucker@@ -17,6 +18,11 @@ , (><) , plucker , intersects+ -- * Basis elements+ , p01, p02, p03+ , p10, p12, p13+ , p20, p21, p23+ , p30, p31, p32 ) where import Control.Applicative@@ -24,10 +30,12 @@ import Data.Foldable as Foldable import Data.Monoid import Data.Traversable-import Linear.Epsilon+import Foreign.Ptr (castPtr)+import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..))+import Linear.Core+import Linear.Epsilon import Linear.Metric-import Control.Lens import Linear.V4 -- | Plücker coordinates for lines in a 3-dimensional space.@@ -47,16 +55,27 @@ instance Monad Plucker where return a = Plucker a a a a a a {-# INLINE return #-}- (>>=) = bindRep+ Plucker a b c d e f >>= g = Plucker a' b' c' d' e' f' where+ Plucker a' _ _ _ _ _ = g a+ Plucker _ b' _ _ _ _ = g b+ Plucker _ _ c' _ _ _ = g c+ Plucker _ _ _ d' _ _ = g d+ Plucker _ _ _ _ e' _ = g e+ Plucker _ _ _ _ _ f' = g f {-# INLINE (>>=) #-} instance Distributive Plucker where- distribute = distributeRep+ distribute f = Plucker (fmap (\(Plucker x _ _ _ _ _) -> x) f)+ (fmap (\(Plucker _ x _ _ _ _) -> x) f)+ (fmap (\(Plucker _ _ x _ _ _) -> x) f)+ (fmap (\(Plucker _ _ _ x _ _) -> x) f)+ (fmap (\(Plucker _ _ _ _ x _) -> x) f)+ (fmap (\(Plucker _ _ _ _ _ x) -> x) f) {-# INLINE distribute #-} -instance Representable Plucker where- rep f = Plucker (f p01) (f p02) (f p03) (f p23) (f p31) (f p12)- {-# INLINE rep #-}+instance Core Plucker where+ core f = Plucker (f p01) (f p02) (f p03) (f p23) (f p31) (f p12)+ {-# INLINE core #-} instance Foldable Plucker where foldMap g (Plucker a b c d e f) =@@ -84,8 +103,8 @@ unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * ( unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (- unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (- unsafeIndex (l1,u1) i1)))))+ unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) *+ unsafeIndex (l1,u1) i1)))) {-# INLINE unsafeIndex #-} inRange (Plucker l1 l2 l3 l4 l5 l6,Plucker u1 u2 u3 u4 u5 u6) (Plucker i1 i2 i3 i4 i5 i6) =@@ -118,6 +137,29 @@ fromRational = pure . fromRational {-# INLINE fromRational #-} +instance Storable a => Storable (Plucker a) where+ sizeOf _ = 6 * sizeOf (undefined::a)+ {-# INLINE sizeOf #-}+ alignment _ = alignment (undefined::a)+ {-# INLINE alignment #-}+ poke ptr (Plucker a b c d e f) = do+ poke ptr' a+ pokeElemOff ptr' 1 b+ pokeElemOff ptr' 2 c+ pokeElemOff ptr' 3 d+ pokeElemOff ptr' 4 e+ pokeElemOff ptr' 5 f+ where ptr' = castPtr ptr+ {-# INLINE poke #-}+ peek ptr = Plucker <$> peek ptr'+ <*> peekElemOff ptr' 1+ <*> peekElemOff ptr' 2+ <*> peekElemOff ptr' 3+ <*> peekElemOff ptr' 4+ <*> peekElemOff ptr' 5+ where ptr' = castPtr ptr+ {-# INLINE peek #-}+ -- | Given a pair of points represented by homogeneous coordinates generate Plücker coordinates -- for the line through them. plucker :: Num a => V4 a -> V4 a -> Plucker a@@ -145,6 +187,24 @@ {-# INLINE p23 #-} {-# INLINE p31 #-} {-# INLINE p12 #-}++-- | These elements form an alternate basis for the Plücker space, or the Grassmanian manifold @Gr(2,V4)@.+p10, p20, p30, p32, p13, p21 :: (Functor f, Num a) => (a -> f a) -> Plucker a -> f (Plucker a)+p10 = anti p01+p20 = anti p02+p30 = anti p03+p32 = anti p23+p13 = anti p31+p21 = anti p21+{-# INLINE p10 #-}+{-# INLINE p20 #-}+{-# INLINE p30 #-}+{-# INLINE p32 #-}+{-# INLINE p13 #-}+{-# INLINE p21 #-}++anti :: (Functor f, Num a) => ((a -> f a) -> r) -> (a -> f a) -> r+anti k f = k (fmap negate . f . negate) -- | Valid Plücker coordinates @p@ will have @'squaredError' p '==' 0@ --
src/Linear/Quaternion.hs view
@@ -27,17 +27,19 @@ , rotate , axisAngle ) where+ import Control.Applicative-import Control.Lens import Data.Complex (Complex((:+))) import Data.Data import Data.Distributive+import Data.Traversable import Data.Foldable import GHC.Arr (Ix(..)) import qualified Data.Foldable as F import Data.Monoid import Foreign.Ptr (castPtr, plusPtr) import Foreign.Storable (Storable(..))+import Linear.Core import Linear.Epsilon import Linear.Conjugate import Linear.Metric@@ -45,6 +47,7 @@ import Linear.Vector import Prelude hiding (any) +-- | Quaternions data Quaternion a = Quaternion a {-# UNPACK #-}!(V3 a) deriving (Eq,Ord,Read,Show,Data,Typeable) @@ -63,7 +66,12 @@ instance Monad Quaternion where return = pure {-# INLINE return #-}- (>>=) = bindRep -- the diagonal of a sedenion is super useful!+ -- the diagonal of a sedenion is super useful!+ Quaternion a (V3 b c d) >>= f = Quaternion a' (V3 b' c' d') where+ Quaternion a' _ = f a+ Quaternion _ (V3 b' _ _) = f b+ Quaternion _ (V3 _ c' _) = f c+ Quaternion _ (V3 _ _ d') = f d {-# INLINE (>>=) #-} instance Ix a => Ix (Quaternion a) where@@ -81,9 +89,9 @@ inRange (l1,u1) i1 && inRange (l2,u2) i2 {-# INLINE inRange #-} -instance Representable Quaternion where- rep f = Quaternion (f _e) (V3 (f _i) (f _j) (f _k))- {-# INLINE rep #-}+instance Core Quaternion where+ core f = Quaternion (f _e) (V3 (f _i) (f _j) (f _k))+ {-# INLINE core #-} instance Foldable Quaternion where foldMap f (Quaternion e v) = f e `mappend` foldMap f v@@ -95,7 +103,7 @@ traverse f (Quaternion e v) = Quaternion <$> f e <*> traverse f v {-# INLINE traverse #-} -instance forall a. Storable a => Storable (Quaternion a) where+instance Storable a => Storable (Quaternion a) where sizeOf _ = 4 * sizeOf (undefined::a) {-# INLINE sizeOf #-} alignment _ = alignment (undefined::a)@@ -170,6 +178,7 @@ Quaternion e v `dot` Quaternion e' v' = e*e' + (v `dot` v') {-# INLINE dot #-} +-- | A vector space that includes the basis elements '_e' and '_i' class Complicated t where _e :: Functor f => (a -> f a) -> t a -> f (t a) _i :: Functor f => (a -> f a) -> t a -> f (t a)@@ -181,11 +190,12 @@ {-# INLINE _i #-} instance Complicated Quaternion where- _e f (Quaternion a v) = (\a' -> Quaternion a' v) <$> f a+ _e f (Quaternion a v) = (`Quaternion` v) <$> f a {-# INLINE _e #-} _i f (Quaternion a v) = Quaternion a <$> _x f v {-# INLINE _i #-} +-- | A vector space that includes the basis elements '_e', '_i', '_j' and '_k' class Complicated t => Hamiltonian t where _j :: Functor f => (a -> f a) -> t a -> f (t a) _k :: Functor f => (a -> f a) -> t a -> f (t a)@@ -200,7 +210,10 @@ {-# INLINE _ijk #-} instance Distributive Quaternion where- distribute = distributeRep+ distribute f = Quaternion (fmap (\(Quaternion x _) -> x) f) $ V3+ (fmap (\(Quaternion _ (V3 y _ _)) -> y) f)+ (fmap (\(Quaternion _ (V3 _ z _)) -> z) f)+ (fmap (\(Quaternion _ (V3 _ _ w)) -> w) f) {-# INLINE distribute #-} instance (Conjugate a, RealFloat a) => Conjugate (Quaternion a) where@@ -292,25 +305,25 @@ where qiq = qi q {-# INLINE tanh #-} - asin q = cut asin q+ asin = cut asin {-# INLINE asin #-}- acos q = cut acos q+ acos = cut acos {-# INLINE acos #-}- atan q = cut atan q+ atan = cut atan {-# INLINE atan #-} - asinh q = cut asinh q+ asinh = cut asinh {-# INLINE asinh #-}- acosh q = cut acosh q+ acosh = cut acosh {-# INLINE acosh #-}- atanh q = cut atanh q+ atanh = cut atanh {-# INLINE atanh #-} -- | Helper for calculating with specific branch cuts cut :: RealFloat a => (Complex a -> Complex a) -> Quaternion a -> Quaternion a-cut f q@(Quaternion e v)- | qiq == 0 = Quaternion a (_x.~b$v)+cut f q@(Quaternion e (V3 _ y z))+ | qiq == 0 = Quaternion a (V3 b y z) | otherwise = reimagine a (b / ai) q where qiq = qi q ai = sqrt qiq@@ -387,7 +400,8 @@ -- | Apply a rotation to a vector. rotate :: (Conjugate a, RealFloat a) => Quaternion a -> V3 a -> V3 a-rotate q v = (q * Quaternion 0 v * conjugate q)^._ijk+rotate q v = ijk where+ Quaternion _ ijk = q * Quaternion 0 v * conjugate q {-# SPECIALIZE rotate :: Quaternion Float -> V3 Float -> V3 Float #-} {-# SPECIALIZE rotate :: Quaternion Double -> V3 Double -> V3 Double #-} @@ -398,6 +412,6 @@ -- | @'axisAngle' axis theta@ builds a 'Quaternion' representing a -- rotation of @theta@ radians about @axis@. axisAngle :: (Epsilon a, Floating a) => V3 a -> a -> Quaternion a-axisAngle axis theta = normalize $ Quaternion (cos half) $ (sin half) *^ axis+axisAngle axis theta = normalize $ Quaternion (cos half) $ sin half *^ axis where half = theta / 2 {-# INLINE axisAngle #-}
src/Linear/V2.hs view
@@ -21,18 +21,36 @@ ) where import Control.Applicative-import Control.Lens import Data.Data import Data.Distributive import Data.Foldable+import Data.Traversable import Data.Monoid import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..))+import Linear.Core import Linear.Metric import Linear.Epsilon+import Prelude hiding (sum) +-- $setup+-- >>> import Control.Lens+ -- | A 2-dimensional vector+--+-- >>> pure 1 :: V2 Int+-- V2 1 1+--+-- >>> V2 1 2 + V2 3 4+-- V2 4 6+--+-- >>> V2 1 2 * V2 3 4+-- V2 3 8+--+-- >>> sum (V2 1 2)+-- 3+ data V2 a = V2 a a deriving (Eq,Ord,Show,Read,Data,Typeable) instance Functor V2 where@@ -58,7 +76,9 @@ instance Monad V2 where return a = V2 a a {-# INLINE return #-}- (>>=) = bindRep+ V2 a b >>= f = V2 a' b' where+ V2 a' _ = f a+ V2 _ b' = f b {-# INLINE (>>=) #-} instance Num a => Num (V2 a) where@@ -91,10 +111,23 @@ -- | A space that distinguishes 2 orthogonal basis vectors '_x' and '_y', but may have more. class R2 t where+ -- |+ -- >>> V2 1 2 ^._x+ -- 1+ --+ -- >>> V2 1 2 & _x .~ 3+ -- V2 3 2 _x :: Functor f => (a -> f a) -> t a -> f (t a) _x = _xy._x {-# INLINE _x #-} + -- |+ -- >>> V2 1 2 ^._y+ -- 2+ --+ -- >>> V2 1 2 & _y .~ 3+ -- V2 1 3+ _y :: Functor f => (a -> f a) -> t a -> f (t a) _y = _xy._y {-# INLINE _y #-}@@ -104,20 +137,23 @@ instance R2 V2 where _x f (V2 a b) = (`V2` b) <$> f a {-# INLINE _x #-}- _y f (V2 a b) = (V2 a) <$> f b+ _y f (V2 a b) = V2 a <$> f b {-# INLINE _y #-} _xy = id {-# INLINE _xy #-} -instance Representable V2 where- rep f = V2 (f _x) (f _y)- {-# INLINE rep #-}+instance Core V2 where+ core f = V2 (f _x) (f _y)+ {-# INLINE core #-} instance Distributive V2 where- distribute f = V2 (fmap (^._x) f) (fmap (^._y) f)+ distribute f = V2 (fmap (\(V2 x _) -> x) f) (fmap (\(V2 _ y) -> y) f) {-# INLINE distribute #-} -- | the counter-clockwise perpendicular vector+--+-- >>> perp $ V2 10 20+-- V2 (-20) 10 perp :: Num a => V2 a -> V2 a perp (V2 a b) = V2 (negate b) a {-# INLINE perp #-}@@ -126,7 +162,7 @@ nearZero = nearZero . quadrance {-# INLINE nearZero #-} -instance forall a. Storable a => Storable (V2 a) where+instance Storable a => Storable (V2 a) where sizeOf _ = 2 * sizeOf (undefined::a) {-# INLINE sizeOf #-} alignment _ = alignment (undefined::a)
src/Linear/V3.hs view
@@ -19,14 +19,15 @@ ) where import Control.Applicative-import Control.Lens import Data.Data import Data.Distributive import Data.Foldable+import Data.Traversable import Data.Monoid import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..))+import Linear.Core import Linear.Epsilon import Linear.Metric import Linear.V2@@ -57,7 +58,10 @@ instance Monad V3 where return a = V3 a a a {-# INLINE return #-}- (>>=) = bindRep+ V3 a b c >>= f = V3 a' b' c' where+ V3 a' _ _ = f a+ V3 _ b' _ = f b+ V3 _ _ c' = f c {-# INLINE (>>=) #-} instance Num a => Num (V3 a) where@@ -89,7 +93,7 @@ {-# INLINABLE dot #-} instance Distributive V3 where- distribute f = V3 (fmap (^._x) f) (fmap (^._y) f) (fmap (^._z) f)+ distribute f = V3 (fmap (\(V3 x _ _) -> x) f) (fmap (\(V3 _ y _) -> y) f) (fmap (\(V3 _ _ z) -> z) f) {-# INLINE distribute #-} -- | A space that distinguishes 3 orthogonal basis vectors: '_x', '_y', and '_z'. (It may have more)@@ -111,11 +115,11 @@ _xyz = id {-# INLINE _xyz #-} -instance Representable V3 where- rep f = V3 (f _x) (f _y) (f _z)- {-# INLINE rep #-}+instance Core V3 where+ core f = V3 (f _x) (f _y) (f _z)+ {-# INLINE core #-} -instance forall a. Storable a => Storable (V3 a) where+instance Storable a => Storable (V3 a) where sizeOf _ = 3 * sizeOf (undefined::a) {-# INLINE sizeOf #-} alignment _ = alignment (undefined::a)@@ -155,8 +159,8 @@ unsafeIndex (V3 l1 l2 l3,V3 u1 u2 u3) (V3 i1 i2 i3) = unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (- unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (- unsafeIndex (l1,u1) i1))+ unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) *+ unsafeIndex (l1,u1) i1) {-# INLINE unsafeIndex #-} inRange (V3 l1 l2 l3,V3 u1 u2 u3) (V3 i1 i2 i3) =
src/Linear/V4.hs view
@@ -20,14 +20,15 @@ ) where import Control.Applicative-import Control.Lens import Data.Data import Data.Distributive import Data.Foldable import Data.Monoid+import Data.Traversable import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..))+import Linear.Core import Linear.Epsilon import Linear.Metric import Linear.V2@@ -59,7 +60,11 @@ instance Monad V4 where return a = V4 a a a a {-# INLINE return #-}- (>>=) = bindRep+ V4 a b c d >>= f = V4 a' b' c' d' where+ V4 a' _ _ _ = f a+ V4 _ b' _ _ = f b+ V4 _ _ c' _ = f c+ V4 _ _ _ d' = f d {-# INLINE (>>=) #-} instance Num a => Num (V4 a) where@@ -91,7 +96,10 @@ {-# INLINE dot #-} instance Distributive V4 where- distribute f = V4 (fmap (^._x) f) (fmap (^._y) f) (fmap (^._z) f) (fmap (^._w) f)+ distribute f = V4 (fmap (\(V4 x _ _ _) -> x) f)+ (fmap (\(V4 _ y _ _) -> y) f)+ (fmap (\(V4 _ _ z _) -> z) f)+ (fmap (\(V4 _ _ _ w) -> w) f) {-# INLINE distribute #-} -- | A space that distinguishes orthogonal basis vectors '_x', '_y', '_z', '_w'. (It may have more.)@@ -119,11 +127,11 @@ _xyzw = id {-# INLINE _xyzw #-} -instance Representable V4 where- rep f = V4 (f _x) (f _y) (f _z) (f _w)- {-# INLINE rep #-}+instance Core V4 where+ core f = V4 (f _x) (f _y) (f _z) (f _w)+ {-# INLINE core #-} -instance forall a. Storable a => Storable (V4 a) where+instance Storable a => Storable (V4 a) where sizeOf _ = 4 * sizeOf (undefined::a) {-# INLINE sizeOf #-} alignment _ = alignment (undefined::a)@@ -167,8 +175,8 @@ unsafeIndex (V4 l1 l2 l3 l4,V4 u1 u2 u3 u4) (V4 i1 i2 i3 i4) = unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (- unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (- unsafeIndex (l1,u1) i1)))+ unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) *+ unsafeIndex (l1,u1) i1)) {-# INLINE unsafeIndex #-} inRange (V4 l1 l2 l3 l4,V4 u1 u2 u3 u4) (V4 i1 i2 i3 i4) =
src/Linear/Vector.hs view
@@ -17,37 +17,55 @@ , (*^) , (^/) , lerp- , basis- , basisFor+ -- , basis+ -- , basisFor ) where import Control.Applicative-import Control.Lens +-- $setup+-- >>> import Control.Lens+-- >>> import Linear.V2+ infixl 6 ^+^, ^-^ infixl 7 ^*, *^, ^/ -- | Compute the sum of two vectors+--+-- >>> V2 1 2 ^+^ V2 3 4+-- V2 4 6 (^+^) :: (Applicative f, Num a) => f a -> f a -> f a (^+^) = liftA2 (+) {-# INLINE (^+^) #-} -- | Compute the negation of a vector+--+-- >>> gnegate (V2 2 4)+-- V2 (-2) (-4) gnegate :: (Functor f, Num a) => f a -> f a gnegate = fmap negate {-# INLINE gnegate #-} -- | Compute the difference between two vectors+--+-- >>> V2 4 5 - V2 3 1+-- V2 1 4 (^-^) :: (Applicative f, Num a) => f a -> f a -> f a (^-^) = liftA2 (-) {-# INLINE (^-^) #-} -- | Compute the left scalar product+--+-- >>> 2 *^ V2 3 4+-- V2 6 8 (*^) :: (Functor f, Num a) => a -> f a -> f a (*^) a = fmap (a*) {-# INLINE (*^) #-} -- | Compute the right scalar product+--+-- >>> V2 3 4 ^* 2+-- V2 6 8 (^*) :: (Functor f, Num a) => f a -> a -> f a f ^* a = fmap (*a) f {-# INLINE (^*) #-}@@ -62,6 +80,8 @@ lerp alpha u v = alpha *^ u ^+^ (1 - alpha) *^ v {-# INLINE lerp #-} +{-+ -- | Produce a default basis for a vector space. If the dimensionality -- of the vector space is not statically known, see 'basisFor'. basis :: (Applicative t, Traversable t, Num a) => [t a]@@ -75,3 +95,5 @@ where z = 0 <$ v n = lengthOf folded z aux i = z & element i .~ 1++-}