packages feed

linear 1.4 → 1.6

raw patch · 19 files changed

+638/−208 lines, 19 filesdep +adjunctionsdep +voiddep ~lens

Dependencies added: adjunctions, void

Dependency ranges changed: lens

Files

CHANGELOG.markdown view
@@ -1,3 +1,7 @@+1.5+---+* `lens` 4 compatibility+ 1.4 --- * Renamed `incore` to `column` and added an example.
LICENSE view
@@ -1,4 +1,4 @@-Copyright 2011-13 Edward Kmett+Copyright 2011-14 Edward Kmett  All rights reserved.
linear.cabal view
@@ -1,6 +1,6 @@ name:          linear category:      Math, Algebra-version:       1.4+version:       1.6 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -9,7 +9,7 @@ stability:     provisional homepage:      http://github.com/ekmett/linear/ bug-reports:   http://github.com/ekmett/linear/issues-copyright:     Copyright (C) 2012-2013 Edward A. Kmett+copyright:     Copyright (C) 2012-2014 Edward A. Kmett synopsis:      Linear Algebra description:   Types and combinators for linear algebra on free vector spaces build-type:    Custom@@ -30,12 +30,14 @@  library   build-depends:+    adjunctions          >= 4     && < 5,     base                 >= 4.5   && < 5,     binary               >= 0.5   && < 0.8,     containers           >= 0.4   && < 0.6,     distributive         >= 0.2.2 && < 1,     ghc-prim,     hashable             >= 1.1   && < 1.3,+    lens                 >= 4     && < 5,     reflection           >= 1.3.2 && < 2,     semigroups           >= 0.9   && < 1,     semigroupoids        >= 3     && < 5,@@ -43,14 +45,16 @@     template-haskell     >= 2.7   && < 3.0,     transformers         >= 0.2   && < 0.4,     unordered-containers >= 0.2.3 && < 0.3,-    vector               >= 0.10  && < 0.11+    vector               >= 0.10  && < 0.11,+    void                 >= 0.6   && < 1    exposed-modules:     Linear     Linear.Affine+    Linear.Algebra     Linear.Binary     Linear.Conjugate-    Linear.Core+    Linear.Covector     Linear.Epsilon     Linear.Instances     Linear.Matrix@@ -80,7 +84,8 @@     directory >= 1.0 && < 1.3,     doctest   >= 0.8 && < 0.10,     filepath  >= 1.3 && < 1.4,-    lens      >= 3.8.4,+    lens,+    linear,     simple-reflect >= 0.3.1  test-suite UnitTests
src/Linear.hs view
@@ -11,8 +11,9 @@ -- that make up the linear package. ---------------------------------------------------------------------------- module Linear-  ( module Linear.Conjugate-  , module Linear.Core+  ( module Linear.Algebra+  , module Linear.Conjugate+  , module Linear.Covector   , module Linear.Epsilon   , module Linear.Matrix   , module Linear.Metric@@ -26,8 +27,9 @@   , module Linear.Vector   )  where +import Linear.Algebra import Linear.Conjugate-import Linear.Core+import Linear.Covector import Linear.Epsilon import Linear.Instances () import Linear.Matrix
src/Linear/Affine.hs view
@@ -19,16 +19,17 @@ module Linear.Affine where  import Control.Applicative+import Control.Lens import Data.Complex (Complex)+import Data.Distributive import Data.Foldable as Foldable import Data.Functor.Bind-import Data.Functor.Identity (Identity)+import Data.Functor.Rep as Rep import Data.HashMap.Lazy (HashMap) import Data.Hashable import Data.IntMap (IntMap) import Data.Ix import Data.Map (Map)-import Data.Traversable as Traversable import Data.Vector (Vector) import Foreign.Storable #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702@@ -37,7 +38,6 @@ #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) #endif-import Linear.Core import Linear.Epsilon import Linear.Metric import Linear.Plucker@@ -119,14 +119,21 @@ #endif            ) -lensP :: Functor f => (g a -> f (g a)) -> Point g a -> f (Point g a)-lensP afb (P a) = (\b -> P b) <$> afb a+lensP :: Lens' (Point g a) (g a)+lensP afb (P a) = P <$> afb a  instance Bind f => Bind (Point f) where   join (P m) = P $ join $ fmap (\(P m')->m') m -instance Core f => Core (Point f) where-  core f = P $ core (\l->f (lensP . l))+instance Distributive f => Distributive (Point f) where+  distribute = P . collect (\(P p) -> p)++instance Representable f => Representable (Point f) where+  type Rep (Point f) = Rep f+  tabulate f = P (tabulate f)+  {-# INLINE tabulate #-}+  index (P xs) = Rep.index xs+  {-# INLINE index #-}  instance R1 f => R1 (Point f) where   _x = lensP . _x
+ src/Linear/Algebra.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+module Linear.Algebra+  ( Algebra(..)+  , Coalgebra(..)+  , multRep, unitalRep+  , comultRep, counitalRep+  ) where++import Control.Lens hiding (index)+import Data.Functor.Rep+import Data.Complex+import Data.Void+import Linear.Vector+import Linear.Quaternion+import Linear.Conjugate+import Linear.V0+import Linear.V1+import Linear.V2+import Linear.V3+import Linear.V4++-- | An associative unital algebra over a ring+class Num r => Algebra r m where+  mult :: (m -> m -> r) -> m -> r+  unital :: r -> m -> r++multRep :: (Representable f, Algebra r (Rep f)) => f (f r) -> f r+multRep ffr = tabulate $ mult (index . index ffr)++unitalRep :: (Representable f, Algebra r (Rep f)) => r -> f r+unitalRep = tabulate . unital++instance Num r => Algebra r Void where+  mult _ _ = 0+  unital _ _ = 0++instance Num r => Algebra r (E V0) where+  mult _ _ = 0+  unital _ _ = 0++instance Num r => Algebra r (E V1) where+  mult f _ = f ex ex+  unital r _ = r++instance Num r => Algebra r () where+  mult f () = f () ()+  unital r () = r++instance (Algebra r a, Algebra r b) => Algebra r (a, b) where+  mult f (a,b) = mult (\a1 a2 -> mult (\b1 b2 -> f (a1,b1) (a2,b2)) b) a+  unital r (a,b) = unital r a * unital r b++instance Num r => Algebra r (E Complex) where+  mult f = \ i -> c^.el i where+   c = (f ee ee - f ei ei) :+ (f ee ei + f ei ee)+  unital r i = (r :+ 0)^.el i++instance (Num r, TrivialConjugate r) => Algebra r (E Quaternion) where+  mult f = index $ Quaternion+    (f ee ee - (f ei ei + f ej ej + f ek ek))+    (V3 (f ee ei + f ei ee + f ej ek - f ek ej)+        (f ee ej + f ej ee + f ek ei - f ei ek)+        (f ee ek + f ek ee + f ei ej - f ej ei))+  unital r = index (Quaternion r 0)++-- | A coassociative counital coalgebra over a ring+class Num r => Coalgebra r m where+  comult :: (m -> r) -> m -> m -> r+  counital :: (m -> r) -> r++comultRep :: (Representable f, Coalgebra r (Rep f)) => f r -> f (f r)+comultRep fr = tabulate $ \i -> tabulate $ \j -> comult (index fr) i j++counitalRep :: (Representable f, Coalgebra r (Rep f)) => f r -> r+counitalRep = counital . index++instance Num r => Coalgebra r Void where+  comult _ _ _ = 0+  counital _ = 0++instance Num r => Coalgebra r () where+  comult f () () = f ()+  counital f = f ()++instance Num r => Coalgebra r (E V0) where+  comult _ _ _ = 0+  counital _ = 0++instance Num r => Coalgebra r (E V1) where+  comult f _ _ = f ex+  counital f = f ex++instance Num r => Coalgebra r (E V2) where+  comult f = index . index v where+    v = V2 (V2 (f ex) 0) (V2 0 (f ey))+  counital f = f ex + f ey++instance Num r => Coalgebra r (E V3) where+  comult f = index . index q where+    q = V3 (V3 (f ex) 0 0)+           (V3 0 (f ey) 0)+           (V3 0 0 (f ez))+  counital f = f ex + f ey + f ez++instance Num r => Coalgebra r (E V4) where+  comult f = index . index v where+    v = V4 (V4 (f ex) 0 0 0) (V4 0 (f ey) 0 0) (V4 0 0 (f ez) 0) (V4 0 0 0 (f ew))+  counital f = f ex + f ey + f ez + f ew++instance Num r => Coalgebra r (E Complex) where+  comult f = \i j -> c^.el i.el j where+    c = (f ee :+ 0) :+ (0 :+ f ei)+  counital f = f ee + f ei++instance (Num r, TrivialConjugate r) => Coalgebra r (E Quaternion) where+  comult f = index . index+    (Quaternion (Quaternion (f ee) (V3 0 0 0))+            (V3 (Quaternion 0 (V3 (f ei) 0 0))+                (Quaternion 0 (V3 0 (f ej) 0))+                (Quaternion 0 (V3 0 0 (f ek)))))+  counital f = f ee + f ei + f ej + f ek++instance (Coalgebra r m, Coalgebra r n) => Coalgebra r (m, n) where+  comult f (a1, b1) (a2, b2) = comult (\a -> comult (\b -> f (a, b)) b1 b2) a1 a2+  counital k = counital $ \a -> counital $ \b -> k (a,b)
src/Linear/Conjugate.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DefaultSignatures #-} ----------------------------------------------------------------------------- -- | -- Copyright   :  (C) 2012-2013 Edward Kmett,@@ -12,6 +13,7 @@ ---------------------------------------------------------------------------- module Linear.Conjugate   ( Conjugate(..)+  , TrivialConjugate   ) where  import Data.Complex hiding (conjugate)@@ -29,8 +31,18 @@   -- >>> conjugate 1   -- 1   conjugate :: a -> a+#ifndef HLINT+  default conjugate :: TrivialConjugate a => a -> a   conjugate = id+#endif +-- | Requires and provides a default definition such that+--+-- @+-- 'conjugate' = 'id'+-- @+class Conjugate a => TrivialConjugate a+ instance Conjugate Integer instance Conjugate Int instance Conjugate Int64@@ -51,3 +63,19 @@   {-# SPECIALIZE instance Conjugate (Complex Float) #-}   {-# SPECIALIZE instance Conjugate (Complex Double) #-}   conjugate (a :+ b) = conjugate a :+ negate b++instance TrivialConjugate Integer+instance TrivialConjugate Int+instance TrivialConjugate Int64+instance TrivialConjugate Int32+instance TrivialConjugate Int16+instance TrivialConjugate Int8+instance TrivialConjugate Word+instance TrivialConjugate Word64+instance TrivialConjugate Word32+instance TrivialConjugate Word16+instance TrivialConjugate Word8+instance TrivialConjugate Double+instance TrivialConjugate Float+instance TrivialConjugate CFloat+instance TrivialConjugate CDouble
− src/Linear/Core.hs 
@@ -1,79 +0,0 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE CPP #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE DeriveGeneric #-}-#endif--------------------------------------------------------------------------------- |--- 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(..)-  , column-  ) where--import Control.Applicative-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702-import GHC.Generics (Generic)-#endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706-import GHC.Generics (Generic1)-#endif---- $setup--- >>> import Linear--- >>> import Control.Lens--type LensLike f s t a b = (a -> f b) -> s -> f t-type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t-type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s---- |--- 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-  -- | Form a structure by applying the given function to lenses focused on its holes.-  core :: ((forall x. Lens' (f x) x) -> a) -> f a--data Context a b t = Context { peek :: b -> t, pos :: a }-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706-                   deriving (Generic, Generic1)-#elif defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702-                   deriving (Generic)-#endif--instance Functor (Context a b) where-  fmap f (Context bt a) = Context (f.bt) a--view :: LensLike (Const a) s t a b -> s -> a-view l = getConst . l Const---- | This is a generalization of 'Control.Lens.inside' to work over any corepresentable 'Functor'.------ @--- 'column' :: 'Core' f => 'Lens' s t a b -> 'Lens' (f s) (f t) (f a) (f b)--- @------ In practice it is used to access a column of a matrix.--------- >>> V2 (V3 1 2 3) (V3 4 5 6) ^._x--- V3 1 2 3------ >>> V2 (V3 1 2 3) (V3 4 5 6) ^.column _x--- V2 1 4-column :: Core f => LensLike (Context a b) s t a b -> Lens (f s) (f t) (f a) (f b)-column l f es = o <$> f i where-   go = l (Context id)-   i = core $ \ e -> pos $ go (view e es)-   o eb = core $ \ e -> peek (go (view e es)) (view e eb)
+ src/Linear/Covector.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}+module Linear.Covector+  ( Covector(..)+  , ($*)+  ) where++import Control.Applicative+import Control.Monad+import Data.Functor.Plus hiding (zero)+import qualified Data.Functor.Plus as Plus+import Data.Functor.Bind+import Data.Functor.Rep as Rep+import Linear.Algebra++-- | Linear functionals from elements of an (infinite) free module to a scalar++newtype Covector r a = Covector { runCovector :: (a -> r) -> r }++infixr 0 $*++($*) :: Representable f => Covector r (Rep f) -> f r -> r+Covector f $* m = f (Rep.index m)++instance Functor (Covector r) where+  fmap f (Covector m) = Covector $ \k -> m (k . f)++instance Apply (Covector r) where+  Covector mf <.> Covector ma = Covector $ \k -> mf $ \f -> ma (k . f)++instance Applicative (Covector r) where+  pure a = Covector $ \k -> k a+  Covector mf <*> Covector ma = Covector $ \k -> mf $ \f -> ma $ k . f++instance Bind (Covector r) where+  Covector m >>- f = Covector $ \k -> m $ \a -> runCovector (f a) k++instance Monad (Covector r) where+  return a = Covector $ \k -> k a+  Covector m >>= f = Covector $ \k -> m $ \a -> runCovector (f a) k++instance Num r => Alt (Covector r) where+  Covector m <!> Covector n = Covector $ \k -> m k + n k++instance Num r => Plus (Covector r) where+  zero = Covector (const 0)++instance Num r => Alternative (Covector r) where+  Covector m <|> Covector n = Covector $ \k -> m k + n k+  empty = Covector (const 0)++instance Num r => MonadPlus (Covector r) where+  Covector m `mplus` Covector n = Covector $ \k -> m k + n k+  mzero = Covector (const 0)++instance Coalgebra r m => Num (Covector r m) where+  Covector f + Covector g = Covector $ \k -> f k + g k+  Covector f - Covector g = Covector $ \k -> f k - g k+  Covector f * Covector g = Covector $ \k -> f $ \m -> g $ comult k m+  negate (Covector f) = Covector $ \k -> negate (f k)+  abs _    = error "Covector.abs: undefined"+  signum _ = error "Covector.signum: undefined"+  fromInteger n = Covector $ \ k -> fromInteger n * counital k
src/Linear/Matrix.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif@@ -15,6 +16,7 @@ --------------------------------------------------------------------------- module Linear.Matrix   ( (!*!), (!+!), (!-!), (!*) , (*!), (!!*), (*!!)+  , column   , adjoint   , M22, M33, M44, M43, m33_to_m44, m43_to_m44   , det22, det33, inv22, inv33@@ -27,9 +29,11 @@   ) where  import Control.Applicative+import Control.Lens hiding (index)+import Control.Lens.Internal.Context import Data.Distributive import Data.Foldable as Foldable-import Data.Functor.Identity+import Data.Functor.Rep import Linear.Epsilon import Linear.Quaternion import Linear.V2@@ -39,6 +43,25 @@ import Linear.Conjugate import Linear.Trace +-- | This is a generalization of 'Control.Lens.inside' to work over any corepresentable 'Functor'.+--+-- @+-- 'column' :: 'Representable' f => 'Lens' s t a b -> 'Lens' (f s) (f t) (f a) (f b)+-- @+--+-- In practice it is used to access a column of a matrix.+--+-- >>> V2 (V3 1 2 3) (V3 4 5 6) ^._x+-- V3 1 2 3+--+-- >>> V2 (V3 1 2 3) (V3 4 5 6) ^.column _x+-- V2 1 4+column :: Representable f => LensLike (Context a b) s t a b -> Lens (f s) (f t) (f a) (f b)+column l f es = o <$> f i where+   go = l (Context id)+   i = tabulate $ \ e -> ipos $ go (index es e)+   o eb = tabulate $ \ e -> ipeek (index eb e) (go (index es e))+ -- $setup -- >>> import Data.Complex -- >>> import Data.IntMap@@ -199,25 +222,16 @@  -- |Extract the translation vector (first three entries of the last -- column) from a 3x4 or 4x4 matrix.--- --- @--- 'translation' :: (R4 v, R3 t) => Lens' (t (v a)) ('V3' a)--- @-translation :: (Functor f, R4 v, R3 t) => (V3 a -> f (V3 a)) -> t (v a) -> f (t (v a))-translation f rs = aux <$> f ((^._w) <$> rs^._xyz)+translation :: (Representable t, R3 t, R4 v) => Lens' (t (v a)) (V3 a)+translation = column _w._xyz+{-+translation f rs = aux <$> f (view _w <$> view _xyz rs)  where aux (V3 x y z) = (_x._w .~ x) . (_y._w .~ y) . (_z._w .~ z) $ rs-       -- (.~) :: (forall f. Functor f => (a -> f b) -> s -> f t) -> b -> s -> t-       (.~) :: ((a -> Identity b) -> s -> Identity t) -> b -> s -> t-       l .~ x = runIdentity . l (const $ Identity x)-       infixr 4 .~-       -- (^.) :: s -> (forall f. Functor f => (a -> f b) -> s -> f t) -> a-       (^.) :: s -> ((a -> Const a a) -> s -> Const a s) -> a-       x ^. l = getConst $ l Const x-       infixl 8 ^.  -- translation :: (R3 t, R4 v, Functor f, Functor t) => (V3 a -> f (V3 a)) -> t (v a) -> f (t a) -- translation = (. fmap (^._w)) . _xyz where --   x ^. l = getConst (l Const x)+-}  -- |2x2 matrix determinant. --@@ -272,3 +286,4 @@         cofactor (q,r,s,t) = det22 (V2 (V2 q r) (V2 s t))         det = det33 m {-# INLINE inv33 #-}+
src/Linear/Plucker.hs view
@@ -1,5 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GADTs #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}@@ -37,16 +40,18 @@   , p10,      p12, p13   , p20, p21,      p23   , p30, p31, p32++  , e01, e02, e03, e12, e31, e23   ) where  import Control.Applicative+import Control.Lens hiding (index, (<.>)) import Data.Distributive import Data.Foldable as Foldable import Data.Functor.Bind+import Data.Functor.Rep import Data.Semigroup import Data.Semigroup.Foldable-import Data.Semigroup.Traversable-import Data.Traversable import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..))@@ -57,7 +62,6 @@ import GHC.Generics (Generic1) #endif -import Linear.Core import Linear.Epsilon import Linear.Metric import Linear.V2@@ -132,9 +136,12 @@                          (fmap (\(Plucker _ _ _ _ _ x) -> x) f)   {-# INLINE distribute #-} -instance Core Plucker where-  core f = Plucker (f p01) (f p02) (f p03) (f p23) (f p31) (f p12)-  {-# INLINE core #-}+instance Representable Plucker where+  type Rep Plucker = E Plucker+  tabulate f = Plucker (f e01) (f e02) (f e03) (f e23) (f e31) (f e12)+  {-# INLINE tabulate #-}+  index xs (E l) = view l xs+  {-# INLINE index #-}  instance Foldable Plucker where   foldMap g (Plucker a b c d e f) =@@ -268,7 +275,7 @@ -- 'p31' :: Lens' ('Plucker' a) a -- 'p12' :: Lens' ('Plucker' a) a -- @-p01, p02, p03, p23, p31, p12 :: Functor f => (a -> f a) -> Plucker a -> f (Plucker a)+p01, p02, p03, p23, p31, p12 :: Lens' (Plucker a) a p01 g (Plucker a b c d e f) = (\a' -> Plucker a' b c d e f) <$> g a p02 g (Plucker a b c d e f) = (\b' -> Plucker a b' c d e f) <$> g b p03 g (Plucker a b c d e f) = (\c' -> Plucker a b c' d e f) <$> g c@@ -309,6 +316,40 @@ anti :: (Functor f, Num a) => ((a -> f a) -> r) -> (a -> f a) -> r anti k f = k (fmap negate . f . negate) +e01, e02, e03, e23, e31, e12 :: E Plucker+e01 = E p01+e02 = E p02+e03 = E p03+e23 = E p23+e31 = E p31+e12 = E p12++instance FunctorWithIndex (E Plucker) Plucker where+  imap f (Plucker a b c d e g) = Plucker (f e01 a) (f e02 b) (f e03 c) (f e23 d) (f e31 e) (f e12 g)+  {-# INLINE imap #-}++instance FoldableWithIndex (E Plucker) Plucker where+  ifoldMap f (Plucker a b c d e g) = f e01 a `mappend` f e02 b `mappend` f e03 c+                           `mappend` f e23 d `mappend` f e31 e `mappend` f e12 g+  {-# INLINE ifoldMap #-}++instance TraversableWithIndex (E Plucker) Plucker where+  itraverse f (Plucker a b c d e g) = Plucker <$> f e01 a <*> f e02 b <*> f e03 c+                                              <*> f e23 d <*> f e31 e <*> f e12 g+  {-# INLINE itraverse #-}++type instance Index (Plucker a) = E Plucker+type instance IxValue (Plucker a) = a++#if MIN_VERSION_lens(4,0,0)+instance Ixed (Plucker a) where+  ix = el+#else+instance Functor f => Ixed f (Plucker a) where+  ix i f = el i (indexed f i)+#endif++ -- | Valid Plücker coordinates @p@ will have @'squaredError' p '==' 0@ -- -- That said, floating point makes a mockery of this claim, so you may want to use 'nearZero'.@@ -353,7 +394,7 @@ -- | Check how two lines pass each other. @passes l1 l2@ describes -- @l2@ when looking down @l1@. passes :: (Epsilon a, Num a, Ord a) => Plucker a -> Plucker a -> LinePass-passes a b +passes a b   | nearZero s = Coplanar   | s > 0 = Counterclockwise   | otherwise = Clockwise@@ -433,3 +474,4 @@ {-# INLINE isLine #-}  -- TODO: drag some more stuff out of my thesis+
src/Linear/Quaternion.hs view
@@ -1,5 +1,10 @@-{-# LANGUAGE DeriveDataTypeable, PatternGuards, ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} {-# LANGUAGE DeriveGeneric #-}@@ -19,6 +24,7 @@   ( Quaternion(..)   , Complicated(..)   , Hamiltonian(..)+  , ee, ei, ej, ek   , slerp   , asinq   , acosq@@ -33,12 +39,13 @@   ) where  import Control.Applicative+import Control.Lens hiding ((<.>)) import Data.Complex (Complex((:+))) import Data.Data import Data.Distributive-import Data.Traversable import Data.Foldable import Data.Functor.Bind+import Data.Functor.Rep import GHC.Arr (Ix(..)) import qualified Data.Foldable as F import Data.Monoid@@ -50,7 +57,6 @@ #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) #endif-import Linear.Core import Linear.Epsilon import Linear.Conjugate import Linear.Metric@@ -129,10 +135,36 @@       inRange (l1,u1) i1 && inRange (l2,u2) i2     {-# INLINE inRange #-} -instance Core Quaternion where-  core f = Quaternion (f _e) (V3 (f _i) (f _j) (f _k))-  {-# INLINE core #-}+instance Representable Quaternion where+  type Rep Quaternion = E Quaternion+  tabulate f = Quaternion (f ee) (V3 (f ei) (f ej) (f ek))+  {-# INLINE tabulate #-}+  index xs (E l) = view l xs+  {-# INLINE index #-} +instance FunctorWithIndex (E Quaternion) Quaternion where+  imap f (Quaternion a (V3 b c d)) = Quaternion (f ee a) $ V3 (f ei b) (f ej c) (f ek d)+  {-# INLINE imap #-}++instance FoldableWithIndex (E Quaternion) Quaternion where+  ifoldMap f (Quaternion a (V3 b c d)) = f ee a `mappend` f ei b `mappend` f ej c `mappend` f ek d+  {-# INLINE ifoldMap #-}++instance TraversableWithIndex (E Quaternion) Quaternion where+  itraverse f (Quaternion a (V3 b c d)) = Quaternion <$> f ee a <*> (V3 <$> f ei b <*> f ej c <*> f ek d)+  {-# INLINE itraverse #-}++type instance Index (Quaternion a) = E Quaternion+type instance IxValue (Quaternion a) = a++#if MIN_VERSION_lens(4,0,0)+instance Ixed (Quaternion a) where+  ix = el+#else+instance Functor f => Ixed f (Quaternion a) where+  ix i f = el i (indexed f i)+#endif+ instance Foldable Quaternion where   foldMap f (Quaternion e v) = f e `mappend` foldMap f v   {-# INLINE foldMap #-}@@ -220,17 +252,12 @@  -- | A vector space that includes the basis elements '_e' and '_i' class Complicated t where-  -- |-  -- @-  -- '_e' :: Lens' (t a) a-  -- @-  _e :: Functor f => (a -> f a) -> t a -> f (t a)-  -- |-  -- @-  -- '_i' :: Lens' (t a) a-  -- @-  _i :: Functor f => (a -> f a) -> t a -> f (t a)+  _e, _i :: Lens' (t a) a +ee, ei :: Complicated t => E t+ee = E _e+ei = E _i+ instance Complicated Complex where   _e f (a :+ b) = (:+ b) <$> f a   {-# INLINE _e #-}@@ -245,22 +272,13 @@  -- | A vector space that includes the basis elements '_e', '_i', '_j' and '_k' class Complicated t => Hamiltonian t where-  -- |-  -- @-  -- '_j' :: Lens' (t a) a-  -- @-  _j :: Functor f => (a -> f a) -> t a -> f (t a)-  -- |-  -- @-  -- '_k' :: Lens' (t a) a-  -- @-  _k :: Functor f => (a -> f a) -> t a -> f (t a)-  -- |-  -- @-  -- '_ijk' :: Lens' (t a) (V3 a)-  -- @-  _ijk :: Functor f => (V3 a -> f (V3 a)) -> t a -> f (t a)+  _j, _k :: Lens' (t a) a+  _ijk :: Lens' (t a) (V3 a) +ej, ek :: Hamiltonian t => E t+ej = E _j+ek = E _k+ instance Hamiltonian Quaternion where   _j f (Quaternion a v) = Quaternion a <$> _y f v   {-# INLINE _j #-}@@ -311,7 +329,7 @@   {-# INLINE pi #-}   exp q@(Quaternion e v)     | qiq == 0 = Quaternion (exp e) v-    | ai <- sqrt qiq, ee <- exp e = reimagine (ee * cos ai) (ee * (sin ai / ai)) q+    | ai <- sqrt qiq, exe <- exp e = reimagine (exe * cos ai) (exe * (sin ai / ai)) q     where qiq = qi q   {-# INLINE exp #-}   log q@(Quaternion e v@(V3 _i j k))
src/Linear/V.hs view
@@ -1,7 +1,10 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds, KindSignatures, ScopedTypeVariables, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707@@ -13,6 +16,9 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE DeriveGeneric #-} #endif+#ifndef MIN_VERSION_lens+#define MIN_VERSION_lens(x,y,z) 1+#endif ----------------------------------------------------------------------------- -- | -- Copyright   :  (C) 2012-2013 Edward Kmett,@@ -36,12 +42,13 @@   ) where  import Control.Applicative+import Control.Lens as Lens import Data.Distributive import Data.Foldable as Foldable import Data.Functor.Bind+import Data.Functor.Rep import Data.Proxy import Data.Reflection as R-import Data.Traversable import Data.Vector as V import Foreign.Ptr import Foreign.Storable@@ -57,7 +64,6 @@ #if !(MIN_VERSION_reflection(1,3,0)) import Language.Haskell.TH #endif-import Linear.Core import Linear.Epsilon import Linear.Metric import Linear.Vector@@ -176,11 +182,6 @@   fromRational = pure . fromRational   {-# INLINE fromRational #-} -instance Dim n => Core (V n) where-  core f = V $ generate (reflectDim (Proxy :: Proxy n)) $ \i -> f $ \g (V v) ->-    (\a -> V $ v V.// [(i,a)]) <$> g (unsafeIndex v i)-  {-# INLINE core #-}- instance Dim n => Distributive (V n) where   distribute f = V $ V.generate (reflectDim (Proxy :: Proxy n)) $ \i -> fmap (\(V v) -> unsafeIndex v i) f   {-# INLINE distribute #-}@@ -258,5 +259,26 @@   (q, 0) -> conT ''D  `appT` int q   (q, 1) -> conT ''SD `appT` int q   _     -> error "ghc is bad at math"+#endif++instance Dim n => Representable (V n) where+  type Rep (V n) = E (V n)+  tabulate f = V $ generate (reflectDim (Proxy :: Proxy n)) $ \i -> f $ E $ \g (V v) ->+    (\a -> V $ v V.// [(i,a)]) <$> g (unsafeIndex v i)+  {-# INLINE tabulate #-}+  index xs (E l) = view l xs+  {-# INLINE index #-}++type instance Index (V n a) = E (V n)+type instance IxValue (V n a) = a++#if MIN_VERSION_lens(4,0,0)+instance Ixed (V n a) where+  ix = el+  {-# INLINE ix #-}+#else+instance Functor f => Ixed f (V n a) where+  ix i f = el i (Lens.indexed f i)+  {-# INLINE ix #-} #endif
src/Linear/V0.hs view
@@ -1,14 +1,19 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE Trustworthy #-} #endif+#ifndef MIN_VERSION_lens+#define MIN_VERSION_lens(x,y,z) 1+#endif ----------------------------------------------------------------------------- -- |--- Copyright   :  (C) 2012-2013 Edward Kmett,+-- Copyright   :  (C) 2012-2013 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -22,21 +27,21 @@   ) where  import Control.Applicative+import Control.Lens import Data.Data import Data.Distributive import Data.Foldable+import Data.Functor.Rep+import Data.Functor.Bind import Data.Ix-import Data.Traversable import Data.Semigroup-import Data.Functor.Bind+import Foreign.Storable (Storable(..)) #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) #endif #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) #endif-import Foreign.Storable (Storable(..))-import Linear.Core import Linear.Metric import Linear.Epsilon import Linear.Vector@@ -132,10 +137,6 @@   dot V0 V0 = 0   {-# INLINE dot #-} -instance Core V0 where-  core _ = V0-  {-# INLINE core #-}- instance Distributive V0 where   distribute _ = V0   {-# INLINE distribute #-}@@ -153,3 +154,35 @@   {-# INLINE poke #-}   peek _ = return V0   {-# INLINE peek #-}++instance FunctorWithIndex (E V0) V0 where+  imap _ V0 = V0+  {-# INLINE imap #-}++instance FoldableWithIndex (E V0) V0 where+  ifoldMap _ V0 = mempty+  {-# INLINE ifoldMap #-}++instance TraversableWithIndex (E V0) V0 where+  itraverse _ V0 = pure V0+  {-# INLINE itraverse #-}++instance Representable V0 where+  type Rep V0 = E V0+  tabulate _ = V0+  {-# INLINE tabulate #-}+  index xs (E l) = view l xs+  {-# INLINE index #-}++type instance Index (V0 a) = E V0+type instance IxValue (V0 a) = a++#if MIN_VERSION_lens(4,0,0)+instance Ixed (V0 a) where+  ix = el+  {-# INLINE ix #-}+#else+instance Functor f => Ixed f (V0 a) where+  ix i f = el i (indexed f i)+  {-# INLINE ix #-}+#endif
src/Linear/V1.hs view
@@ -2,6 +2,8 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -25,17 +27,17 @@ module Linear.V1   ( V1(..)   , R1(..)+  , ex   ) where  import Control.Applicative+import Control.Lens import Data.Data import Data.Distributive import Data.Foldable-import Data.Functor.Identity (Identity(..))-import Data.Traversable-import Data.Semigroup.Foldable-import Data.Semigroup.Traversable import Data.Functor.Bind+import Data.Functor.Rep+import Data.Semigroup.Foldable import Foreign.Storable (Storable) import GHC.Arr (Ix(..)) #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702@@ -44,7 +46,6 @@ #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) #endif-import Linear.Core import Linear.Metric import Linear.Epsilon import Linear.Vector@@ -153,11 +154,11 @@   -- >>> V1 2 & _x .~ 3   -- V1 3   ---  -- @-  -- '_x' :: Lens' (t a) a-  -- @-  _x :: Functor f => (a -> f a) -> t a -> f (t a)+  _x :: Lens' (t a) a +ex :: R1 t => E t+ex = E _x+ instance R1 V1 where   _x f (V1 a) = V1 <$> f a   {-# INLINE _x #-}@@ -166,10 +167,6 @@   _x f (Identity a) = Identity <$> f a   {-# INLINE _x #-} -instance Core V1 where-  core f = V1 (f _x)-  {-# INLINE core #-}- instance Distributive V1 where   distribute f = V1 (fmap (\(V1 x) -> x) f)   {-# INLINE distribute #-}@@ -186,3 +183,35 @@    inRange (V1 l1,V1 u1) (V1 i1) = inRange (l1,u1) i1   {-# INLINE inRange #-}++instance Representable V1 where+  type Rep V1 = E V1+  tabulate f = V1 (f ex)+  {-# INLINE tabulate #-}+  index xs (E l) = view l xs+  {-# INLINE index #-}++instance FunctorWithIndex (E V1) V1 where+  imap f (V1 a) = V1 (f ex a)+  {-# INLINE imap #-}++instance FoldableWithIndex (E V1) V1 where+  ifoldMap f (V1 a) = f ex a+  {-# INLINE ifoldMap #-}++instance TraversableWithIndex (E V1) V1 where+  itraverse f (V1 a) = V1 <$> f ex a+  {-# INLINE itraverse #-}++type instance Index (V1 a) = E V1+type instance IxValue (V1 a) = a++#if MIN_VERSION_lens(4,0,0)+instance Ixed (V1 a) where+  ix = el+  {-# INLINE ix #-}+#else+instance Functor f => Ixed f (V1 a) where+  ix i f = el i (indexed f i)+  {-# INLINE ix #-}+#endif
src/Linear/V2.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} -- {-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702@@ -22,18 +24,19 @@   ( V2(..)   , R1(..)   , R2(..)+  , ex, ey   , perp   ) where  import Control.Applicative+import Control.Lens hiding ((<.>)) import Data.Data import Data.Distributive import Data.Foldable-import Data.Traversable+import Data.Functor.Bind+import Data.Functor.Rep import Data.Semigroup import Data.Semigroup.Foldable-import Data.Semigroup.Traversable-import Data.Functor.Bind import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..))@@ -43,11 +46,10 @@ #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) #endif-import Linear.Core import Linear.Metric import Linear.Epsilon import Linear.Vector-import Linear.V1 (R1(..))+import Linear.V1 (R1(..),ex) import Prelude hiding (sum)  -- $setup@@ -180,6 +182,9 @@   -- @   _xy :: Functor f => (V2 a -> f (V2 a)) -> t a -> f (t a) +ey :: R2 t => E t+ey = E _y+ instance R1 V2 where   _x f (V2 a b) = (`V2` b) <$> f a   {-# INLINE _x #-}@@ -190,10 +195,6 @@   _xy = id   {-# INLINE _xy #-} -instance Core V2 where-  core f = V2 (f _x) (f _y)-  {-# INLINE core #-}- instance Distributive V2 where   distribute f = V2 (fmap (\(V2 x _) -> x) f) (fmap (\(V2 _ y) -> y) f)   {-# INLINE distribute #-}@@ -236,3 +237,36 @@   inRange (V2 l1 l2,V2 u1 u2) (V2 i1 i2) =     inRange (l1,u1) i1 && inRange (l2,u2) i2   {-# INLINE inRange #-}++instance Representable V2 where+  type Rep V2 = E V2+  tabulate f = V2 (f ex) (f ey)+  {-# INLINE tabulate #-}+  index xs (E l) = view l xs+  {-# INLINE index #-}++instance FunctorWithIndex (E V2) V2 where+  imap f (V2 a b) = V2 (f ex a) (f ey b)+  {-# INLINE imap #-}++instance FoldableWithIndex (E V2) V2 where+  ifoldMap f (V2 a b) = f ex a `mappend` f ey b+  {-# INLINE ifoldMap #-}++instance TraversableWithIndex (E V2) V2 where+  itraverse f (V2 a b) = V2 <$> f ex a <*> f ey b+  {-# INLINE itraverse #-}++type instance Index (V2 a) = E V2+type instance IxValue (V2 a) = a++#if MIN_VERSION_lens(4,0,0)+instance Ixed (V2 a) where+  ix = el+  {-# INLINE ix #-}+#else+instance Functor f => Ixed f (V2 a) where+  ix i f = el i (indexed f i)+  {-# INLINE ix #-}+#endif+
src/Linear/V3.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}@@ -21,17 +25,18 @@   , R1(..)   , R2(..)   , R3(..)+  , ex, ey, ez   ) where  import Control.Applicative+import Control.Lens hiding ((<.>)) import Data.Data import Data.Distributive import Data.Foldable import Data.Functor.Bind-import Data.Traversable+import Data.Functor.Rep import Data.Semigroup import Data.Semigroup.Foldable-import Data.Semigroup.Traversable import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..))@@ -41,7 +46,6 @@ #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) #endif-import Linear.Core import Linear.Epsilon import Linear.Metric import Linear.V2@@ -161,6 +165,9 @@   -- @   _xyz :: Functor f => (V3 a -> f (V3 a)) -> t a -> f (t a) +ez :: R3 t => E t+ez = E _z+ instance R1 V3 where   _x f (V3 a b c) = (\a' -> V3 a' b c) <$> f a   {-# INLINE _x #-}@@ -177,10 +184,6 @@   _xyz = id   {-# INLINE _xyz #-} -instance Core V3 where-  core f = V3 (f _x) (f _y) (f _z)-  {-# INLINE core #-}- instance Storable a => Storable (V3 a) where   sizeOf _ = 3 * sizeOf (undefined::a)   {-# INLINE sizeOf #-}@@ -229,3 +232,34 @@     inRange (l1,u1) i1 && inRange (l2,u2) i2 &&     inRange (l3,u3) i3   {-# INLINE inRange #-}++instance Representable V3 where+  type Rep V3 = E V3+  tabulate f = V3 (f ex) (f ey) (f ez)+  {-# INLINE tabulate #-}+  index xs (E l) = view l xs+  {-# INLINE index #-}++instance FunctorWithIndex (E V3) V3 where+  imap f (V3 a b c) = V3 (f ex a) (f ey b) (f ez c)+  {-# INLINE imap #-}++instance FoldableWithIndex (E V3) V3 where+  ifoldMap f (V3 a b c) = f ex a `mappend` f ey b `mappend` f ez c+  {-# INLINE ifoldMap #-}++instance TraversableWithIndex (E V3) V3 where+  itraverse f (V3 a b c) = V3 <$> f ex a <*> f ey b <*> f ez c+  {-# INLINE itraverse #-}++type instance Index (V3 a) = E V3+type instance IxValue (V3 a) = a++#if MIN_VERSION_lens(4,0,0)+instance Ixed (V3 a) where+  ix = el+#else+instance Functor f => Ixed f (V3 a) where+  ix i f = el i (indexed f i)+#endif+
src/Linear/V4.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}@@ -22,17 +26,18 @@   , R2(..)   , R3(..)   , R4(..)+  , ex, ey, ez, ew   ) where  import Control.Applicative+import Control.Lens hiding ((<.>)) import Data.Data import Data.Distributive import Data.Foldable import Data.Functor.Bind+import Data.Functor.Rep import Data.Semigroup import Data.Semigroup.Foldable-import Data.Semigroup.Traversable-import Data.Traversable import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..))@@ -42,7 +47,6 @@ #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) #endif-import Linear.Core import Linear.Epsilon import Linear.Metric import Linear.V2@@ -167,6 +171,9 @@   -- @   _xyzw :: Functor f => (V4 a -> f (V4 a)) -> t a -> f (t a) +ew :: R4 t => E t+ew = E _w+ instance R1 V4 where   _x f (V4 a b c d) = (\a' -> V4 a' b c d) <$> f a   {-# INLINE _x #-}@@ -189,10 +196,6 @@   _xyzw = id   {-# INLINE _xyzw #-} -instance Core V4 where-  core f = V4 (f _x) (f _y) (f _z) (f _w)-  {-# INLINE core #-}- instance Storable a => Storable (V4 a) where   sizeOf _ = 4 * sizeOf (undefined::a)   {-# INLINE sizeOf #-}@@ -254,3 +257,35 @@     inRange (l1,u1) i1 && inRange (l2,u2) i2 &&     inRange (l3,u3) i3 && inRange (l4,u4) i4   {-# INLINE inRange #-}++instance Representable V4 where+  type Rep V4 = E V4+  tabulate f = V4 (f ex) (f ey) (f ez) (f ew)+  {-# INLINE tabulate #-}+  index xs (E l) = view l xs+  {-# INLINE index #-}++instance FunctorWithIndex (E V4) V4 where+  imap f (V4 a b c d) = V4 (f ex a) (f ey b) (f ez c) (f ew d)+  {-# INLINE imap #-}++instance FoldableWithIndex (E V4) V4 where+  ifoldMap f (V4 a b c d) = f ex a `mappend` f ey b `mappend` f ez c `mappend` f ew d+  {-# INLINE ifoldMap #-}++instance TraversableWithIndex (E V4) V4 where+  itraverse f (V4 a b c d) = V4 <$> f ex a <*> f ey b <*> f ez c <*> f ew d+  {-# INLINE itraverse #-}++type instance Index (V4 a) = E V4+type instance IxValue (V4 a) = a++#if MIN_VERSION_lens(4,0,0)+instance Ixed (V4 a) where+  ix = el+#else+instance Functor f => Ixed f (V4 a) where+  ix i f = el i (indexed f i)+#endif++
src/Linear/Vector.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}@@ -19,6 +20,7 @@ ----------------------------------------------------------------------------- module Linear.Vector   ( Additive(..)+  , E(..)   , negated   , (^*)   , (*^)@@ -28,29 +30,32 @@   , basisFor   , kronecker   , outer+  , unit   ) where  import Control.Applicative+import Control.Lens import Data.Complex import Data.Foldable as Foldable (Foldable, forM_, foldl')-import Data.Functor.Identity import Data.HashMap.Lazy as HashMap import Data.Hashable import Data.IntMap as IntMap import Data.Map as Map import Data.Monoid (mempty)+import Data.Traversable (mapAccumL) import Data.Vector as Vector import Data.Vector.Mutable as Mutable-import Data.Traversable (Traversable, traverse, mapAccumL) #ifdef USE_GHC_GENERICS import GHC.Generics #endif import Linear.Instances ()  -- $setup--- >>> import Control.Lens -- >>> import Linear.V2 +-- | Basis element+newtype E t = E { el :: forall x. Lens' (t x) x }+ infixl 6 ^+^, ^-^ infixl 7 ^*, *^, ^/ @@ -382,6 +387,13 @@ -- | Produce a diagonal matrix from a vector. kronecker :: (Traversable t, Num a) => t a -> t (t a) kronecker v = fillFromList (choices $ traverse (\a -> SetOne 0 [a]) v) v++-- | Create a unit vector.+--+-- >>> unit _x :: V2 Int+-- V2 1 0+unit :: (Applicative t, Num a) => Lens' (t a) a -> t a+unit l = runIdentity $ l (Identity . const 1) $ pure 0  fillFromList :: Traversable t => [a] -> t b -> t a fillFromList l = snd . mapAccumL aux l