{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Point.EuclideanDistance
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Points that have to do with Euclidean distances between
-- \(d\)-dimensional points.
--
--------------------------------------------------------------------------------
module HGeometry.Point.EuclideanDistance
  ( cmpByDistanceTo
  , squaredEuclideanDist, euclideanDist
  , HasSquaredEuclideanDistance(..)
  ) where

import           Control.Lens
import           Data.Ord (comparing)
import           HGeometry.Ext
import qualified HGeometry.Number.Radical as Radical
import           HGeometry.Point.Class
import           HGeometry.Point.Type
import           HGeometry.Properties
import           HGeometry.Vector

--------------------------------------------------------------------------------
-- * Distances

-- | Squared Euclidean distance between two points
squaredEuclideanDist     :: (Num r, Point_ point d r, Point_ point' d r, Metric_ (Vector d r) d r)
                         => point -> point' -> r
squaredEuclideanDist :: forall r point (d :: Nat) point'.
(Num r, Point_ point d r, Point_ point' d r,
 Metric_ (Vector d r) d r) =>
point -> point' -> r
squaredEuclideanDist point
p point'
q = Vector d r -> r
forall vector (d :: Nat) r.
(Metric_ vector d r, Num r) =>
vector -> r
quadrance (Vector d r -> r) -> Vector d r -> r
forall a b. (a -> b) -> a -> b
$ (point
ppoint -> Getting (Vector d r) point (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) point (Vector d r)
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point point (Vector d r) (Vector d r)
vector) Vector d r -> Vector d r -> Vector d r
forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
^-^ (point'
qpoint' -> Getting (Vector d r) point' (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) point' (Vector d r)
forall (d :: Nat) r s.
(Dimension point' ~ d, NumType point' ~ r, Dimension point' ~ d,
 NumType point' ~ s) =>
Lens point' point' (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point' point' (Vector d r) (Vector d r)
vector)
{-# INLINE squaredEuclideanDist #-}

-- | Euclidean distance between two points
euclideanDist     :: (Radical.Radical r, Point_ point d r, Metric_ (Vector d r) d r)
                  => point -> point -> r
euclideanDist :: forall r point (d :: Nat).
(Radical r, Point_ point d r, Metric_ (Vector d r) d r) =>
point -> point -> r
euclideanDist point
p point
q = r -> r
forall r. Radical r => r -> r
Radical.sqrt (r -> r) -> r -> r
forall a b. (a -> b) -> a -> b
$ point -> point -> r
forall r point (d :: Nat) point'.
(Num r, Point_ point d r, Point_ point' d r,
 Metric_ (Vector d r) d r) =>
point -> point' -> r
squaredEuclideanDist point
p point
q
{-# INLINE euclideanDist #-}

-- | Compare two points by their distance to the first argument
cmpByDistanceTo   :: ( Ord r, Num r, Point_ point d r, Point_ center d r
                     , Metric_ (Vector d r) d r
                     )
                  => center -> point -> point -> Ordering
cmpByDistanceTo :: forall r point (d :: Nat) center.
(Ord r, Num r, Point_ point d r, Point_ center d r,
 Metric_ (Vector d r) d r) =>
center -> point -> point -> Ordering
cmpByDistanceTo center
c = (point -> r) -> point -> point -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (center -> point -> r
forall r point (d :: Nat) point'.
(Num r, Point_ point d r, Point_ point' d r,
 Metric_ (Vector d r) d r) =>
point -> point' -> r
squaredEuclideanDist center
c)
{-# INLINE cmpByDistanceTo #-}

--------------------------------------------------------------------------------

-- | Types for which we can compute the squared Euclidean distance.
class Metric_ (Vector (Dimension g) (NumType g)) (Dimension g) (NumType g)
      => HasSquaredEuclideanDistance g where
  {-# MINIMAL pointClosestToWithDistance | pointClosestTo #-}
  -- | Given a point q and a geometry g, the squared Euclidean distance between q and g.
  squaredEuclideanDistTo   :: ( r ~ NumType g
                              , d ~ Dimension g
                              , Num r
                              , Point_ point d r
                              )
                           => point -> g -> r
  squaredEuclideanDistTo point
q = (Point d r, r) -> r
forall a b. (a, b) -> b
snd ((Point d r, r) -> r) -> (g -> (Point d r, r)) -> g -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. point -> g -> (Point d r, r)
forall g r (d :: Nat) point.
(HasSquaredEuclideanDistance g, r ~ NumType g, d ~ Dimension g,
 Num r, Point_ point d r) =>
point -> g -> (Point d r, r)
forall r (d :: Nat) point.
(r ~ NumType g, d ~ Dimension g, Num r, Point_ point d r) =>
point -> g -> (Point d r, r)
pointClosestToWithDistance point
q
  {-# INLINE squaredEuclideanDistTo #-}

  -- | Given q and g, computes the point p in g closest to q according
  -- to the Squared Euclidean distance.
  pointClosestTo   :: ( r ~ NumType g
                      , d ~ Dimension g
                      , Num r
                      , Point_ point d r
                      )
                   => point -> g -> Point d r
  pointClosestTo point
q = (Point d r, r) -> Point d r
forall a b. (a, b) -> a
fst ((Point d r, r) -> Point d r)
-> (g -> (Point d r, r)) -> g -> Point d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. point -> g -> (Point d r, r)
forall g r (d :: Nat) point.
(HasSquaredEuclideanDistance g, r ~ NumType g, d ~ Dimension g,
 Num r, Point_ point d r) =>
point -> g -> (Point d r, r)
forall r (d :: Nat) point.
(r ~ NumType g, d ~ Dimension g, Num r, Point_ point d r) =>
point -> g -> (Point d r, r)
pointClosestToWithDistance point
q
  {-# INLINE pointClosestTo #-}

  -- | Given q and g, computes the point p in g closest to q according
  -- to the Squared Euclidean distance. Returns both the point and the
  -- distance realized by this point.
  pointClosestToWithDistance     :: ( r ~ NumType g
                                    , d ~ Dimension g
                                    , Num r
                                    , Point_ point d r
                                    )
                                 => point -> g
                                 -> (Point d r, r)
  pointClosestToWithDistance point
q g
g = let q' :: PointF (Vector d r)
q' = Vector d r -> PointF (Vector d r)
forall v. v -> PointF v
Point (Vector d r -> PointF (Vector d r))
-> Vector d r -> PointF (Vector d r)
forall a b. (a -> b) -> a -> b
$ point
qpoint -> Getting (Vector d r) point (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) point (Vector d r)
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point point (Vector d r) (Vector d r)
vector
                                       p :: PointF (Vector d r)
p  = PointF (Vector d r) -> g -> PointF (Vector d r)
forall g r (d :: Nat) point.
(HasSquaredEuclideanDistance g, r ~ NumType g, d ~ Dimension g,
 Num r, Point_ point d r) =>
point -> g -> Point d r
forall r (d :: Nat) point.
(r ~ NumType g, d ~ Dimension g, Num r, Point_ point d r) =>
point -> g -> Point d r
pointClosestTo PointF (Vector d r)
q' g
g
                                   in (PointF (Vector d r)
p, PointF (Vector d r) -> PointF (Vector d r) -> r
forall r point (d :: Nat) point'.
(Num r, Point_ point d r, Point_ point' d r,
 Metric_ (Vector d r) d r) =>
point -> point' -> r
squaredEuclideanDist PointF (Vector d r)
p PointF (Vector d r)
q')
  {-# INLINE pointClosestToWithDistance #-}

instance ( Vector_ v            d r
         , Metric_ (Vector d r) d r
         ) => HasSquaredEuclideanDistance (PointF v) where
  pointClosestTo :: forall r (d :: Nat) point.
(r ~ NumType (PointF v), d ~ Dimension (PointF v), Num r,
 Point_ point d r) =>
point -> PointF v -> Point d r
pointClosestTo point
_ PointF v
p = Vector d r -> PointF (Vector d r)
forall v. v -> PointF v
Point (Vector d r -> PointF (Vector d r))
-> Vector d r -> PointF (Vector d r)
forall a b. (a -> b) -> a -> b
$ PointF v
pPointF v
-> Getting (Vector d r) (PointF v) (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) (PointF v) (Vector d r)
forall (d :: Nat) r s.
(Dimension (PointF v) ~ d, NumType (PointF v) ~ r,
 Dimension (PointF v) ~ d, NumType (PointF v) ~ s) =>
Lens (PointF v) (PointF v) (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens (PointF v) (PointF v) (Vector d r) (Vector d r)
vector
  {-# INLINE pointClosestTo #-}


instance HasSquaredEuclideanDistance p => HasSquaredEuclideanDistance (p :+ extra) where
  pointClosestTo :: forall r (d :: Nat) point.
(r ~ NumType (p :+ extra), d ~ Dimension (p :+ extra), Num r,
 Point_ point d r) =>
point -> (p :+ extra) -> Point d r
pointClosestTo point
q = point -> p -> Point d r
forall g r (d :: Nat) point.
(HasSquaredEuclideanDistance g, r ~ NumType g, d ~ Dimension g,
 Num r, Point_ point d r) =>
point -> g -> Point d r
forall r (d :: Nat) point.
(r ~ NumType p, d ~ Dimension p, Num r, Point_ point d r) =>
point -> p -> Point d r
pointClosestTo point
q (p -> Point d r)
-> ((p :+ extra) -> p) -> (p :+ extra) -> Point d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting p (p :+ extra) p -> (p :+ extra) -> p
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting p (p :+ extra) p
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core
  {-# INLINE pointClosestTo #-}