{-# LANGUAGE TemplateHaskell  #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Algorithms.Geometry.SmallestEnclosingBall.Types
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Types to represent the smallest enclosing disk of a set of points in
-- \(\mathbb{R}^2\)
--
--------------------------------------------------------------------------------
module Algorithms.Geometry.SmallestEnclosingBall.Types where

import qualified Data.Foldable as F
import           Data.Geometry
import           Data.Geometry.Ball
import           Control.Lens
import           Data.Ext

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

-- | List of two or three elements
data TwoOrThree a = Two !a !a | Three !a !a !a deriving (Int -> TwoOrThree a -> ShowS
[TwoOrThree a] -> ShowS
TwoOrThree a -> String
(Int -> TwoOrThree a -> ShowS)
-> (TwoOrThree a -> String)
-> ([TwoOrThree a] -> ShowS)
-> Show (TwoOrThree a)
forall a. Show a => Int -> TwoOrThree a -> ShowS
forall a. Show a => [TwoOrThree a] -> ShowS
forall a. Show a => TwoOrThree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TwoOrThree a] -> ShowS
$cshowList :: forall a. Show a => [TwoOrThree a] -> ShowS
show :: TwoOrThree a -> String
$cshow :: forall a. Show a => TwoOrThree a -> String
showsPrec :: Int -> TwoOrThree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> TwoOrThree a -> ShowS
Show,ReadPrec [TwoOrThree a]
ReadPrec (TwoOrThree a)
Int -> ReadS (TwoOrThree a)
ReadS [TwoOrThree a]
(Int -> ReadS (TwoOrThree a))
-> ReadS [TwoOrThree a]
-> ReadPrec (TwoOrThree a)
-> ReadPrec [TwoOrThree a]
-> Read (TwoOrThree a)
forall a. Read a => ReadPrec [TwoOrThree a]
forall a. Read a => ReadPrec (TwoOrThree a)
forall a. Read a => Int -> ReadS (TwoOrThree a)
forall a. Read a => ReadS [TwoOrThree a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TwoOrThree a]
$creadListPrec :: forall a. Read a => ReadPrec [TwoOrThree a]
readPrec :: ReadPrec (TwoOrThree a)
$creadPrec :: forall a. Read a => ReadPrec (TwoOrThree a)
readList :: ReadS [TwoOrThree a]
$creadList :: forall a. Read a => ReadS [TwoOrThree a]
readsPrec :: Int -> ReadS (TwoOrThree a)
$creadsPrec :: forall a. Read a => Int -> ReadS (TwoOrThree a)
Read,TwoOrThree a -> TwoOrThree a -> Bool
(TwoOrThree a -> TwoOrThree a -> Bool)
-> (TwoOrThree a -> TwoOrThree a -> Bool) -> Eq (TwoOrThree a)
forall a. Eq a => TwoOrThree a -> TwoOrThree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TwoOrThree a -> TwoOrThree a -> Bool
$c/= :: forall a. Eq a => TwoOrThree a -> TwoOrThree a -> Bool
== :: TwoOrThree a -> TwoOrThree a -> Bool
$c== :: forall a. Eq a => TwoOrThree a -> TwoOrThree a -> Bool
Eq,Eq (TwoOrThree a)
Eq (TwoOrThree a)
-> (TwoOrThree a -> TwoOrThree a -> Ordering)
-> (TwoOrThree a -> TwoOrThree a -> Bool)
-> (TwoOrThree a -> TwoOrThree a -> Bool)
-> (TwoOrThree a -> TwoOrThree a -> Bool)
-> (TwoOrThree a -> TwoOrThree a -> Bool)
-> (TwoOrThree a -> TwoOrThree a -> TwoOrThree a)
-> (TwoOrThree a -> TwoOrThree a -> TwoOrThree a)
-> Ord (TwoOrThree a)
TwoOrThree a -> TwoOrThree a -> Bool
TwoOrThree a -> TwoOrThree a -> Ordering
TwoOrThree a -> TwoOrThree a -> TwoOrThree a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (TwoOrThree a)
forall a. Ord a => TwoOrThree a -> TwoOrThree a -> Bool
forall a. Ord a => TwoOrThree a -> TwoOrThree a -> Ordering
forall a. Ord a => TwoOrThree a -> TwoOrThree a -> TwoOrThree a
min :: TwoOrThree a -> TwoOrThree a -> TwoOrThree a
$cmin :: forall a. Ord a => TwoOrThree a -> TwoOrThree a -> TwoOrThree a
max :: TwoOrThree a -> TwoOrThree a -> TwoOrThree a
$cmax :: forall a. Ord a => TwoOrThree a -> TwoOrThree a -> TwoOrThree a
>= :: TwoOrThree a -> TwoOrThree a -> Bool
$c>= :: forall a. Ord a => TwoOrThree a -> TwoOrThree a -> Bool
> :: TwoOrThree a -> TwoOrThree a -> Bool
$c> :: forall a. Ord a => TwoOrThree a -> TwoOrThree a -> Bool
<= :: TwoOrThree a -> TwoOrThree a -> Bool
$c<= :: forall a. Ord a => TwoOrThree a -> TwoOrThree a -> Bool
< :: TwoOrThree a -> TwoOrThree a -> Bool
$c< :: forall a. Ord a => TwoOrThree a -> TwoOrThree a -> Bool
compare :: TwoOrThree a -> TwoOrThree a -> Ordering
$ccompare :: forall a. Ord a => TwoOrThree a -> TwoOrThree a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (TwoOrThree a)
Ord,a -> TwoOrThree b -> TwoOrThree a
(a -> b) -> TwoOrThree a -> TwoOrThree b
(forall a b. (a -> b) -> TwoOrThree a -> TwoOrThree b)
-> (forall a b. a -> TwoOrThree b -> TwoOrThree a)
-> Functor TwoOrThree
forall a b. a -> TwoOrThree b -> TwoOrThree a
forall a b. (a -> b) -> TwoOrThree a -> TwoOrThree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TwoOrThree b -> TwoOrThree a
$c<$ :: forall a b. a -> TwoOrThree b -> TwoOrThree a
fmap :: (a -> b) -> TwoOrThree a -> TwoOrThree b
$cfmap :: forall a b. (a -> b) -> TwoOrThree a -> TwoOrThree b
Functor)

instance F.Foldable TwoOrThree where
  foldMap :: (a -> m) -> TwoOrThree a -> m
foldMap a -> m
f (Two   a
a a
b)   = a -> m
f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
b
  foldMap a -> m
f (Three a
a a
b a
c) = a -> m
f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
b m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
c

-- | Construct datatype from list with exactly two or three elements.
twoOrThreeFromList         :: [a] -> Either String (TwoOrThree a)
twoOrThreeFromList :: [a] -> Either String (TwoOrThree a)
twoOrThreeFromList [a
a,a
b]   = TwoOrThree a -> Either String (TwoOrThree a)
forall a b. b -> Either a b
Right (TwoOrThree a -> Either String (TwoOrThree a))
-> TwoOrThree a -> Either String (TwoOrThree a)
forall a b. (a -> b) -> a -> b
$ a -> a -> TwoOrThree a
forall a. a -> a -> TwoOrThree a
Two a
a a
b
twoOrThreeFromList [a
a,a
b,a
c] = TwoOrThree a -> Either String (TwoOrThree a)
forall a b. b -> Either a b
Right (TwoOrThree a -> Either String (TwoOrThree a))
-> TwoOrThree a -> Either String (TwoOrThree a)
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> TwoOrThree a
forall a. a -> a -> a -> TwoOrThree a
Three a
a a
b a
c
twoOrThreeFromList [a]
_       = String -> Either String (TwoOrThree a)
forall a b. a -> Either a b
Left String
"Wrong number of elements"




-- | The result of a smallest enclosing disk computation: The smallest ball
--    and the points defining it
data DiskResult p r = DiskResult { DiskResult p r -> Disk () r
_enclosingDisk  :: Disk () r
                                 , DiskResult p r -> TwoOrThree (Point 2 r :+ p)
_definingPoints :: TwoOrThree (Point 2 r :+ p)
                                 } deriving (Int -> DiskResult p r -> ShowS
[DiskResult p r] -> ShowS
DiskResult p r -> String
(Int -> DiskResult p r -> ShowS)
-> (DiskResult p r -> String)
-> ([DiskResult p r] -> ShowS)
-> Show (DiskResult p r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p r. (Show r, Show p) => Int -> DiskResult p r -> ShowS
forall p r. (Show r, Show p) => [DiskResult p r] -> ShowS
forall p r. (Show r, Show p) => DiskResult p r -> String
showList :: [DiskResult p r] -> ShowS
$cshowList :: forall p r. (Show r, Show p) => [DiskResult p r] -> ShowS
show :: DiskResult p r -> String
$cshow :: forall p r. (Show r, Show p) => DiskResult p r -> String
showsPrec :: Int -> DiskResult p r -> ShowS
$cshowsPrec :: forall p r. (Show r, Show p) => Int -> DiskResult p r -> ShowS
Show,DiskResult p r -> DiskResult p r -> Bool
(DiskResult p r -> DiskResult p r -> Bool)
-> (DiskResult p r -> DiskResult p r -> Bool)
-> Eq (DiskResult p r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall p r.
(Eq r, Eq p) =>
DiskResult p r -> DiskResult p r -> Bool
/= :: DiskResult p r -> DiskResult p r -> Bool
$c/= :: forall p r.
(Eq r, Eq p) =>
DiskResult p r -> DiskResult p r -> Bool
== :: DiskResult p r -> DiskResult p r -> Bool
$c== :: forall p r.
(Eq r, Eq p) =>
DiskResult p r -> DiskResult p r -> Bool
Eq)
makeLenses ''DiskResult