--------------------------------------------------------------------------------
-- |
-- Module      :  Algorithms.Geometry.ClosestPair.Naive
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Naive \O(n\^2)\) time algorithm to compute the closest pair of points among
-- \(n\) points in \(\mathbb{R}^d\).
--
--------------------------------------------------------------------------------
module Algorithms.Geometry.ClosestPair.Naive( closestPair
                                            , closestPairWith
                                            , DistanceFunction
                                            ) where

import           Control.Lens ((^.),_1)
import           Data.Ext
import qualified Data.Foldable as F
import           Data.Geometry.Point
import           Data.Geometry.Properties (NumType)
import           Data.Geometry.Vector (Arity)
import           Data.LSeq (LSeq)
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Semigroup
import           Data.Util

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

-- | Naive algorithm to compute the closest pair according to the
-- (squared) Euclidean distance in \(d\) dimensions. Note that we need
-- at least two elements for there to be a closest pair.
--
-- running time: \(O(dn^2)\) time.
closestPair :: ( Ord r, Arity d, Num r)
            => LSeq 2 (Point d r :+ p) -> Two (Point d r :+ p)
closestPair :: LSeq 2 (Point d r :+ p) -> Two (Point d r :+ p)
closestPair = (SP (Two (Point d r :+ p)) r
-> Getting
     (Two (Point d r :+ p))
     (SP (Two (Point d r :+ p)) r)
     (Two (Point d r :+ p))
-> Two (Point d r :+ p)
forall s a. s -> Getting a s a -> a
^.Getting
  (Two (Point d r :+ p))
  (SP (Two (Point d r :+ p)) r)
  (Two (Point d r :+ p))
forall s t a b. Field1 s t a b => Lens s t a b
_1) (SP (Two (Point d r :+ p)) r -> Two (Point d r :+ p))
-> (LSeq 2 (Point d r :+ p) -> SP (Two (Point d r :+ p)) r)
-> LSeq 2 (Point d r :+ p)
-> Two (Point d r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DistanceFunction (Point d r :+ p)
-> LSeq 2 (Point d r :+ p) -> SP (Two (Point d r :+ p)) r
forall r (d :: Nat) p.
Ord r =>
DistanceFunction (Point d r :+ p)
-> LSeq 2 (Point d r :+ p) -> SP (Two (Point d r :+ p)) r
closestPairWith (\Point d r :+ p
p Point d r :+ p
q -> Point d r -> Point d r -> r
forall r (d :: Nat).
(Num r, Arity d) =>
Point d r -> Point d r -> r
squaredEuclideanDist (Point d r :+ p
p(Point d r :+ p)
-> Getting (Point d r) (Point d r :+ p) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.Getting (Point d r) (Point d r :+ p) (Point d r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point d r :+ p
q(Point d r :+ p)
-> Getting (Point d r) (Point d r :+ p) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.Getting (Point d r) (Point d r :+ p) (Point d r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core))


type DistanceFunction g = g -> g -> NumType g

-- | Naive algorithm to compute the closest pair of points (and the
-- distance realized by those points) given a distance function.  Note
-- that we need at least two elements for there to be a closest pair.
--
-- running time: \(O(T(d)n^2)\), where \(T(d)\) is the time required
-- to evaluate the distance between two points in \(\mathbb{R}^d\).
closestPairWith   :: Ord r
                  => DistanceFunction (Point d r :+ p)
                  -> LSeq 2 (Point d r :+ p) -> SP (Two (Point d r :+ p)) r
closestPairWith :: DistanceFunction (Point d r :+ p)
-> LSeq 2 (Point d r :+ p) -> SP (Two (Point d r :+ p)) r
closestPairWith DistanceFunction (Point d r :+ p)
d = Arg r (Two (Point d r :+ p)) -> SP (Two (Point d r :+ p)) r
forall b a. Arg b a -> SP a b
getVal (Arg r (Two (Point d r :+ p)) -> SP (Two (Point d r :+ p)) r)
-> (LSeq 2 (Point d r :+ p) -> Arg r (Two (Point d r :+ p)))
-> LSeq 2 (Point d r :+ p)
-> SP (Two (Point d r :+ p)) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Min (Arg r (Two (Point d r :+ p))) -> Arg r (Two (Point d r :+ p))
forall a. Min a -> a
getMin (Min (Arg r (Two (Point d r :+ p)))
 -> Arg r (Two (Point d r :+ p)))
-> (LSeq 2 (Point d r :+ p) -> Min (Arg r (Two (Point d r :+ p))))
-> LSeq 2 (Point d r :+ p)
-> Arg r (Two (Point d r :+ p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Min (Arg r (Two (Point d r :+ p))))
-> Min (Arg r (Two (Point d r :+ p)))
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty (Min (Arg r (Two (Point d r :+ p))))
 -> Min (Arg r (Two (Point d r :+ p))))
-> (LSeq 2 (Point d r :+ p)
    -> NonEmpty (Min (Arg r (Two (Point d r :+ p)))))
-> LSeq 2 (Point d r :+ p)
-> Min (Arg r (Two (Point d r :+ p)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Two (Point d r :+ p) -> Min (Arg r (Two (Point d r :+ p))))
-> NonEmpty (Two (Point d r :+ p))
-> NonEmpty (Min (Arg r (Two (Point d r :+ p))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Two (Point d r :+ p) -> Min (Arg r (Two (Point d r :+ p)))
mkPair (NonEmpty (Two (Point d r :+ p))
 -> NonEmpty (Min (Arg r (Two (Point d r :+ p)))))
-> (LSeq 2 (Point d r :+ p) -> NonEmpty (Two (Point d r :+ p)))
-> LSeq 2 (Point d r :+ p)
-> NonEmpty (Min (Arg r (Two (Point d r :+ p))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSeq 2 (Point d r :+ p) -> NonEmpty (Two (Point d r :+ p))
forall a. LSeq 2 a -> NonEmpty (Two a)
pairs
  where
    getVal :: Arg b a -> SP a b
getVal (Arg b
dist a
x) = a -> b -> SP a b
forall a b. a -> b -> SP a b
SP a
x b
dist
    mkPair :: Two (Point d r :+ p) -> Min (Arg r (Two (Point d r :+ p)))
mkPair (Two Point d r :+ p
p Point d r :+ p
q)    = Arg r (Two (Point d r :+ p)) -> Min (Arg r (Two (Point d r :+ p)))
forall a. a -> Min a
Min (r -> Two (Point d r :+ p) -> Arg r (Two (Point d r :+ p))
forall a b. a -> b -> Arg a b
Arg (DistanceFunction (Point d r :+ p)
d Point d r :+ p
p Point d r :+ p
q) ((Point d r :+ p) -> (Point d r :+ p) -> Two (Point d r :+ p)
forall a. a -> a -> Two a
Two Point d r :+ p
p Point d r :+ p
q))

-- | Produce all lists from a vec of elements. Since the Vec contains at least two
-- elements, the resulting list is non-empty
pairs :: LSeq 2 a -> NonEmpty.NonEmpty (Two a)
pairs :: LSeq 2 a -> NonEmpty (Two a)
pairs = [Two a] -> NonEmpty (Two a)
forall a. [a] -> NonEmpty a
NonEmpty.fromList ([Two a] -> NonEmpty (Two a))
-> (LSeq 2 a -> [Two a]) -> LSeq 2 a -> NonEmpty (Two a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [Two a]
forall a. [a] -> [Two a]
uniquePairs ([a] -> [Two a]) -> (LSeq 2 a -> [a]) -> LSeq 2 a -> [Two a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSeq 2 a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList