{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE Trustworthy #-}
module Linear.Metric
( Metric(..), normalize, project
) where
import Control.Applicative
import Data.Foldable as Foldable
import Data.Functor.Compose
import Data.Functor.Identity
import Data.Functor.Product
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 f a
x f a
y = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Foldable.sum forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall a. Num a => a -> a -> a
(*) f a
x f a
y
#endif
quadrance :: Num a => f a -> a
quadrance f a
v = 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 a
f f a
g = forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance (f a
f 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 a
f f a
g = forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm (f a
f forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ f a
g)
norm :: Floating a => f a -> a
norm f a
v = forall a. Floating a => a -> a
sqrt (forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance f a
v)
signorm :: Floating a => f a -> f a
signorm f a
v = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Fractional a => a -> a -> a
/a
m) f a
v where
m :: a
m = forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm f a
v
instance (Metric f, Metric g) => Metric (Product f g) where
dot :: forall a. Num a => Product f g a -> Product f g a -> a
dot (Pair f a
a g a
b) (Pair f a
c g a
d) = forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
dot f a
a f a
c forall a. Num a => a -> a -> a
+ forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
dot g a
b g a
d
quadrance :: forall a. Num a => Product f g a -> a
quadrance (Pair f a
a g a
b) = forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance f a
a forall a. Num a => a -> a -> a
+ forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance g a
b
qd :: forall a. Num a => Product f g a -> Product f g a -> a
qd (Pair f a
a g a
b) (Pair f a
c g a
d) = forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
qd f a
a f a
c forall a. Num a => a -> a -> a
+ forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
qd g a
b g a
d
distance :: forall a. Floating a => Product f g a -> Product f g a -> a
distance Product f g a
p Product f g a
q = forall a. Floating a => a -> a
sqrt (forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
qd Product f g a
p Product f g a
q)
instance (Metric f, Metric g) => Metric (Compose f g) where
dot :: forall a. Num a => Compose f g a -> Compose f g a -> a
dot (Compose f (g a)
a) (Compose f (g a)
b) = forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
dot f (g a)
a f (g a)
b)
quadrance :: forall a. Num a => Compose f g a -> a
quadrance = forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
qd :: forall a. Num a => Compose f g a -> Compose f g a -> a
qd (Compose f (g a)
a) (Compose f (g a)
b) = forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
qd f (g a)
a f (g a)
b)
distance :: forall a. Floating a => Compose f g a -> Compose f g a -> a
distance (Compose f (g a)
a) (Compose f (g a)
b) = forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
qd f (g a)
a f (g a)
b)
instance Metric Identity where
dot :: forall a. Num a => Identity a -> Identity a -> a
dot (Identity a
x) (Identity a
y) = a
x forall a. Num a => a -> a -> a
* a
y
instance Metric []
instance Metric Maybe
instance Metric ZipList where
dot :: forall a. Num a => ZipList a -> ZipList a -> a
dot (ZipList [a]
x) (ZipList [a]
y) = 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 :: forall a (f :: * -> *).
(Floating a, Metric f, Epsilon a) =>
f a -> f a
normalize f a
v = if forall a. Epsilon a => a -> Bool
nearZero a
l Bool -> Bool -> Bool
|| forall a. Epsilon a => a -> Bool
nearZero (a
1forall a. Num a => a -> a -> a
-a
l) then f a
v else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Fractional a => a -> a -> a
/forall a. Floating a => a -> a
sqrt a
l) f a
v
where l :: a
l = 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 :: forall (v :: * -> *) a.
(Metric v, Fractional a) =>
v a -> v a -> v a
project v a
u v a
v = ((v a
v forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` v a
u) forall a. Fractional a => a -> a -> a
/ forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance v a
u) forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v a
u