{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
module Linear.Metric
( Metric(..), normalize, project
) where
import Control.Applicative
import Data.Foldable as Foldable
import Data.Functor.Identity
import Data.Vector (Vector)
import Data.IntMap (IntMap)
import Data.Map (Map)
import Data.HashMap.Strict (HashMap)
import Data.Hashable (Hashable)
import Linear.Epsilon
import Linear.Vector
class Additive f => Metric f where
dot :: Num a => f a -> f a -> a
#ifndef HLINT
default dot :: (Foldable f, Num a) => f a -> f a -> a
dot x :: f a
x y :: f a
y = f a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Foldable.sum (f a -> a) -> f a -> a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> f a -> f a -> f a
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 a -> a -> a
forall a. Num a => a -> a -> a
(*) f a
x f a
y
#endif
quadrance :: Num a => f a -> a
quadrance v :: f a
v = f a -> f a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
dot f a
v f a
v
qd :: Num a => f a -> f a -> a
qd f :: f a
f g :: f a
g = f a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance (f a
f f a -> f a -> f a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ f a
g)
distance :: Floating a => f a -> f a -> a
distance f :: f a
f g :: f a
g = f a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm (f a
f f a -> f a -> f a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ f a
g)
norm :: Floating a => f a -> a
norm v :: f a
v = a -> a
forall a. Floating a => a -> a
sqrt (f a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance f a
v)
signorm :: Floating a => f a -> f a
signorm v :: f a
v = (a -> a) -> f a -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> a
forall a. Fractional a => a -> a -> a
/a
m) f a
v where
m :: a
m = f a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm f a
v
instance Metric Identity where
dot :: Identity a -> Identity a -> a
dot (Identity x :: a
x) (Identity y :: a
y) = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y
instance Metric []
instance Metric Maybe
instance Metric ZipList where
dot :: ZipList a -> ZipList a -> a
dot (ZipList x :: [a]
x) (ZipList y :: [a]
y) = [a] -> [a] -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
dot [a]
x [a]
y
instance Metric IntMap
instance Ord k => Metric (Map k)
instance (Hashable k, Eq k) => Metric (HashMap k)
instance Metric Vector
normalize :: (Floating a, Metric f, Epsilon a) => f a -> f a
normalize :: f a -> f a
normalize v :: f a
v = if a -> Bool
forall a. Epsilon a => a -> Bool
nearZero a
l Bool -> Bool -> Bool
|| a -> Bool
forall a. Epsilon a => a -> Bool
nearZero (1a -> a -> a
forall a. Num a => a -> a -> a
-a
l) then f a
v else (a -> a) -> f a -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> a
forall a. Fractional a => a -> a -> a
/a -> a
forall a. Floating a => a -> a
sqrt a
l) f a
v
where l :: a
l = f a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance f a
v
project :: (Metric v, Fractional a) => v a -> v a -> v a
project :: v a -> v a -> v a
project u :: v a
u v :: v a
v = ((v a
v v a -> v a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` v a
u) a -> a -> a
forall a. Fractional a => a -> a -> a
/ v a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance v a
u) a -> v a -> v a
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v a
u