packages feed

linear 1.2 → 1.3

raw patch · 8 files changed

+248/−24 lines, 8 filesdep +HUnitdep +lineardep +test-frameworkdep ~base

Dependencies added: HUnit, linear, test-framework, test-framework-hunit

Dependency ranges changed: base

Files

linear.cabal view
@@ -1,6 +1,6 @@ name:          linear category:      Math, Algebra-version:       1.2+version:       1.3 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -80,3 +80,16 @@     filepath  >= 1.3 && < 1.4,     lens      >= 3.8.4,     simple-reflect >= 0.3.1++test-suite UnitTests+  type:           exitcode-stdio-1.0+  main-is:        UnitTests.hs+  other-modules:  Plucker+  ghc-options:    -Wall -Werror -threaded+  hs-source-dirs: tests+  build-depends:+    base,+    test-framework >= 0.8,+    test-framework-hunit >= 0.3,+    HUnit >= 1.2.5,+    linear
src/Linear.hs view
@@ -16,7 +16,6 @@   , module Linear.Epsilon   , module Linear.Matrix   , module Linear.Metric-  , module Linear.Plucker   , module Linear.Quaternion   , module Linear.Trace   , module Linear.V0@@ -33,7 +32,6 @@ import Linear.Instances () import Linear.Matrix import Linear.Metric-import Linear.Plucker import Linear.Quaternion import Linear.Trace import Linear.V0
src/Linear/Core.hs view
@@ -12,8 +12,11 @@ ---------------------------------------------------------------------------- module Linear.Core   ( Core(..)+  , incore   ) where +import Control.Applicative+ -- | -- 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@@ -21,4 +24,28 @@ -- 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. 'Control.Lens.Lens' (f x) x) -> a) -> f a+  -- @   core :: ((forall g x. Functor g => (x -> g x) -> f x -> g (f x)) -> a) -> f a++data Context a b t = Context { peek :: b -> t, pos :: a }++instance Functor (Context a b) where+  fmap f (Context bt a) = Context (f.bt) a++view :: ((a -> Const a b) -> s -> Const a t) -> s -> a+view l = getConst . l Const++-- | This is a generalization of 'Control.Lens.inside' to work over any corepresentable 'Functor'.+--+-- @+-- 'incore' :: 'Core' f => 'Lens' s t a b -> 'Lens' (f s) (f t) (f a) (f b)+-- @+incore :: (Functor g, Core f) => ((a -> Context a b b) -> s -> Context a b t) -> (f a -> g (f b)) -> f s -> g (f t)+incore 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/Matrix.hs view
@@ -29,6 +29,7 @@ import Control.Applicative import Data.Distributive import Data.Foldable as Foldable+import Data.Functor.Identity import Linear.Epsilon import Linear.Quaternion import Linear.V2@@ -197,10 +198,26 @@           (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 where-  x ^. l = getConst (l Const x)+-- 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)+ 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. --
src/Linear/Plucker.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GADTs #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif@@ -20,7 +21,16 @@   , isotropic   , (><)   , plucker+  , plucker3D+  -- * Operations on lines+  , parallel   , intersects+  , LinePass(..)+  , passes+  , quadranceToOrigin+  , closestToOrigin+  , isLine+  , Coincides(..)   -- * Basis elements   ,      p01, p02, p03   , p10,      p12, p13@@ -42,6 +52,8 @@ import Linear.Core import Linear.Epsilon import Linear.Metric+import Linear.V2+import Linear.V3 import Linear.V4 import Linear.Vector @@ -202,19 +214,35 @@     where ptr' = castPtr ptr   {-# INLINE peek #-} --- | Given a pair of points represented by homogeneous coordinates generate Plücker coordinates--- for the line through them.+instance Metric Plucker where+  dot (Plucker a b c d e f) (Plucker g h i j k l) = a*g+b*h+c*i+d*j+e*k+f*l+  {-# INLINE dot #-}++instance Epsilon a => Epsilon (Plucker a) where+  nearZero = nearZero . quadrance+  {-# INLINE nearZero #-}++-- | Given a pair of points represented by homogeneous coordinates+-- generate Plücker coordinates for the line through them, directed+-- from the second towards the first. plucker :: Num a => V4 a -> V4 a -> Plucker a plucker (V4 a b c d)         (V4 e f g h) =   Plucker (a*f-b*e)           (a*g-c*e)-          (a*d-h*e)-          (c*h-d*g)-          (d*f-b*h)           (b*g-c*f)+          (a*h-d*e)+          (b*h-d*f)+          (c*h-d*g) {-# INLINE plucker #-} +-- | Given a pair of 3D points, generate Plücker coordinates for the+-- line through them, directed from the second towards the first.+plucker3D :: Num a => V3 a -> V3 a -> Plucker a+plucker3D p q = Plucker a b c d e f+  where V3 a b c = p - q+        V3 d e f = p `cross` q+ -- | These elements form a basis for the Plücker space, or the Grassmanian manifold @Gr(2,V4)@. -- -- @@@ -276,25 +304,113 @@ -- | This isn't th actual metric because this bilinear form gives rise to an isotropic quadratic space infixl 5 >< (><) :: Num a => Plucker a -> Plucker a -> a-Plucker a b c d e f >< Plucker g h i j k l = a*g+b*h+c*i-d*j-e*k-f*l+Plucker a b c d e f >< Plucker g h i j k l = a*l-b*k+c*j+d*i-e*h+f*g {-# INLINE (><) #-} --- | Checks if the line is near-isotropic (isotropic vectors in this quadratic space represent lines in real 3d space)+-- | Checks if the line is near-isotropic (isotropic vectors in this+-- quadratic space represent lines in real 3d space). isotropic :: Epsilon a => Plucker a -> Bool isotropic a = nearZero (a >< a) {-# INLINE isotropic #-} --- | Checks if the two vectors intersect (or nearly intersect)-intersects :: Epsilon a => Plucker a -> Plucker a -> Bool-intersects a b = nearZero (a >< b)+-- | Checks if two lines intersect (or nearly intersect).+intersects :: (Epsilon a, Ord a) => Plucker a -> Plucker a -> Bool+intersects a b = not (a `parallel` b) && passes a b == Coplanar+-- intersects :: Epsilon a => Plucker a -> Plucker a -> Bool+-- intersects a b = nearZero (a >< b) {-# INLINE intersects #-} -instance Metric Plucker where-  dot (Plucker a b c d e f) (Plucker g h i j k l) = a*g+b*h+c*i+d*j+e*k+f*l-  {-# INLINE dot #-}+-- | Describe how two lines pass each other.+data LinePass = Coplanar+              -- ^ The lines are coplanar (parallel or intersecting).+              | Clockwise+              -- ^ The lines pass each other clockwise (right-handed+              -- screw)+              | Counterclockwise+              -- ^ The lines pass each other counterclockwise+              -- (left-handed screw).+                deriving (Eq, Show) -instance Epsilon a => Epsilon (Plucker a) where-  nearZero = nearZero . quadrance-  {-# INLINE nearZero #-}+-- | 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 +  | nearZero s = Coplanar+  | s > 0 = Counterclockwise+  | otherwise = Clockwise+  where s = (u1 `dot` v2) + (u2 `dot` v1)+        V2 u1 v1 = toUV a+        V2 u2 v2 = toUV b+{-# INLINE passes #-}++-- | Checks if two lines are parallel.+parallel :: Epsilon a => Plucker a -> Plucker a -> Bool+parallel a b = nearZero $ u1 `cross` u2+  where V2 u1 _ = toUV a+        V2 u2 _ = toUV b+{-# INLINE parallel #-}++-- | Represent a Plücker coordinate as a pair of 3-tuples, typically+-- denoted U and V.+toUV :: Plucker a -> V2 (V3 a)+toUV (Plucker a b c d e f) = V2 (V3 a b c) (V3 d e f)++-- | Checks if two lines coincide in space. In other words, undirected equality.+coincides :: (Epsilon a, Fractional a) => Plucker a -> Plucker a -> Bool+coincides p1 p2 = Foldable.all nearZero $ (s *^ p2) - p1+  where s = maybe 1 getFirst . getOption . fold $ saveDiv <$> p1 <*> p2+        saveDiv x y | nearZero y = Option Nothing+                    | otherwise  = Option . Just $ First (x / y)+{-# INLINABLE coincides #-}++-- | Checks if two lines coincide in space, and have the same+-- orientation.+coincides' :: (Epsilon a, Fractional a, Ord a) => Plucker a -> Plucker a -> Bool+coincides' p1 p2 = Foldable.all nearZero ((s *^ p2) - p1) && s > 0+  where s = maybe 1 getFirst . getOption . fold $ saveDiv <$> p1 <*> p2+        saveDiv x y | nearZero y = Option Nothing+                    | otherwise  = Option . Just $ First (x / y)+{-# INLINABLE coincides' #-}++-- | When lines are represented as Plücker coordinates, we have the+-- ability to check for both directed and undirected+-- equality. Undirected equality between 'Line's (or a 'Line' and a+-- 'Ray') checks that the two lines coincide in 3D space. Directed+-- equality, between two 'Ray's, checks that two lines coincide in 3D,+-- and have the same direction. To accomodate these two notions of+-- equality, we use an 'Eq' instance on the 'Coincides' data type.+--+-- For example, to check the /directed/ equality between two lines,+-- @p1@ and @p2@, we write, @Ray p1 == Ray p2@.+data Coincides a where+  Line :: (Epsilon a, Fractional a) => Plucker a -> Coincides a+  Ray  :: (Epsilon a, Fractional a, Ord a) => Plucker a -> Coincides a++instance Eq (Coincides a) where+  Line a == Line b  = coincides a b+  Line a == Ray b   = coincides a b+  Ray a  == Line b  = coincides a b+  Ray a  == Ray b   = coincides' a b++-- | The minimum squared distance of a line from the origin.+quadranceToOrigin :: Fractional a => Plucker a -> a+quadranceToOrigin p = (v `dot` v) / (u `dot` u)+  where V2 u v = toUV p+{-# INLINE quadranceToOrigin #-}++-- | The point where a line is closest to the origin.+closestToOrigin :: Fractional a => Plucker a -> V3 a+closestToOrigin p = normalizePoint $ V4 x y z (u `dot` u)+  where V2 u v = toUV p+        V3 x y z = v `cross` u+{-# INLINE closestToOrigin #-}++-- | Not all 6-dimensional points correspond to a line in 3D. This+-- predicate tests that a Plücker coordinate lies on the Grassmann+-- manifold, and does indeed represent a 3D line.+isLine :: Epsilon a => Plucker a -> Bool+isLine p = nearZero $ u `dot` v+  where V2 u v = toUV p+{-# INLINE isLine #-}  -- TODO: drag some more stuff out of my thesis
src/Linear/V4.hs view
@@ -16,7 +16,7 @@ ---------------------------------------------------------------------------- module Linear.V4   ( V4(..)-  , vector, point+  , vector, point, normalizePoint   , R1(..)   , R2(..)   , R3(..)@@ -204,6 +204,15 @@ point :: Num a => V3 a -> V4 a point (V3 a b c) = V4 a b c 1 {-# INLINE point #-}++-- | Convert 4-dimensional projective coordinates to a 3-dimensional+-- point. This operation may be denoted, @euclidean [x:y:z:w] = (x\/w,+-- y\/w, z\/w)@ where the projective, homogenous, coordinate+-- @[x:y:z:w]@ is one of many associated with a single point @(x\/w,+-- y\/w, z\/w)@.+normalizePoint :: Fractional a => V4 a -> V3 a+normalizePoint (V4 a b c w) = (1/w) *^ V3 a b c+{-# INLINE normalizePoint #-}  instance Epsilon a => Epsilon (V4 a) where   nearZero = nearZero . quadrance
+ tests/Plucker.hs view
@@ -0,0 +1,34 @@+module Plucker (tests) where+import Linear+import Linear.Plucker+import Test.HUnit++ln2,ln3,ln4,ln5,ln6,ln7,ln8,ln9 :: Plucker Float+ln2 = plucker3D (V3 1 3 0) (V3 1 3 (-2))    -- starting line+ln3 = plucker3D (V3 2 3 0) (V3 2 3 (-2))    -- parallel+ln4 = plucker3D (V3 2 4 0) (V3 1 4 (-2))    -- ccw+ln5 = plucker3D (V3 (-2) 4 0) (V3 2 4 (-2)) -- cw+ln6 = plucker3D (V3 2 3 0) (V3 1 3 (-2))    -- intersect+ln7 = plucker3D (V3 1 3 0) (V3 1 3 2)       -- reversed+ln8 = plucker3D (V3 0 4 4) (V3 0 (-4) (-4)) -- through origin+ln9 = Plucker 1 2 3 4 5 6                   -- not a 3D line++tests :: Test+tests = test [ "parallel" ~: parallel ln2 ln3 ~?= True+             , "CCW" ~: passes ln2 ln4 ~?= Counterclockwise +             , "CW" ~: passes ln2 ln5 ~?= Clockwise+             , "intersect1" ~: intersects ln2 ln6 ~?= True +             , "intersect2" ~: intersects ln2 ln3 ~?= False+             , "line equality 1" ~: Line ln2 == Line ln2 ~?= True +             , "line equality 2" ~: Line ln2 == Line ln7 ~?= True +             , "line equality 3" ~: Line ln2 == Ray ln7 ~?= True+             , "line equality 4" ~: Ray ln2 == Line ln7 ~?= True+             , "ray equality 1" ~: Ray ln2 == Ray ln7 ~?= False+             , "ray equality 2" ~: Ray ln2 == Ray (3 *^ ln2) ~?= True+             , "ray equality 3" ~: Ray ln2 == Ray (negate ln7) ~?= True+             , "quadrance" ~: nearZero (quadranceToOrigin ln2 - 10) ~?= True+             , "closest 1" ~: +                 nearZero (qd (V3 1 3 0) $ closestToOrigin ln2) ~?= True+             , "closest 2" ~: nearZero (qd 0 $ closestToOrigin ln8) ~?= True+             , "isLine 1" ~: isLine ln2 ~?= True+             , "isLine 2" ~: isLine ln9 ~?= False ]
+ tests/UnitTests.hs view
@@ -0,0 +1,10 @@+module Main (main) where+import Test.Framework (defaultMain, testGroup, Test)+import Test.Framework.Providers.HUnit+import qualified Plucker++tests :: [Test]+tests = [ testGroup "Plucker" $ hUnitTestToTests Plucker.tests ]++main :: IO ()+main = defaultMain tests