Vector.hs

-- 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