Cartesian 0.2.0.0 → 0.2.1.0

raw patch · 9 files changed

+309/−274 lines, 9 filesdep ~base

Dependency ranges changed: base

Files

Cartesian.cabal +3/−3
README.md +1/−0
src/Cartesian/Internal/Core.hs +23/−6
src/Cartesian/Internal/Lenses.hs +25/−29
src/Cartesian/Internal/Types.hs +20/−23
src/Cartesian/Plane.hs +175/−107
src/Cartesian/Plane/Lenses.hs +0/−79
src/Cartesian/Plane/Types.hs +47/−5
src/Cartesian/Space/Types.hs +15/−22

Cartesian.cabal view

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             0.2.0.0
+version:             0.2.1.0
 
 -- A short (one-line) description of the package.
 synopsis:            Coordinate systems
@@ -57,10 +57,10 @@   other-modules:       Cartesian.Internal.Types, Cartesian.Internal.Lenses, Cartesian.Internal.Core, Cartesian.Internal.Utils
 
   -- LANGUAGE extensions used by modules in this package.
-  other-extensions:    TemplateHaskell, RankNTypes
+  other-extensions:    TemplateHaskell, RankNTypes, MultiParamTypeClasses, FlexibleInstances
 
   -- Other library packages from which modules are imported.
-  build-depends:       base <= 4.8.1.0,
+  build-depends:       base == 4.*,
                        lens <= 4.13.0.0,
                        template-haskell

README.md view

@@ -13,3 +13,4 @@ ----
 - Use typeclass for Vectors (would save a lot of boilerplate)
 - Allow functions to operate on any Vector-like type (including eg. Complex)
+- Consistent naming scheme (eg. use Vector(2D|3D) or just Vector for both types)

src/Cartesian/Internal/Core.hs view

@@ -21,7 +21,7 @@ --------------------------------------------------------------------------------------------------------------------------------------------
 -- GHC Pragmas
 --------------------------------------------------------------------------------------------------------------------------------------------
-
+{-# LANGUAGE FlexibleInstances #-}
 
 
 
@@ -40,7 +40,7 @@ import Control.Lens ((%~))
 
 import Cartesian.Internal.Types
-import Cartesian.Internal.Lenses
+-- import Cartesian.Internal.Lenses
 
 
 
@@ -49,6 +49,8 @@ --------------------------------------------------------------------------------------------------------------------------------------------
 
 -- | Finds the overlap between two ranges (lower bound, upper bound).
+-- | Yields the overlap of two closed intervals (n ∈ R)
+-- TODO: Normalise intervals (eg. (12, 5) -> (5, 12))
 overlap :: (Ord n) => (n, n) -> (n, n) -> Maybe (n, n)
 overlap (a, b) (c, d)
   | min (a, b) (c, d) /= (a', b') = Just (b', c')
@@ -58,17 +60,17 @@ -- Vectors ---------------------------------------------------------------------------------------------------------------------------------
 
 -- | Applies a function to each component in a vector
-dotmap :: Vector v => (a -> b) -> v a -> v b
+dotmap :: (Vector v, Num a) => (a -> b) -> v a -> v b
 dotmap f v = vzip (const . f) v v
 
 
 -- | Performs component-wise operations
-dotwise :: Vector v => (a -> b -> c) -> v a -> v b -> v c
-dotwise = vzip -- Hmmm. Dotwise isn't really a fold is it?
+dotwise :: (Vector v, Num a) => (a -> b -> c) -> v a -> v b -> v c
+dotwise = vzip
 
 
 -- | Dot product of two vectors
-dot :: (Vector v, Floating f) => v f -> v f -> f
+dot :: (Vector v, Num f) => v f -> v f -> f
 dot a b = vfold (+) 0 $ dotwise (*) a b
 -- dot (Vector x y z) (Vector x' y' z') = (x * x') + (y * y') + (z * z') -- TODO: Refactor with Num instance (?)
 
@@ -82,9 +84,24 @@ magnitude :: (Vector v, Floating f) => v f -> f
 magnitude v = euclidean v v
 
+
+-- |
 mag :: (Vector v, Floating f) => v f -> f
 mag = magnitude
 
+-- Instances -------------------------------------------------------------------------------------------------------------------------------
+
+-- |
+instance (Vector v, Floating f) => Num (v f) where
+  -- TODO: Helper method to reduce boilerplate for component-wise operations
+  (+) = dotwise (+)       --
+  (-) = dotwise (-)       --
+  (*) a b     = undefined -- TODO: Is this really correct?
+  fromInteger = fromScalar . fromInteger             --
+  signum v    = dotmap (/mag v) v      -- TODO: Proper way of implementing this function for vectors
+  abs         = fromScalar . magnitude --
+
+--------------------------------------------------------------------------------------------------------------------------------------------
 
 -- | Angle (in radians) between the positive X-axis and the vector
 -- argument :: (Floating a, Eq a) => Vector a -> a

src/Cartesian/Internal/Lenses.hs view

@@ -10,7 +10,7 @@ 
 -- Created October 31 2015
 
--- TODO | -
+-- TODO | - QuickCheck, performance
 --        -
 
 -- SPEC | -
@@ -21,9 +21,10 @@ --------------------------------------------------------------------------------------------------------------------------------------------
 -- GHC Pragmas
 --------------------------------------------------------------------------------------------------------------------------------------------
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE TemplateHaskell        #-}
+{-# LANGUAGE RankNTypes             #-}
 
 
 
@@ -44,6 +45,7 @@ import Language.Haskell.TH
 
 import Cartesian.Internal.Types
+import Cartesian.Internal.Core
 import Cartesian.Internal.Utils
 
 
@@ -54,20 +56,6 @@ 
 -- Vector ----------------------------------------------------------------------------------------------------------------------------------
 
--- | Focus on the X component
-x :: HasX v f => Lens v v f f
-x = lens getX setX
-
-
--- | Focus on the Y component
-y :: HasY v f => Lens v v f f
-y = lens getY setY
-
-
--- | Focus on the Z component
-z :: HasZ v f => Lens v v f f
-z = lens getZ setZ
-
 -- BoundingBox -----------------------------------------------------------------------------------------------------------------------------
 
 -- TODO: Relative lenses (eg. padding)
@@ -104,42 +92,50 @@                      centre' = box^.centre.axis --
                  in BoundingBox { sizeOf=(box^.size) & axis .~ newsize, centreOf=(box^.centre) & axis .~ (to `towards` negate (newsize*0.5)) } -- TODO: Refactor. And then refactor some more.
 
+-- Lines -----------------------------------------------------------------------------------------------------------------------------------
+
+-- TODO: Use type class (?)
+
+begin :: Lens (Line v) (Line v) v v
+begin = lens (\(Line a _) -> a) (\(Line _ b) a -> Line a b)
+
+end :: Lens (Line v) (Line v) v v
+end = lens (\(Line _ b) -> b) (\(Line a _) b -> Line a b)
+
 --------------------------------------------------------------------------------------------------------------------------------------------
 
-width :: (HasX v f) => Lens (BoundingBox v) (BoundingBox v) f f
+width :: (HasX v f) => SideLens v f
 width = size.x
 
 
-height :: (HasY v f) => Lens (BoundingBox v) (BoundingBox v) f f
+height :: (HasY v f) => SideLens v f
 height = size.y
 
 
-depth :: (HasZ v f) => Lens (BoundingBox v) (BoundingBox v) f f
+depth :: (HasZ v f) => SideLens v f
 depth = size.z
 
 -- So much boilerplate it makes me cry -----------------------------------------------------------------------------------------------------
 
--- type SideLens = (Fractional f, HasX v f) => Lens (BoundingBox v) (BoundingBox v) f f
-
-left :: (Fractional f, HasX v f) => Lens (BoundingBox v) (BoundingBox v) f f
+left :: (HasX v f, Fractional f) => SideLens v f
 left = side x (-)
 
 
-right :: (Fractional f, HasX v f) => Lens (BoundingBox v) (BoundingBox v) f f
+right :: (HasX v f, Fractional f) => SideLens v f
 right = side x (+)
 
 
-bottom :: (Fractional f, HasY v f) => Lens (BoundingBox v) (BoundingBox v) f f
+bottom :: (HasY v f, Fractional f) => SideLens v f
 bottom = side y (-)
 
 
-top :: (Fractional f, HasY v f) => Lens (BoundingBox v) (BoundingBox v) f f
+top :: (HasY v f, Fractional f) => SideLens v f
 top = side y (+)
 
 
-front :: (Fractional f, HasZ v f) => Lens (BoundingBox v) (BoundingBox v) f f
+front :: (HasZ v f, Fractional f) => SideLens v f
 front = side z (-)
 
 
-back :: (Fractional f, HasZ v f) => Lens (BoundingBox v) (BoundingBox v) f f
+back :: (HasZ v f, Fractional f) => SideLens v f
 back = side z (+)

src/Cartesian/Internal/Types.hs view

@@ -24,7 +24,7 @@ {-# LANGUAGE TemplateHaskell        #-}
 {-# LANGUAGE MultiParamTypeClasses  #-}
 {-# LANGUAGE FunctionalDependencies #-}
-
+{-# LANGUAGE RankNTypes             #-}
 
 
 --------------------------------------------------------------------------------------------------------------------------------------------
@@ -37,45 +37,42 @@ --------------------------------------------------------------------------------------------------------------------------------------------
 -- We'll need these
 --------------------------------------------------------------------------------------------------------------------------------------------
-
-
+import Control.Lens (Lens)
 
 
 --------------------------------------------------------------------------------------------------------------------------------------------
 -- Types
 --------------------------------------------------------------------------------------------------------------------------------------------
 
+-- Synonyms --------------------------------------------------------------------------------------------------------------------------------
+
+-- |
+-- type SideLens = (Fractional f, HasX v f) => Lens (BoundingBox v) (BoundingBox v) f f
+type SideLens v f = Lens (BoundingBox v) (BoundingBox v) f f
+
 -- Types -----------------------------------------------------------------------------------------------------------------------------------
 
 -- |
 -- TODO: Anchors (eg. C, N, S, E W and combinations thereof, perhaps represented as relative Vectors)
 data BoundingBox v = BoundingBox { centreOf :: v, sizeOf :: v }
 
+
+-- |
+-- TODO: Use record (eg. from, to) (?)
+data Line v = Line v v
+
 -- Classes ---------------------------------------------------------------------------------------------------------------------------------
 
 -- |
 -- TODO: Use GADT instead (?)
 -- TODO: Reduce boilerplate, figure out deriving, choose interface carefully
+-- TODO: Figure out how to deal with parameter (fromScalar requires a Num constraint on f, maybe use 'subclass')
 class Vector v where
-  vfold :: (f' -> f  -> f')  -> f'  -> v f  -> f'
-  vzip  :: (f  -> f' -> f'') -> v f -> v f' -> v f''
-
-
--- |
-class HasX a f | a -> f where
-  getX :: a -> f
-  setX :: a -> f -> a
-
-
--- |
-class HasY a f | a -> f where
-  getY :: a -> f
-  setY :: a -> f -> a
+  fromScalar :: Num f => f -> v f
+  vfold :: Num f => (f' -> f  -> f')  -> f'  -> v f  -> f'     -- TODO: What's with the Num constraint (not sure what I was thinking)
+  vzip  :: Num f => (f  -> f' -> f'') -> v f -> v f' -> v f''  -- TODO: What's with the Num constraint (not sure what I was thinking)
 
 
--- |
-class HasZ a f | a -> f where
-  getZ :: a -> f
-  setZ :: a -> f -> a
-
--- Instances -------------------------------------------------------------------------------------------------------------------------------
+class HasX a f | a -> f where { x :: Lens a a f f }
+class HasY a f | a -> f where { y :: Lens a a f f }
+class HasZ a f | a -> f where { z :: Lens a a f f }

src/Cartesian/Plane.hs view

@@ -21,7 +21,9 @@ --------------------------------------------------------------------------------------------------------------------------------------------
 -- API
 --------------------------------------------------------------------------------------------------------------------------------------------
-module Cartesian.Plane where
+module Cartesian.Plane (module Cartesian.Plane,
+                        module Cartesian.Plane.Types,
+                        magnitude) where -- TODO: Why do I need to export 'intersect' specifically when I'm already exporting this entire module
 
 
 
@@ -32,111 +34,89 @@ import Data.Ord  (comparing)
 import Data.Complex hiding (magnitude)
 
+import           Control.Monad (when)
+import           Control.Applicative
+
+import           Control.Lens ((^.))
 import qualified Control.Lens as L
 
 -- import Southpaw.Utilities.Utilities (pairwise)
 
+import Cartesian.Internal.Types
+import Cartesian.Internal.Lenses
+import Cartesian.Internal.Core
 
+import Cartesian.Space.Types
+import Cartesian.Plane.Types
 
---------------------------------------------------------------------------------------------------------------------------------------------
--- Types
---------------------------------------------------------------------------------------------------------------------------------------------
---------------------------------------------------------------------------------------------------------------------------------------------
--- |
--- TODO: Rename (?)
-data Vector num = Vector num num deriving (Eq, Show) -- TODO: Constraints on argument types (cf. GADT) (?)
 
 
--- |
-data Line num = Line (Vector num) (Vector num)
-
-
--- |
--- TODO: Rename (eg. 'Shape') (?)
-type Polygon num = [Vector num]
-
-
--- |
-data Linear num = Linear { intercept :: num, slope :: num }
-
-
 --------------------------------------------------------------------------------------------------------------------------------------------
--- |
--- type Domain
-
+-- Functions
+--------------------------------------------------------------------------------------------------------------------------------------------
 
 -- | Determines if a point lies within a polygon using the odd-even method.
 --
 -- TODO: Use epsilon (?)
 -- TODO: How to treat points that lie on an edge
-inside :: Num n => Polygon n -> Vector n -> Bool
-inside (p:olygon) (Vector x y) = undefined
+inside :: Num n => Polygon n -> Vector2D n -> Bool
+inside polygon (Vector2D x y) = undefined
   where
-    lines   = (p:olygon)++[p] -- Close the loop
+    lines   = polygon ++ [head polygon] -- Close the loop
     -- between (Line (Vector ax ay) (Vector bx by)) = _
 
 
+-- |
+-- instance Convertible (Vector2D f, Vector3D f) where
+  -- _
 
---------------------------------------------------------------------------------------------------------------------------------------------
--- Instances
---------------------------------------------------------------------------------------------------------------------------------------------
--- | abs v * signum v == v
-instance (Floating a, Eq a) => Num (Vector a) where
-  -- TODO: Helper method to reduce boilerplate for component-wise operations
-  (+) = dotwise (+)
-  (-) = dotwise (-)
-  (*) = dotwise (*) -- TODO: Is this really correct?
-  fromInteger n = Vector (fromInteger n) 0
-  signum (Vector 0 0) = Vector 0 0
-  signum v@(Vector x y) = Vector (x/mag v) (y/mag v)
-  abs a  = Vector (euclidean a a) 0
 
+-- |
+to3D :: Num f => Vector2D f -> Vector3D f
+to3D (Vector2D x' y') = Vector3D x' y' 0
 
 
---------------------------------------------------------------------------------------------------------------------------------------------
--- Functions
---------------------------------------------------------------------------------------------------------------------------------------------
--- Vector math ------------------------------------------------------------------------------------
--- | Performs component-wise operations
-dotwise :: (a -> b -> c) -> Vector a -> Vector b -> Vector c
-dotwise f (Vector x y) (Vector x' y') = Vector (f x x') (f y y')
+-- |
+from3D :: Num f => Vector3D f -> Vector2D f
+from3D (Vector3D x' y' _) = Vector2D x' y'
 
 
--- | Dot product of two vectors
-dot :: Floating a => Vector a -> Vector a -> a
-dot (Vector x y) (Vector x' y') = (x * x') + (y * y') -- TODO: Refactor with Num instance (?)
+-- | Perform some unary operation on a 2D vector as a 3D vector, converting the result back to 2D by discarding the z component.
+-- TODO: Rename (?)
+-- TODO: Loosen Num restriction (eg. to anything with a 'zero' value) (?)
+in3D :: (Num f, Num f') => (Vector3D f -> Vector3D f') -> Vector2D f -> Vector2D f'
+in3D f = from3D . f . to3D
 
 
--- | Euclidean distance between two points
-euclidean :: Floating a => Vector a -> Vector a -> a
-euclidean a b = sqrt $ dot a b
+-- | Same as in3D, but for binary operations.
+-- _ :: _
+-- _
 
 
--- |
-magnitude :: (Floating a, Eq a) => Vector a -> a
-magnitude v = euclidean v v
 
-mag :: (Floating a, Eq a) => Vector a -> a
-mag = magnitude
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Functions
+--------------------------------------------------------------------------------------------------------------------------------------------
 
+-- Vector math -----------------------------------------------------------------------------------------------------------------------------
 
 -- | Angle (in radians) between the positive X-axis and the vector
-argument :: (Floating a, Eq a) => Vector a -> a
-argument (Vector 0 0) = 0
-argument (Vector x y) = atan $ y/x
-
-
-arg :: (Floating a, Eq a) => Vector a -> a
-arg = argument
-
-
--- | Vector -> (magnitude, argument)
-polar :: (Floating a, Eq a) => Vector a -> (a, a)
-polar v@(Vector x y) = (magnitude v, argument v)
+-- argument :: (Floating a, Eq a) => Vector a -> a
+-- argument (Vector 0 0) = 0
+-- argument (Vector x y) = atan $ y/x
+--
+--
+-- arg :: (Floating a, Eq a) => Vector a -> a
+-- arg = argument
+--
+--
+-- -- | Vector -> (magnitude, argument)
+-- polar :: (Floating a, Eq a) => Vector a -> (a, a)
+-- polar v@(Vector x y) = (magnitude v, argument v)
 
+-- Geometry --------------------------------------------------------------------------------------------------------------------------------
 
--- Geometry ---------------------------------------------------------------------------------------
--- | Yields the point at which two finite lines intersect. The lines are defined inclusively by
+-- | Yields the intersection point of two finite lines. The lines are defined inclusively by
 --   their endpoints. The result is wrapped in a Maybe value to account for non-intersecting
 --   lines.
 --
@@ -148,41 +128,129 @@ -- TODO: Intersect for curves (functions) and single points (?)
 -- TODO: Polymorphic, typeclass (lines, shapes, ranges, etc.) (?)
 --
-intersect :: RealFrac n => Line n -> Line n -> Maybe (Vector n)
-intersect a b
-  | (fst $ deltas a) == 0 = Just $ error "Not implemented"
-  | (fst $ deltas b) == 0 = Just $ error "Not implemented"
-  | slope a == slope b = Nothing
-  | otherwise          = Nothing
-  where deltas (Line (Vector ax ay) (Vector bx by)) = (bx - ax, by - ay) -- TODO: Rename (eg. deltas) (?)
-        vertical (Line (Vector ax _) (Vector bx _)) =  ax == bx
-        slope line     = let (dx, dy) = deltas line in dy/dx
-        intercept line@(Line (Vector x y) _)
-          | vertical line = Nothing
-          | otherwise     = Just $ y - slope line * x
+-- TODO: I'm pretty sure I've finished this function and then misplaced it...
+-- intersect :: RealFrac n => Line n -> Line n -> Maybe (Vector2D n)
+-- intersect a b = do
+--   when ((fst $ deltas a) == 0) $ Just (error "Not implemented")
+--   when ((fst $ deltas b) == 0) $ Just (error "Not implemented")
+--   when (slope a == slope b)    $ Nothing
+--   let Just $ Vector2D () ()
+--   where
+--     deltas   (Line (Vector2D ax ay) (Vector2D bx by)) = (bx - ax, by - ay) -- TODO: Rename (eg. deltas) (?)
+--     vertical (Line (Vector2D ax _) (Vector2D bx _))   =  ax == bx
+--     slope line     = let (dx, dy) = deltas line in dy/dx
+--     intercept line@(Line (Vector x y) _)
+--       | vertical line = Nothing
+--       | otherwise     = Just $ y - slope line * x
 
+-- Linear functions ------------------------------------------------------------------------------------------------------------------------
 
--- Geometry ---------------------------------------------------------------------------------------
 -- |
+-- TODO: Refactor
+-- TODO: Invariants, check corner cases
+-- TODO: Deal with vertical lines
+-- TODO: Factor out infinite-line logic
+-- TODO: Decide how to deal with identical lines
+-- TODO: Factor out domain logic (eg. write restrict or domain function)
+-- TODO: Visual debugging functions
+intersect :: RealFloat f => Line (Vector2D f) -> Line (Vector2D f) -> Maybe (Vector2D f)
+intersect f' g' = do
+  p <- mp
+  indomain f' p
+  indomain g' p
+  where
+    -- indomain :: RealFloat f => Line (Vector2D f) -> Vector2D f -> Maybe (Vector2D f)
+    indomain h' = restrict (h'^.begin) (h'^.end)
+
+    -- mp :: Maybe (Vector2D f)
+    mp = case [linear f', linear g'] of
+      [Just f, Nothing] -> let x' = g'^.begin.x in Just $ Vector2D (x') (plotpoint f x')
+      [Nothing, Just g] -> let x' = f'^.begin.x in Just $ Vector2D (x') (plotpoint g x')
+      [Just f,  Just g] -> linearIntersect f g
+      _                 -> Nothing
+
+
+-- | Gives the linear function overlapping the given segment
+linear :: RealFloat f => Line (Vector2D f) -> Maybe (Linear f)
+linear line = Linear <$> intercept line <*> slope line
+
+
+-- | Applies a linear function to the given value
+-- TODO: Rename (?)
+plotpoint :: RealFloat f => Linear f -> f -> f
+plotpoint f x = slopeOf f*x + interceptOf f
+
+
+-- | Finds the intersection (if any) of two linear functions
+linearIntersect :: RealFloat f => Linear f -> Linear f -> Maybe (Vector2D f)
+linearIntersect f g
+  | slopeOf f == slopeOf g  = Nothing
+  | otherwise = let x = (a-α)/(β-b) in Just $ Vector2D x (a*x + b)
+  where
+    [a, α] = map interceptOf [f, g]
+    [b, β] = map slopeOf [f, g]
+
+
+-- |
+slope :: RealFloat f => Line (Vector2D f) -> Maybe f
+slope (Line fr to)
+  | dx == 0   = Nothing
+  | otherwise = Just $ dy/dx
+  where
+    (Vector2D dx dy) = to - fr
+
+
+-- |
+intercept :: RealFloat f => Line (Vector2D f) -> Maybe f
+intercept line = do
+  slope' <- slope line
+  return $ y' - slope'*x'
+  where
+    (x', y') = (line^.begin.x, line^.begin.y)
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+-- |
+between :: Ord a => a -> a -> a -> Bool
+between mini maxi a = mini <= a && a <= maxi
+
+
+-- | Ensures that a given point lies within the domain and codomain
+-- TODO: Let this function work on scalars, write another function for domain and codomain (?)
+-- restrict domain codomain p = _
+restrict :: (Num f, Ord f) => Vector2D f -> Vector2D f -> Vector2D f -> Maybe (Vector2D f)
+restrict a b p@(Vector2D x y)
+  | indomain && incodomain = Just p
+  | otherwise              = Nothing
+  where
+    (Vector2D lowx lowy)   = dotwise min a b
+    (Vector2D highx highy) = dotwise max a b
+    indomain   = between lowx highx x
+    incodomain = between lowy highy y
+
+-- Geometry --------------------------------------------------------------------------------------------------------------------------------
+
+-- |
 -- inside :: (Num n, Ord n) => Triangle n -> Point n -> Bool
 -- inside _ _ = False
 
 
 -- |
-intersects :: RealFrac r => Line r -> Line r -> Bool
-intersects a b = case intersect a b of
-  Just _  -> True
-  Nothing -> False
+-- intersects :: RealFrac r => Line r -> Line r -> Bool
+-- intersects a b = case intersect a b of
+--   Just _  -> True
+--   Nothing -> False
 
 
--- | Yields the overlap of two closed intervals (n ∈ R)
--- TODO: Normalise intervals (eg. (12, 5) -> (5, 12))
-overlap :: Real a => (a, a) -> (a, a) -> Maybe (a, a)
-overlap a b
-  | leftmost /= (α, β) = Just (β, γ) --
-  | otherwise          = Nothing     --
-  where [α, β, γ, _] = sort [fst a, snd a, fst b, snd b] -- That's right.
-        leftmost     = minimumBy (comparing fst) [a, b]  --
+-- -- | Yields the overlap of two closed intervals (n ∈ R)
+-- -- TODO: Normalise intervals (eg. (12, 5) -> (5, 12))
+-- overlap :: Real a => (a, a) -> (a, a) -> Maybe (a, a)
+-- overlap a b
+--   | leftmost /= (α, β) = Just (β, γ) --
+--   | otherwise          = Nothing     --
+--   where
+--     [α, β, γ, _] = sort [fst a, snd a, fst b, snd b] -- That's right.
+--     leftmost     = minimumBy (comparing fst) [a, b]  --
 
 
 -- |
@@ -196,17 +264,17 @@ -- TODO: Use Maybe (?)
 -- TODO: Rename (eg. toLinear, function) (?)
 --
-coefficients :: (Fractional a, Eq a) => Line a -> Maybe (a, a)
-coefficients (Line (Vector ax ay) (Vector bx by))
-  | ax == bx  = Nothing
-  | ay == ay  = Nothing
-  | otherwise = let slope' = (by - ay)/(bx - ax) in Just (slope', ay - slope'*ax)
+-- coefficients :: (Fractional a, Eq a) => Line a -> Maybe (a, a)
+-- coefficients (Line (Vector ax ay) (Vector bx by)) = do
+-- 	when (ax == bx) Nothing
+-- 	when (ay == ay) Nothing
+-- 	let slope' = (by - ay)/(bx - ax) in Just (slope', ay - slope'*ax)
 
+-- Linear functions ------------------------------------------------------------------------------------------------------------------------
 
--- Linear functions -------------------------------------------------------------------------------
 -- | Solves a linear equation for x (f(x) = g(x))
 -- TODO: Use Epsilon (?)
-solve :: (Fractional n, Eq n) => Linear n -> Linear n -> Maybe n
-solve f g
-  | slope f == slope g = Nothing
-  | otherwise          = Just $ (intercept f - intercept g)/(slope f - slope g)
+-- solve :: (Fractional n, Eq n) => Linear n -> Linear n -> Maybe n
+-- solve f g
+--   | slope f == slope g = Nothing
+--   | otherwise          = Just $ (intercept f - intercept g)/(slope f - slope g)

src/Cartesian/Plane/Lenses.hs view

@@ -46,82 +46,3 @@ --------------------------------------------------------------------------------------------------------------------------------------------
 -- Lenses
 --------------------------------------------------------------------------------------------------------------------------------------------
-
--- |
--- TODO: Make sure invariants remain true (eg. left < right)
--- TODO: Make coordinate-system independent (eg. direction of axes)
-makeBoundingBoxSideLens :: RealFloat f => (BoundingBox f -> f) -> (BoundingBox f -> f -> (f, f, f, f)) -> Lens (BoundingBox f) (BoundingBox f) f f
-makeBoundingBoxSideLens oldside newsides f s@(BoundingBox { _centre=(cx:+cy), _size=(dx:+dy) }) = assemble <$> f (oldside s)
-  where
-    assemble newside = let (nleft, nright, ntop, nbottom) = newsides s newside
-                           newsize                        = (nright-nleft):+(nbottom-ntop)
-                       in BoundingBox { _centre=(nleft:+ntop)+(newsize*(0.5:+0.0)), _size=newsize }
-
--- Core lenses -----------------------------------------------------------------------------------------------------------------------------
-
--- |
-centre :: RealFloat f => Lens (BoundingBox f) (BoundingBox f) (Complex f) (Complex f)
-centre f s = let assemble new = s { _centre=new } in assemble <$> f (_centre s)
-
-
--- |
-size :: RealFloat f => Lens (BoundingBox f) (BoundingBox f) (Complex f) (Complex f)
-size f s = let assemble new = s { _size=new } in assemble <$> f (_size s)
-
--- Side lenses (absolute) ------------------------------------------------------------------------------------------------------------------
-
--- |
-left :: RealFloat f => Lens (BoundingBox f) (BoundingBox f) f f
-left = makeBoundingBoxSideLens
-         (\(BoundingBox { _centre=cx:+_,  _size=dx:+_  }) -> cx - dx/2)
-         (\(BoundingBox { _centre=cx:+cy, _size=dx:+dy }) newside -> (newside, cx+dx/2, cy-dy/2, cy+dy/2))
-
-
--- |
-right :: RealFloat f => Lens (BoundingBox f) (BoundingBox f) f f
-right = makeBoundingBoxSideLens
-          (\(BoundingBox { _centre=cx:+_,  _size=dx:+_  })         -> cx + dx/2)
-          (\(BoundingBox { _centre=cx:+cy, _size=dx:+dy }) newside -> (cx-dx/2, newside, cy-dy/2, cy+dy/2))
-
-
--- |
-top :: RealFloat f => Lens (BoundingBox f) (BoundingBox f) f f
-top = makeBoundingBoxSideLens
-        (\(BoundingBox { _centre=_:+cy,  _size=_:+dy  }) -> cy - dy/2)
-        (\(BoundingBox { _centre=cx:+cy, _size=dx:+dy }) newside -> (cx-dx/2, cx+dx/2, newside, cy+dy/2))
-
-
--- |
-bottom :: RealFloat f => Lens (BoundingBox f) (BoundingBox f) f f
-bottom = makeBoundingBoxSideLens
-           (\(BoundingBox { _centre=_:+cy,  _size=_:+dy  }) -> cy + dy/2)
-           (\(BoundingBox { _centre=cx:+cy, _size=dx:+dy }) newside -> (cx-dx/2, cx+dx/2, cy-dy/2, newside))
-
--- Side lenses (relative) ------------------------------------------------------------------------------------------------------------------
-
--- |
-leftpad :: RealFloat f => Lens (BoundingBox f) (BoundingBox f) f f
-leftpad = makeBoundingBoxSideLens
-            (\(BoundingBox { _centre=cx:+_,  _size=dx:+_  }) -> cx - dx/2)
-            (\(BoundingBox { _centre=cx:+cy, _size=dx:+dy }) newside -> (cx-dx/2+newside, cx+dx/2, cy-dy/2, cy+dy/2))
-
-
--- |
-rightpad :: RealFloat f => Lens (BoundingBox f) (BoundingBox f) f f
-rightpad = makeBoundingBoxSideLens
-             (\(BoundingBox { _centre=cx:+_,  _size=dx:+_  })         -> cx + dx/2)
-             (\(BoundingBox { _centre=cx:+cy, _size=dx:+dy }) newside -> (cx-dx/2, cx+dx/2+newside, cy-dy/2, cy+dy/2))
-
-
--- |
-toppad :: RealFloat f => Lens (BoundingBox f) (BoundingBox f) f f
-toppad = makeBoundingBoxSideLens
-          (\(BoundingBox { _centre=_:+cy,  _size=_:+dy  }) -> cy - dy/2)
-          (\(BoundingBox { _centre=cx:+cy, _size=dx:+dy }) newside -> (cx-dx/2, cx+dx/2, cy-dy/2+newside, cy+dy/2))
-
-
--- |
-bottompad :: RealFloat f => Lens (BoundingBox f) (BoundingBox f) f f
-bottompad = makeBoundingBoxSideLens
-              (\(BoundingBox { _centre=_:+cy,  _size=_:+dy  }) -> cy + dy/2)
-              (\(BoundingBox { _centre=cx:+cy, _size=dx:+dy }) newside -> (cx-dx/2, cx+dx/2, cy-dy/2, cy+dy/2+newside))

src/Cartesian/Plane/Types.hs view

@@ -21,15 +21,18 @@ --------------------------------------------------------------------------------------------------------------------------------------------
 -- GHC Directives
 --------------------------------------------------------------------------------------------------------------------------------------------
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE RankNTypes      #-}
+{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances     #-}
 
 
 
 --------------------------------------------------------------------------------------------------------------------------------------------
 -- API
 --------------------------------------------------------------------------------------------------------------------------------------------
-module Cartesian.Plane.Types where
+module Cartesian.Plane.Types (module Cartesian.Plane.Types,
+                              module Cartesian.Internal.Types) where
 
 
 
@@ -39,17 +42,56 @@ import Data.Complex
 import Control.Lens
 
+import Cartesian.Internal.Types
+import Cartesian.Space.Types
 
 
+
 --------------------------------------------------------------------------------------------------------------------------------------------
 -- Types
 --------------------------------------------------------------------------------------------------------------------------------------------
 
 -- |
--- TODO: Anchors (eg. C, N, S, E W and combinations thereof, perhaps represented as relative Vectors)
-data BoundingBox f = BoundingBox { _centre :: Complex f, _size :: Complex f } deriving (Show)
+-- type Domain
 
 
 -- |
+-- TODO: Rename (?)
+data Vector2D f = Vector2D f f deriving (Eq, Show) -- TODO: Constraints on argument types (cf. GADT) (?)
+
+
+-- |
+-- TODO: Rename (eg. 'Shape') (?)
+type Polygon f = [Vector2D f]
+
+
+-- |
+data Linear f = Linear { interceptOf :: f, slopeOf :: f }
+
+
+-- |
 -- TODO: Use existing type instead (?)
 -- data Side = SideLeft | SideRight | SideTop | SideBottom
+
+-- Instances -------------------------------------------------------------------------------------------------------------------------------
+
+-- |
+-- TODO: Refactor. A lot.
+instance Vector Vector2D where
+  fromScalar s = Vector2D s 0
+  vfold f a (Vector2D x' y')                    = f (f a x') y'
+  vzip  f   (Vector2D x' y') (Vector2D x'' y'') = Vector2D (f x' x'') (f y' y'')
+
+
+instance HasX (Vector2D f) f where
+  x = lens
+        (\(Vector2D x' _)     -> x')
+        (\(Vector2D _  y') x' -> Vector2D x' y')
+
+instance HasY (Vector2D f) f where
+  y = lens
+        (\(Vector2D _  y')   -> y')
+        (\(Vector2D x' _) y' -> Vector2D x' y')
+
+-- instance HasZ (Vector2D f) f where
+  -- z = lens (const 0) const

src/Cartesian/Space/Types.hs view

@@ -48,44 +48,37 @@ -- Types
 --------------------------------------------------------------------------------------------------------------------------------------------
 
--- |
-data Vector3D f = Vector3D f f f -- TODO: Constraints on argument types (cf. GADT) (?)
-
-
--- |
-data Line f = Line (Vector3D f) (Vector3D f)
-
+--------------------------------------------------------------------------------------------------------------------------------------------
 
 -- |
--- data BoundingBox f = BoundingBox { _centre :: Vector f, _size :: Vector f }
+data Vector3D f = Vector3D f f f -- TODO: Constraints on argument types (cf. GADT) (?)
 
 -- Instances -------------------------------------------------------------------------------------------------------------------------------
 
 -- |
 -- TODO: Refactor. A lot.
 instance Vector Vector3D where
+  fromScalar s = Vector3D s 0 0
   vfold f a (Vector3D x' y' z')                        = f (f (f a x') y') z'
   vzip  f   (Vector3D x' y' z') (Vector3D x'' y'' z'') = Vector3D (f x' x'') (f y' y'') (f z' z'')
 
+
 -- |
-instance (Floating v, Eq v) => Num (Vector3D v) where
-  -- TODO: Helper method to reduce boilerplate for component-wise operations
-  (+) = dotwise (+)
-  (-) = dotwise (-)
-  (*) (Vector3D x y z) (Vector3D x' y' z') = undefined -- TODO: Is this really correct?
-  fromInteger n = Vector3D (fromInteger n) 0 0
-  signum v@(Vector3D x' y' z') = Vector3D (x'/(abs v^.x)) (y'/(abs v^.x)) (z'/(abs v^.x)) -- TODO: Proper way of implementing this function for vectors
-  abs (Vector3D x' y' z')      = Vector3D (sqrt $ (x'**2) + (y'**2) + (z'**2)) (0) (0)
+-- instance (Floating v, Eq v) => Num (Vector3D v) where
+--   -- TODO: Helper method to reduce boilerplate for component-wise operations
+--   (+) = dotwise (+)
+--   (-) = dotwise (-)
+--   (*) (Vector3D x y z) (Vector3D x' y' z') = undefined -- TODO: Is this really correct?
+--   fromInteger x = Vector3D (fromInteger x) 0 0
+--   signum v = dotmap (/mag v) v -- TODO: Proper way of implementing this function for vectors
+--   abs    (Vector3D x' y' z') = Vector3D (sqrt $ (x'**2) + (y'**2) + (z'**2)) (0) (0)
 
 
 instance HasX (Vector3D f) f where
-  getX (Vector3D x' _  _)     = x'
-  setX (Vector3D _  y' z') x' = Vector3D x' y' z'
+  x = lens (\(Vector3D x' _ _) -> x') (\(Vector3D _ y' z') x' -> Vector3D x' y' z')
 
 instance HasY (Vector3D f) f where
-  getY (Vector3D y' _ _)     = y'
-  setY (Vector3D x' _ z') y' = Vector3D x' y' z'
+  y = lens (\(Vector3D _ y' _) -> y') (\(Vector3D x' _ z') y' -> Vector3D x' y' z')
 
 instance HasZ (Vector3D f) f where
-  getZ (Vector3D z' _  _)    = z'
-  setZ (Vector3D x' y' _) z' = Vector3D x' y' z'
+  z = lens (\(Vector3D _ _ z') -> z') (\(Vector3D x' y' _) z' -> Vector3D x' y' z')