Skip to content

Instantly share code, notes, and snippets.

@Bradcomp
Created September 18, 2016 05:25
Show Gist options
  • Save Bradcomp/a07df236386eb985ab82c0356824b107 to your computer and use it in GitHub Desktop.
Save Bradcomp/a07df236386eb985ab82c0356824b107 to your computer and use it in GitHub Desktop.
Simple Vector Library in Haskell
module Vectors where
import Data.Functor (Functor)
import Data.Function (on)
import Control.Applicative (Applicative, liftA2)
--Helper function for dealing with floating point errors
roundTo:: (RealFrac a) => Int -> a -> a
roundTo digits num = (/10^^digits) $ fromIntegral $ round $ num * (10 ^^ digits)
data Vector a = Vector [a]
deriving (Eq, Show)
instance Functor Vector where
fmap f (Vector v) = Vector $ map f v
instance Applicative Vector where
pure a = Vector (repeat a)
(<*>) (Vector f) (Vector v) = Vector $ zipWith ($) f v
instance Foldable Vector where
foldr f acc (Vector v) = foldr f acc v
--Another helper function
allEq :: (Eq a) => Vector a -> Bool
allEq (Vector []) = True
allEq (Vector (x:xs)) = all (== x) xs
--Add two vectors
addV :: (Num a) => Vector a -> Vector a -> Vector a
addV = liftA2 (+)
--Subtract two vectors
subtractV :: (Num a) => Vector a -> Vector a -> Vector a
subtractV = liftA2 (-)
--Multiply a scalar by a vector
multS :: (Num a) => a -> Vector a -> Vector a
multS n = fmap (*n)
magnitude :: (Floating a) => Vector a -> a
magnitude = sqrt . sum . (fmap (**2))
normalize :: (Floating a) => Vector a -> Vector a
normalize v = multS (1.0 / (magnitude v)) v
--Dot product
dot :: (Num a) => Vector a -> Vector a -> a
dot v1 v2 = sum $ liftA2 (*) v1 v2
--Angle between two vectors
theta :: (Floating a) => Vector a -> Vector a -> a
theta v1 v2 = acos $ (dot `on` normalize) v1 v2
isOrthogonal :: (RealFrac a, Eq a) => Vector a -> Vector a -> Bool
isOrthogonal v1 v2 = (== 0) $ (roundTo 8) $ dot v1 v2
isParallel :: (RealFrac a, Eq a) => Vector a -> Vector a -> Bool
isParallel v1 v2 = allEq $ fmap (roundTo 8) $ (liftA2 (/)) v1 v2
projection :: (Floating a) => Vector a -> Vector a -> Vector a
projection vec basis = multS mag uBasis
where uBasis = normalize basis
mag = dot vec uBasis
--Component of a vector orthogonal to the basis
orthogonalProj :: (Floating a) => Vector a -> Vector a -> Vector a
orthogonalProj vec basis = subtractV vec $ projection vec basis
--Cross product only makes sense for a 3-d vector.
cross :: (Num a) => Vector a -> Vector a -> Vector a
cross (Vector (x1:y1:z1:[])) (Vector (x2:y2:z2:[])) =
Vector [y1*z2 - y2*z1, -(x1*z2 - x2*z1), x1*y2 - x2*y1]
cross v1 v2 = Vector [0, 0, 0]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment