module Algorithms.Geometry.SmallestEnclosingBall.Naive where
import Control.Lens
import Data.Ext
import Algorithms.Geometry.SmallestEnclosingBall.Types
import Data.Geometry.Ball
import Data.Geometry.Point
import Data.List(minimumBy)
import Data.Function(on)
import Data.Maybe(fromMaybe)
import Algorithms.Util
smallestEnclosingDisk :: (Ord r, Fractional r)
=> [Point 2 r :+ p]
-> DiskResult p r
smallestEnclosingDisk pts@(_:_:_) = smallestEnclosingDisk' pts $
pairs pts ++ triplets pts
smallestEnclosingDisk _ = error "smallestEnclosingDisk: Too few points"
pairs :: Fractional r => [Point 2 r :+ p] -> [DiskResult p r]
pairs pts = [DiskResult (fromDiameter (a^.core) (b^.core)) (Two a b)
| SP a b <- uniquePairs pts]
triplets :: (Ord r, Fractional r) => [Point 2 r :+ p] -> [DiskResult p r]
triplets pts = [DiskResult (disk' a b c) (Three a b c)
| ST a b c <- uniqueTriplets pts]
disk' :: (Ord r, Fractional r)
=> Point 2 r :+ p -> Point 2 r :+ p -> Point 2 r :+ p -> Disk () r
disk' a b c = fromMaybe degen $ disk (a^.core) (b^.core) (c^.core)
where
degen = (smallestEnclosingDisk' [a,b,c] $ pairs [a,b,c])^.enclosingDisk
smallestEnclosingDisk' :: (Ord r, Num r)
=> [Point 2 r :+ p] -> [DiskResult p r] -> DiskResult p r
smallestEnclosingDisk' pts = minimumBy (compare `on` (^.enclosingDisk.squaredRadius))
. filter (flip enclosesAll pts)
enclosesAll :: (Num r, Ord r) => DiskResult p r -> [Point 2 r :+ q] -> Bool
enclosesAll d = all (\(p :+ _) -> p `inClosedBall` (d^.enclosingDisk))