-- SG library -- Copyright (c) 2009, Neil Brown. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are -- met: -- -- * Redistributions of source code must retain the above copyright -- notice, this list of conditions and the following disclaimer. -- * Redistributions in binary form must reproduce the above copyright -- notice, this list of conditions and the following disclaimer in the -- documentation and/or other materials provided with the distribution. -- * The author's name may not be used to endorse or promote products derived -- from this software without specific prior written permission. -- -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS -- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, -- THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -- PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR -- CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, -- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- | The module with all the different type-classes for vectors. Generally, the -- main functions you might need from this function are: -- -- * 'magSq' and 'mag' (defined for all vectors). -- -- * 'getX' and 'getY' (defined for all vectors) as well as 'getZ' (defined for -- all vectors with 3 or more dimensions). -- -- * 'dotProduct', 'unitVector', 'averageVec', 'averageUnitVec', 'sameDirection', -- 'projectOnto', 'projectPointOnto', 'distFrom' (defined for all vectors). -- -- * 'iso', which is defined for all combinations of vectors with the same number -- of dimensions. -- -- The rest of the functions are mainly just wiring necessary for other functions, -- but must be exported. -- -- As to the vector types, there are two methods to use this library. One is to -- use the types from the "Data.SG.Vector.Basic" library, which support basic vector -- operations. The other is to use the types from the "Data.SG.Geometry.TwoDim" -- and "Data.SG.Geometry.ThreeDim" modules, where a position vector is differentiated -- from a relative vector (to increase clarity of code, and help prevent errors -- such as adding two points together). Both systems can be used with various -- useful functions (involving lines too) from "Data.SG.Geometry". module Data.SG.Vector where import Data.Foldable (Foldable, toList) -- | An isomorphism amongst vectors. Allows you to convert between two vectors -- that have the same dimensions. You will notice that all the instances reflect -- this. class IsomorphicVectors from to where iso :: Num a => from a -> to a instance IsomorphicVectors v v where iso = id -- | The class that is implemented by all vectors. -- -- Minimal implementation: fromComponents class Foldable p => Coord p where -- | Gets the components of the vector, in the order x, y (, z). getComponents :: Num a => p a -> [a] getComponents = toList -- | Re-constructs a vector from the list of coordinates. If there are too few, -- the rest will be filled with zeroes. If there are too many, the latter ones are -- ignored. fromComponents :: Num a => [a] -> p a -- | Gets the magnitude squared of the vector. This should be fast for -- repeated calls on 'Data.SG.Geometry.TwoDim.Rel2'' and -- 'Data.SG.Geometry.ThreeDim.Rel3'', which cache this value. magSq :: Num a => p a -> a magSq = sum . map (\x -> x * x) . getComponents -- | Computes the dot product of the two vectors. dotProduct :: Num a => p a -> p a -> a dotProduct a b = sum $ zipWith (*) (getComponents a) (getComponents b) -- | This class is implemented by all 2D and 3D vectors, so 'getX' gets the X co-ordinate -- of both 2D and 3D vectors. class Coord p => Coord2 p where getX :: p a -> a getY :: p a -> a -- | This class is implemented by all 3D vectors. To get the X and Y components, -- use 'getX' and 'getY' from 'Coord2'. class Coord2 p => Coord3 p where getZ :: p a -> a -- | The origin\/all-zero vector (can be used with any vector type you like) origin :: (Coord p, Num a) => p a origin = fromComponents $ repeat 0 -- | Gets the magnitude of the given vector. mag :: (Coord p, Floating a) => p a -> a mag = sqrt . magSq -- | Scales the vector so that it has length 1. Note that due to floating-point -- inaccuracies and so on, mag (unitVector v) will not necessarily equal 1, but -- it should be very close. If an all-zero vector is passed, the same will be -- returned. -- -- This function should be very fast when called on -- 'Data.SG.Geometry.TwoDim.Rel2'' and 'Data.SG.Geometry.ThreeDim.Rel3''; -- vectors that are already unit vectors (no processing is done). unitVector :: (Coord p, VectorNum p, Ord a, Floating a) => p a -> p a unitVector v | abs (magSq v - 1) < 0.000001 = v | magSq v == 0 = v -- Avoid division by zero | otherwise = fmapNum1 (/ mag v) v -- | Gets the average vector of all the given vectors. Essentially it is the -- sum of the vectors, divided by the length, so @averageVec [Point2 (-3, 0), Point2 -- (5,0)]@ will give @Point2 (1,0)@. If the list is empty, the -- all-zero vector is returned. averageVec :: (Fractional a, VectorNum p, Num (p a)) => [p a] -> p a averageVec [] = 0 averageVec vs = fmapNum1 (/ fromInteger (toInteger $ length vs)) (sum vs) -- | Like averageVec composed with unitVector -- gets the average of the -- vectors in the list, and normalises the length. If the list is empty, the all-zero -- vector is returned (which is therefore not a unit vector). Similarly, -- if the average of all the vectors is all-zero, the all-zero vector will be returned. averageUnitVec :: (Floating a, Ord a, Coord p, VectorNum p, Num (p a)) => [p a] -> p a averageUnitVec [] = 0 averageUnitVec vs = unitVector $ sum vs -- | Works out if the two vectors are in the same direction (to within a small -- tolerance). sameDirection :: (VectorNum rel, Coord rel, Ord a, Floating a) => rel a -> rel a -> Bool sameDirection v w = all (< 0.000001) diffs where diffs = map abs $ zipWith (-) (getComponents $ unitVector v) (getComponents $ unitVector w) -- | Gives back the vector (first parameter), translated onto given axis (second -- parameter). Note that the scale is always distance, /not/ related to the size -- of the axis vector. projectOnto :: (Floating a, Ord a, VectorNum rel, Coord rel) => rel a -> rel a -> a projectOnto v axis = (v `dotProduct` unitVector axis) -- | Projects the first parameter onto the given axes (X, Y), returning a point -- in terms of the new axes. projectOnto2 :: (Floating a, Ord a, VectorNum rel, Coord rel) => rel a -> (rel a, rel a) -> rel a projectOnto2 v (axisX, axisY) = fromComponents [v `projectOnto` axisX, v `projectOnto` axisY] -- | Gives back the point (first parameter), translated onto given axis (second -- parameter). Note that the scale is always distance, /not/ related to the size -- of the axis vector. projectPointOnto :: (Floating a, Ord a, VectorNum rel, Coord rel, IsomorphicVectors pt rel) => pt a -> rel a -> a projectPointOnto pt = projectOnto (iso pt) -- | Projects the point (first parameter) onto the given axes (X, Y), returning a point -- in terms of the new axes. projectPointOnto2 :: (Floating a, Ord a, VectorNum rel, Coord rel, IsomorphicVectors pt rel, Coord pt) => pt a -> (rel a, rel a) -> pt a projectPointOnto2 v (axisX, axisY) = fromComponents [v `projectPointOnto` axisX, v `projectPointOnto` axisY] -- | Works out the distance between two points. distFrom :: (VectorNum pt, Coord pt, Floating a) => pt a -> pt a -> a distFrom v0 v1 = mag $ fmapNum2 (-) v0 v1 -- | A modified version of 'Functor' and 'Control.Applicative.Applicative' that adds the 'Num' -- constraint on the result. You are unlikely to need to use this class much -- directly. Some vectors have 'Functor' and 'Control.Applicative.Applicative' instances anyway. class VectorNum f where -- | Like 'fmap', but with a 'Num' constraint. fmapNum1 :: Num b => (a -> b) -> f a -> f b -- | Like 'Control.Applicative.liftA2', but with a 'Num' constraint. fmapNum2 :: Num c => (a -> b -> c) -> f a -> f b -> f c -- | Like 'fmapNum1', but can only be used if you won't change the magnitude: fmapNum1inv :: Num a => (a -> a) -> f a -> f a -- | Like 'Control.Applicative.pure' (or 'fromInteger') but with a 'Num' constraint. simpleVec :: Num a => a -> f a