--------------------------------------------------------------------------------
-- |
-- Module      :  Algorithms.Geometry.Diameter.ConvexHull
-- Copyright   :  (C) David Himmelstrup
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals, David Himmelstrup
--------------------------------------------------------------------------------
module Algorithms.Geometry.Diameter.ConvexHull
  ( diameter
  , diametralPair
  ) where

import           Algorithms.Geometry.ConvexHull.GrahamScan (convexHull)
import qualified Algorithms.Geometry.Diameter.Naive        as Naive
import           Control.Lens                              ((^.))
import           Data.Ext                                  (core, type (:+))
import           Data.Geometry                             (Point, euclideanDist)
import qualified Data.Geometry.Polygon.Convex              as Convex
import qualified Data.List.NonEmpty                        as NonEmpty

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

-- | Computes the Euclidean diameter by first finding the convex hull.
--
-- running time: \(O(n \log n)\)
diameter :: (Ord r, Floating r) => [Point 2 r :+ p] -> r
diameter :: [Point 2 r :+ p] -> r
diameter = r
-> ((Point 2 r :+ p, Point 2 r :+ p) -> r)
-> Maybe (Point 2 r :+ p, Point 2 r :+ p)
-> r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe r
0 (\(Point 2 r :+ p
p,Point 2 r :+ p
q) -> Point 2 r -> Point 2 r -> r
forall r (d :: Nat).
(Floating r, Arity d) =>
Point d r -> Point d r -> r
euclideanDist (Point 2 r :+ p
p(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point 2 r :+ p
q(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)) (Maybe (Point 2 r :+ p, Point 2 r :+ p) -> r)
-> ([Point 2 r :+ p] -> Maybe (Point 2 r :+ p, Point 2 r :+ p))
-> [Point 2 r :+ p]
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point 2 r :+ p] -> Maybe (Point 2 r :+ p, Point 2 r :+ p)
forall r p.
(Ord r, Num r) =>
[Point 2 r :+ p] -> Maybe (Point 2 r :+ p, Point 2 r :+ p)
diametralPair

-- | Computes the Euclidean diameter by first finding the convex hull.
--
-- running time: \(O(n \log n)\)
diametralPair :: (Ord r, Num r)
                   => [Point 2 r :+ p] -> Maybe (Point 2 r :+ p, Point 2 r :+ p)
diametralPair :: [Point 2 r :+ p] -> Maybe (Point 2 r :+ p, Point 2 r :+ p)
diametralPair lst :: [Point 2 r :+ p]
lst@(Point 2 r :+ p
_:Point 2 r :+ p
_:Point 2 r :+ p
_:[Point 2 r :+ p]
_) = (Point 2 r :+ p, Point 2 r :+ p)
-> Maybe (Point 2 r :+ p, Point 2 r :+ p)
forall a. a -> Maybe a
Just ((Point 2 r :+ p, Point 2 r :+ p)
 -> Maybe (Point 2 r :+ p, Point 2 r :+ p))
-> (ConvexPolygon p r -> (Point 2 r :+ p, Point 2 r :+ p))
-> ConvexPolygon p r
-> Maybe (Point 2 r :+ p, Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConvexPolygon p r -> (Point 2 r :+ p, Point 2 r :+ p)
forall r p.
(Ord r, Num r) =>
ConvexPolygon p r -> (Point 2 r :+ p, Point 2 r :+ p)
Convex.diametralPair (ConvexPolygon p r -> Maybe (Point 2 r :+ p, Point 2 r :+ p))
-> ConvexPolygon p r -> Maybe (Point 2 r :+ p, Point 2 r :+ p)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Point 2 r :+ p) -> ConvexPolygon p r
forall r p.
(Ord r, Num r) =>
NonEmpty (Point 2 r :+ p) -> ConvexPolygon p r
convexHull (NonEmpty (Point 2 r :+ p) -> ConvexPolygon p r)
-> NonEmpty (Point 2 r :+ p) -> ConvexPolygon p r
forall a b. (a -> b) -> a -> b
$ [Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p)
forall a. [a] -> NonEmpty a
NonEmpty.fromList [Point 2 r :+ p]
lst
diametralPair [Point 2 r :+ p]
lst           = [Point 2 r :+ p] -> Maybe (Point 2 r :+ p, Point 2 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)
Naive.diametralPair [Point 2 r :+ p]
lst