--------------------------------------------------------------------------------
-- |
-- Module      :  Algorithms.Geometry.Diameter.Naive
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Algorithms.Geometry.Diameter.Naive where

import Control.Lens
import Data.Ext
import Data.Geometry
import Data.List(maximumBy)

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

-- | Computes the Euclidean diameter by naively trying all pairs.
--
-- running time: \(O(n^2)\)
diameter :: (Ord r, Floating r, Arity d) => [Point d r :+ p] -> r
diameter :: [Point d r :+ p] -> r
diameter = r
-> ((Point d r :+ p, Point d r :+ p) -> r)
-> Maybe (Point d r :+ p, Point d r :+ p)
-> r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe r
0 (\(Point d r :+ p
p,Point d r :+ p
q) -> Point d r -> Point d r -> r
forall r (d :: Nat).
(Floating r, Arity d) =>
Point d r -> Point d r -> r
euclideanDist (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)) (Maybe (Point d r :+ p, Point d r :+ p) -> r)
-> ([Point d r :+ p] -> Maybe (Point d r :+ p, Point d r :+ p))
-> [Point d r :+ p]
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point d r :+ p] -> Maybe (Point d r :+ p, Point d r :+ p)
forall r (d :: Nat) p.
(Ord r, Num r, Arity d) =>
[Point d r :+ p] -> Maybe (Point d r :+ p, Point d r :+ p)
diametralPair

-- | Computes the Euclidean diametral pair by naively trying all pairs.
--
-- running time: \(O(n^2)\)
diametralPair :: (Ord r, Num r, Arity d)
                   => [Point d r :+ p] -> Maybe (Point d r :+ p, Point d r :+ p)
diametralPair :: [Point d r :+ p] -> Maybe (Point d r :+ p, Point d r :+ p)
diametralPair = (Point d r -> Point d r -> r)
-> [Point d r :+ p] -> Maybe (Point d r :+ p, Point d r :+ p)
forall r (d :: Nat) p.
Ord r =>
(Point d r -> Point d r -> r)
-> [Point d r :+ p] -> Maybe (Point d r :+ p, Point d r :+ p)
diametralPairWith Point d r -> Point d r -> r
forall r (d :: Nat).
(Num r, Arity d) =>
Point d r -> Point d r -> r
squaredEuclideanDist

-- | Given a distance function and a list of points pts, computes the diametral
-- pair by naively trying all pairs.
--
-- running time: \(O(n^2)\)
diametralPairWith               :: Ord r
                                     => (Point d r -> Point d r -> r)
                                     -> [Point d r :+ p]
                                     -> Maybe (Point d r :+ p, Point d r :+ p)
diametralPairWith :: (Point d r -> Point d r -> r)
-> [Point d r :+ p] -> Maybe (Point d r :+ p, Point d r :+ p)
diametralPairWith Point d r -> Point d r -> r
f pts :: [Point d r :+ p]
pts@(Point d r :+ p
_:Point d r :+ p
_:[Point d r :+ p]
_) = (Point d r :+ p, Point d r :+ p)
-> Maybe (Point d r :+ p, Point d r :+ p)
forall a. a -> Maybe a
Just ((Point d r :+ p, Point d r :+ p)
 -> Maybe (Point d r :+ p, Point d r :+ p))
-> (Point d r :+ p, Point d r :+ p)
-> Maybe (Point d r :+ p, Point d r :+ p)
forall a b. (a -> b) -> a -> b
$ ((Point d r :+ p, Point d r :+ p)
 -> (Point d r :+ p, Point d r :+ p) -> Ordering)
-> [(Point d r :+ p, Point d r :+ p)]
-> (Point d r :+ p, Point d r :+ p)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (Point d r :+ p, Point d r :+ p)
-> (Point d r :+ p, Point d r :+ p) -> Ordering
cmp [ (Point d r :+ p
p,Point d r :+ p
q) | Point d r :+ p
p <- [Point d r :+ p]
pts, Point d r :+ p
q <- [Point d r :+ p]
pts ]
  where
    f' :: (Point d r :+ p, Point d r :+ p) -> r
f' (Point d r :+ p
p,Point d r :+ p
q) = Point d r -> Point d r -> r
f (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)
    (Point d r :+ p, Point d r :+ p)
tp cmp :: (Point d r :+ p, Point d r :+ p)
-> (Point d r :+ p, Point d r :+ p) -> Ordering
`cmp` (Point d r :+ p, Point d r :+ p)
tq = (Point d r :+ p, Point d r :+ p) -> r
f' (Point d r :+ p, Point d r :+ p)
tp r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Point d r :+ p, Point d r :+ p) -> r
f' (Point d r :+ p, Point d r :+ p)
tq
diametralPairWith Point d r -> Point d r -> r
_ [Point d r :+ p]
_           = Maybe (Point d r :+ p, Point d r :+ p)
forall a. Maybe a
Nothing