diff --git a/Cartesian.cabal b/Cartesian.cabal new file mode 100644 --- /dev/null +++ b/Cartesian.cabal @@ -0,0 +1,68 @@ +-- Initial Cartesian.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +-- The name of the package. +name: Cartesian + +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +synopsis: Coordinate systems + +-- A longer description of the package. +-- description: + +-- The license under which the package is released. +license: MIT + +-- The file containing the license text. +license-file: LICENSE.md + +-- The package author(s). +author: Jonatan H Sundqvist + +-- An email address to which users can send suggestions, bug reports, and +-- patches. +maintainer: jonatanhsundqvist@gmail.com + +-- A copyright notice. +-- copyright: + +category: Math + +build-type: Simple + +-- Extra files to be distributed with the package, such as examples or a +-- README. +extra-source-files: README.md + +-- Constraint on the version of Cabal needed to build this package. +cabal-version: >=1.10 + + +library + -- Modules exported by the library. + exposed-modules: Cartesian.Lenses, Cartesian.Plane, Cartesian.Space, + Cartesian.Plane.Utilities, Cartesian.Plane.Types, Cartesian.Plane.BoundingBox, Cartesian.Plane.BoundingBox.Lenses + + -- Modules included in this library but not exported. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + other-extensions: TemplateHaskell, RankNTypes + + -- Other library packages from which modules are imported. + build-depends: base <= 4.8.1.0, + lens <= 4.13.0.0 + + -- Directories containing source files. + hs-source-dirs: src + + -- Base language which the package is written in. + default-language: Haskell2010 diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2015 Jonatan H Sundqvist + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +Cartesian +========= + +Functions and types for working with three-dimensional coordinate systems diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Cartesian/Lenses.hs b/src/Cartesian/Lenses.hs new file mode 100644 --- /dev/null +++ b/src/Cartesian/Lenses.hs @@ -0,0 +1,59 @@ +-- | +-- Module : Cartesian.Lenses +-- Description : +-- Copyright : (c) Jonatan H Sundqvist, 2015 +-- License : MIT +-- Maintainer : Jonatan H Sundqvist +-- Stability : experimental|stable +-- Portability : POSIX (not sure) +-- + +-- Created August 30 2015 + +-- TODO | - +-- - + +-- SPEC | - +-- - + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- GHC Pragmas +-------------------------------------------------------------------------------------------------------------------------------------------- +{-# LANGUAGE TemplateHaskell #-} + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- API +-------------------------------------------------------------------------------------------------------------------------------------------- +module Cartesian.Lenses where + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- We'll need these +-------------------------------------------------------------------------------------------------------------------------------------------- +import qualified Control.Lens as L + +import qualified Cartesian.Plane.Types as Plane +-- import qualified Cartesian.Space.Types as Space + +-- import qualified Cartesian.Plane as Plane +-- import qualified Cartesian.Space as Space + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- Invoke the Templates! +-------------------------------------------------------------------------------------------------------------------------------------------- +-------------------------------------------------------------------------------------------------------------------------------------------- +L.makeLenses ''Plane.BoundingBox + + + +-------------------------------------------------------------------------------------------------------------------------------------------- + + +-------------------------------------------------------------------------------------------------------------------------------------------- diff --git a/src/Cartesian/Plane.hs b/src/Cartesian/Plane.hs new file mode 100644 --- /dev/null +++ b/src/Cartesian/Plane.hs @@ -0,0 +1,212 @@ +-- | +-- Module : Cartesian.Plane +-- Description : +-- Copyright : (c) Jonatan H Sundqvist, year +-- License : MIT +-- Maintainer : Jonatan H Sundqvist +-- Stability : experimental|stable +-- Portability : POSIX (not sure) +-- + +-- Created date year + +-- TODO | - Which constraints are appropriate (Num is probably too generic, should be Real, maybe RealFrac) +-- - Strictness, performance + +-- SPEC | - +-- - + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- API +-------------------------------------------------------------------------------------------------------------------------------------------- +module Cartesian.Plane where + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- We'll need these +-------------------------------------------------------------------------------------------------------------------------------------------- +import Data.List (sort, minimumBy) +import Data.Ord (comparing) +import Data.Complex hiding (magnitude) + +import qualified Control.Lens as L + +-- import Southpaw.Utilities.Utilities (pairwise) + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- 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 + + +-- | 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 + where + lines = (p:olygon)++[p] -- Close the loop + -- between (Line (Vector ax ay) (Vector bx by)) = _ + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- 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 + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- 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') + + +-- | 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 (?) + + +-- | Euclidean distance between two points +euclidean :: Floating a => Vector a -> Vector a -> a +euclidean a b = sqrt $ dot a b + + +-- | +magnitude :: (Floating a, Eq a) => Vector a -> a +magnitude v = euclidean v v + +mag :: (Floating a, Eq a) => Vector a -> a +mag = magnitude + + +-- | 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) + + +-- Geometry --------------------------------------------------------------------------------------- +-- | Yields the point at which two finite lines intersect. The lines are defined inclusively by +-- their endpoints. The result is wrapped in a Maybe value to account for non-intersecting +-- lines. +-- +-- TODO: Move equation solving to separate function (two linear functions) +-- TODO: Simplify logic by considering f(x) = y for vertical lines (?) +-- TODO: Return Either instead of Maybe (eg. Left "parallel") (?) +-- +-- TODO: Math notes, MathJax or LaTex +-- 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 + + +-- 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 + + +-- | 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] -- + + +-- | +-- TODO: Intersect Rectangles + + + +-- | Coefficients for the linear function of a Line (slope, intercept). +-- Fails for vertical and horizontal lines. +-- +-- 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) + + +-- 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) diff --git a/src/Cartesian/Plane/BoundingBox.hs b/src/Cartesian/Plane/BoundingBox.hs new file mode 100644 --- /dev/null +++ b/src/Cartesian/Plane/BoundingBox.hs @@ -0,0 +1,85 @@ +-- | +-- Module : Cartesian.Plane.BoundingBox +-- Description : +-- Copyright : (c) Jonatan H Sundqvist, 2015 +-- License : MIT +-- Maintainer : Jonatan H Sundqvist +-- Stability : experimental|stable +-- Portability : POSIX (not sure) +-- + +-- Created September 7 2015 + +-- TODO | - Corner lenses +-- - + +-- SPEC | - +-- - + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- GHC Pragmas +-------------------------------------------------------------------------------------------------------------------------------------------- + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- API +-------------------------------------------------------------------------------------------------------------------------------------------- +module Cartesian.Plane.BoundingBox (module Cartesian.Plane.Types, + module Cartesian.Plane.BoundingBox, + module Cartesian.Plane.BoundingBox.Lenses) where + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- We'll need these +-------------------------------------------------------------------------------------------------------------------------------------------- +import Data.Complex +import Data.Functor ((<$>)) +import Data.List (sort) + +import Control.Lens + +import Cartesian.Plane.Types +import Cartesian.Plane.BoundingBox.Lenses +import Cartesian.Plane.Utilities + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- Functions +-------------------------------------------------------------------------------------------------------------------------------------------- + +-- Convenience constructors ---------------------------------------------------------------------------------------------------------------- + +-- | +-- TODO: Better name (?) +-- TODO: Don't make assumptions about WHICH corners they are (✓) +fromCorners :: RealFloat f => Complex f -> Complex f -> BoundingBox f +fromCorners nw@(n:+w) se@(s:+e) = let size = dotmap abs (se-nw) in BoundingBox { _centre=dotwise min nw se+size*(0.5:+0.0), _size=size } + + +-- | Creates a bounding box from a topleft and size vector. +fromCornerAndSize :: RealFloat f => Complex f -> Complex f -> BoundingBox f +fromCornerAndSize nw size' = BoundingBox { _centre=nw+size'*0.5, _size=size' } + + +-- | Top Left Bottom Right +fromSides :: RealFloat f => f -> f -> f -> f -> BoundingBox f +fromSides top left bottom right = fromCorners (left:+top) (right:+bottom) + +-- Booleans -------------------------------------------------------------------------------------------------------------------------------- + +-- | +intersect :: (RealFloat f, Ord f) => BoundingBox f -> BoundingBox f -> Maybe (BoundingBox f) +intersect a b = do + (left', right') <- overlap (a^.left, a^.right) (b^.left, b^.right) + (top', bottom') <- overlap (a^.top, a^.bottom) (b^.top, b^.bottom) + return $ fromSides top' left' bottom' right' + where + overlap (a, b) (c, d) + | min (a, b) (c, d) == (a', b') = Just (b', c') + | otherwise = Nothing + where [a', b', c', d'] = sort [a, b, c, d] diff --git a/src/Cartesian/Plane/BoundingBox/Lenses.hs b/src/Cartesian/Plane/BoundingBox/Lenses.hs new file mode 100644 --- /dev/null +++ b/src/Cartesian/Plane/BoundingBox/Lenses.hs @@ -0,0 +1,128 @@ +-- | +-- Module : Cartesian.BoundingBox.Lenses +-- Description : +-- Copyright : (c) Jonatan H Sundqvist, 2015 +-- License : MIT +-- Maintainer : Jonatan H Sundqvist +-- Stability : experimental|stable +-- Portability : POSIX (not sure) +-- + +-- Created October 21 2015 + +-- TODO | - +-- - + +-- SPEC | - +-- - + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- GHC Pragmas +-------------------------------------------------------------------------------------------------------------------------------------------- +{-# LANGUAGE RankNTypes #-} + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- API +-------------------------------------------------------------------------------------------------------------------------------------------- +module Cartesian.Plane.BoundingBox.Lenses where + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- We'll need these +-------------------------------------------------------------------------------------------------------------------------------------------- +import Data.Complex (Complex ((:+))) +import Data.Functor ((<$>)) +import Control.Lens + +import Cartesian.Plane.Types + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- 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)) diff --git a/src/Cartesian/Plane/Types.hs b/src/Cartesian/Plane/Types.hs new file mode 100644 --- /dev/null +++ b/src/Cartesian/Plane/Types.hs @@ -0,0 +1,55 @@ +-- | +-- Module : Cartesian.Plane.Types +-- Description : +-- Copyright : (c) Jonatan H Sundqvist, 2015 +-- License : MIT +-- Maintainer : Jonatan H Sundqvist +-- Stability : experimental|stable +-- Portability : POSIX (not sure) +-- + +-- Created September 6 2015 + +-- TODO | - Rename or move out function definitions +-- - Move BoundingBox functions to separate module (so that you could write BBox.makeFrom...) + +-- SPEC | - +-- - + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- GHC Directives +-------------------------------------------------------------------------------------------------------------------------------------------- +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE RankNTypes #-} + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- API +-------------------------------------------------------------------------------------------------------------------------------------------- +module Cartesian.Plane.Types where + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- We'll need these +-------------------------------------------------------------------------------------------------------------------------------------------- +import Data.Complex +import Control.Lens + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- 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) + + +-- | +-- TODO: Use existing type instead (?) +-- data Side = SideLeft | SideRight | SideTop | SideBottom diff --git a/src/Cartesian/Plane/Utilities.hs b/src/Cartesian/Plane/Utilities.hs new file mode 100644 --- /dev/null +++ b/src/Cartesian/Plane/Utilities.hs @@ -0,0 +1,71 @@ +-- | +-- Module : Cartesian.Plane.Utilities +-- Description : +-- Copyright : (c) Jonatan H Sundqvist, 2015 +-- License : MIT +-- Maintainer : Jonatan H Sundqvist +-- Stability : experimental|stable +-- Portability : POSIX (not sure) +-- + +-- Created September 8 2015 + +-- TODO | - Uses lenses for Complex type (?) +-- - + +-- SPEC | - +-- - + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- GHC Pragmas +-------------------------------------------------------------------------------------------------------------------------------------------- + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- API +-------------------------------------------------------------------------------------------------------------------------------------------- +module Cartesian.Plane.Utilities where + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- We'll need these +-------------------------------------------------------------------------------------------------------------------------------------------- +import Data.Complex + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- Functions +-------------------------------------------------------------------------------------------------------------------------------------------- +-- | Applies a function to each component in a vector +dotmap :: (a -> b) -> Complex a -> Complex b +dotmap f (re:+im) = f re :+ f im + + +-- | +dotwise :: (a -> a -> b) -> Complex a -> Complex a -> Complex b +dotwise f (re:+im) (re':+im') = f re re':+ f im im' + + +-- | Negates the real component (X) +flipx :: Complex Double -> Complex Double +flipx (x:+y) = (-x):+y + + +-- | Negates the imaginary component (Y) +flipy :: Complex Double -> Complex Double +flipy (x:+y) = x:+(-y) + + +-- | Creates a number on the real line (where the imaginary part is 0) +real :: Double -> Complex Double +real = (:+ 0) + + +-- | Creates a number on the imaginary line (where the real part is 0) +imag :: Double -> Complex Double +imag = (0 :+) diff --git a/src/Cartesian/Space.hs b/src/Cartesian/Space.hs new file mode 100644 --- /dev/null +++ b/src/Cartesian/Space.hs @@ -0,0 +1,157 @@ +-- | +-- Module : Cartesian.Space +-- Copyright : (C) 2015 Jonatan H Sundqvist +-- License : MIT-style (see the file LICENSE) +-- Maintainer : Jonatan H Sundqvist +-- Stability : provisional +-- Portability : Portable +-- +-- Vector and coordinate system utilities. + +-- +-- Cartesian.hs +-- This module exports the API for the Cartesian project +-- +-- Jonatan H Sundqvist +-- January 27 2015 +-- + +-- TODO | - Haddock header, sections, full coverage +-- - Separate 2D and 3D modules (✓) +-- - Factor out common functionality for Space.hs and Plane.hs + +-- SPEC | - +-- - + + + +module Cartesian.Space where + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- We'll need these +-------------------------------------------------------------------------------------------------------------------------------------------- +import Data.List (sort, minimumBy) +import Data.Ord (comparing) + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- Types +-------------------------------------------------------------------------------------------------------------------------------------------- + +-- | +data Vector num = Vector num num num -- TODO: Constraints on argument types (cf. GADT) (?) + + +-- | +data Line num = Line (Vector num) (Vector num) + + +-- | Why the hell did I write this useless function? +vector :: Num a => a -> a -> a -> Vector a +vector = Vector -- SublimeHaskell prefers the eta-reduced version (point-free) + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------------------------------------------------------------------- + +-- | +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 0 + signum v@(Vector x y z) = Vector (x/mag v) (y/mag v) (z/mag v) -- TODO: Proper way of implementing this function for vectors + abs v = Vector (mag v) (0) (0) + + + +-------------------------------------------------------------------------------------------------------------------------------------------- +-- Functions +-------------------------------------------------------------------------------------------------------------------------------------------- + +-- Vector math ----------------------------------------------------------------------------------------------------------------------------- +-- | Performs component-wise operations +dotwise :: (a -> b -> c) -> Vector a -> Vector b -> Vector c +dotwise f (Vector x y z) (Vector x' y' z') = Vector (f x x') (f y y') (f z z') + + +-- | Dot product of two vectors +dot :: Floating a => Vector a -> Vector a -> a +dot (Vector x y z) (Vector x' y' z') = (x * x') + (y * y') + (z * z') -- TODO: Refactor with Num instance (?) + + +-- | Euclidean distance between two points +euclidean :: Floating a => Vector a -> Vector a -> a +euclidean a b = sqrt $ dot a b + + +-- | +magnitude :: (Floating a, Eq a) => Vector a -> a +magnitude v = euclidean v v + +mag :: (Floating a, Eq a) => Vector a -> a +mag = magnitude + + +-- | Angle (in radians) between the positive X-axis and the vector +-- argument :: (Floating a, Eq a) => Vector a -> a +-- argument (Vector 0 0 0) = 0 +-- argument (Vector x y z) = 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) + +-------------------------------------------------------------------------------------------------------------------------------------------- + +-- | Intersect +-- TODO: Math notes, MathJax or LaTex +-- TODO: Intersect for curves (functions) and single points (?) +-- TODO: Polymorphic, typeclass (lines, shapes, ranges, etc.) (?) +intersect :: Num a => Line a -> Line a -> Maybe (Vector a) +intersect _ _ = error "Not implemented" -- Nothing + + +-- | +intersects :: Num a => Line a -> Line a -> 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] -- + + +-- | +-- TODO: Intersect Rectangles + + + +-- | Coefficients for the linear function of a Line (slope, intercept). The Z-component is ignored. +-- Fails for vertical and horizontal lines. +-- +-- TODO: Use Maybe (?) +-- +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)