```{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies
, TypeOperators, FlexibleInstances, UndecidableInstances
#-}
----------------------------------------------------------------------
-- |
-- Module      :   Data.VectorSpace
-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008
--
-- Maintainer  :  conal@conal.net, andygill@ku.edu
-- Stability   :  experimental
--
-- Vector spaces
----------------------------------------------------------------------

-- NB: I'm attempting to replace fundeps with associated types.  See
-- NewVectorSpace.hs.  Ran into trouble with type equality constraints not
-- getting propagated.  Manuel Ch is looking into it.
--

module Data.VectorSpace
(
, VectorSpace(..), (^/), (^*)
, InnerSpace(..)
, lerp, magnitudeSq, magnitude, normalized
) where

import Data.Complex hiding (magnitude)

import Data.MemoTrie

infixr 7 *^, ^/, <.>
infixl 7 ^*

-- | Vector space @v@ over a scalar field @s@.  Extends 'AdditiveGroup'
-- with scalar multiplication.
class AdditiveGroup v => VectorSpace v s | v -> s where
-- | Scale a vector
(*^)  :: s -> v -> v

-- | Adds inner (dot) products.
class VectorSpace v s => InnerSpace v s where
-- | Inner/dot product
(<.>) :: v -> v -> s

-- | Vector divided by scalar
(^/) :: (Fractional s, VectorSpace v s) => v -> s -> v
v ^/ s = (1/s) *^ v

-- | Vector multiplied by scalar
(^*) :: VectorSpace v s => v -> s -> v
(^*) = flip (*^)

-- | Linear interpolation between @a@ (when @t==0@) and @b@ (when @t==1@).
lerp :: (VectorSpace v s, Num s) => v -> v -> s -> v
lerp a b t = (1-t)*^a ^+^ t*^b

-- | Square of the length of a vector.  Sometimes useful for efficiency.
magnitudeSq :: InnerSpace v s => v -> s
magnitudeSq v = v <.> v

magnitude :: (InnerSpace v s, Floating s) =>  v -> s
magnitude = sqrt . magnitudeSq

-- | Vector in same direction as given one but with length of one.  If
-- given the zero vector, then return it.
normalized :: (InnerSpace v s, Floating s) =>  v -> v
normalized v = v ^/ magnitude v

instance VectorSpace Double Double where (*^)  = (*)
instance InnerSpace  Double Double where (<.>) = (*)

instance VectorSpace Float  Float  where (*^)  = (*)
instance InnerSpace  Float  Float  where (<.>) = (*)

instance (RealFloat v, VectorSpace v s) => VectorSpace (Complex v) s where
s*^(u :+ v) = s*^u :+ s*^v

instance (RealFloat v, InnerSpace v s, AdditiveGroup s)
=> InnerSpace (Complex v) s where
(u :+ v) <.> (u' :+ v') = (u <.> u') ^+^ (v <.> v')

-- Hm.  The 'RealFloat' constraint is unfortunate here.  It's due to a
-- questionable decision to place 'RealFloat' into the definition of the
-- 'Complex' /type/, rather than in functions and instances as needed.

instance (VectorSpace u s,VectorSpace v s) => VectorSpace (u,v) s where
s *^ (u,v) = (s*^u,s*^v)

instance (InnerSpace u s,InnerSpace v s, AdditiveGroup s)
=> InnerSpace (u,v) s where
(u,v) <.> (u',v') = (u <.> u') ^+^ (v <.> v')

instance (VectorSpace u s,VectorSpace v s,VectorSpace w s)
=> VectorSpace (u,v,w) s where
s *^ (u,v,w) = (s*^u,s*^v,s*^w)

instance (InnerSpace u s,InnerSpace v s,InnerSpace w s, AdditiveGroup s)
=> InnerSpace (u,v,w) s where
(u,v,w) <.> (u',v',w') = u<.>u' ^+^ v<.>v' ^+^ w<.>w'

-- Standard instance for an applicative functor applied to a vector space.
instance VectorSpace v s => VectorSpace (a->v) s where
(*^) s = fmap (s *^)

-- No 'InnerSpace' instance for @(a->v)@.

instance (HasTrie u, VectorSpace v s, AdditiveGroup (u :->: v))
=> VectorSpace (u :->: v) s where
(*^) s = fmap (s *^)

-- The 'AdditiveGroup' constraint is implied by the others, thanks to the
-- instance in Data.AdditiveGroup.  Why isn't ghc figuring it out?
```