Simple Vector Library in Haskell

Vectors.hs

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]