{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
module Diagrams.TwoD.Points where
import Data.List
import Diagrams.Core
import Diagrams.TwoD.Vector
import Diagrams.TwoD.Types (P2)
import Linear.Affine
convexHull2D :: OrderedField n => [P2 n] -> [P2 n]
convexHull2D :: forall n. OrderedField n => [P2 n] -> [P2 n]
convexHull2D [P2 n]
ps = forall a. [a] -> [a]
init [P2 n]
upper forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse (forall a. [a] -> [a]
tail [P2 n]
lower)
where
([P2 n]
upper, [P2 n]
lower) = forall n. OrderedField n => [P2 n] -> ([P2 n], [P2 n])
sortedConvexHull (forall a. Ord a => [a] -> [a]
sort [P2 n]
ps)
sortedConvexHull :: OrderedField n => [P2 n] -> ([P2 n], [P2 n])
sortedConvexHull :: forall n. OrderedField n => [P2 n] -> ([P2 n], [P2 n])
sortedConvexHull [P2 n]
ps = (forall {p :: * -> *} {a}.
(Diff p ~ V2, Ord a, Num a, Affine p) =>
Bool -> [p a] -> [p a]
chain Bool
True [P2 n]
ps, forall {p :: * -> *} {a}.
(Diff p ~ V2, Ord a, Num a, Affine p) =>
Bool -> [p a] -> [p a]
chain Bool
False [P2 n]
ps)
where
chain :: Bool -> [p a] -> [p a]
chain Bool
upper (p a
p1_:p a
p2_:[p a]
rest_) =
case V2 a -> p a -> [p a] -> Either [p a] [p a]
go (p a
p2_ forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. p a
p1_) p a
p2_ [p a]
rest_ of
Right [p a]
l -> p a
p1_forall a. a -> [a] -> [a]
:[p a]
l
Left [p a]
l -> Bool -> [p a] -> [p a]
chain Bool
upper (p a
p1_forall a. a -> [a] -> [a]
:[p a]
l)
where
test :: a -> Bool
test = if Bool
upper then (forall a. Ord a => a -> a -> Bool
>a
0) else (forall a. Ord a => a -> a -> Bool
<a
0)
go :: V2 a -> p a -> [p a] -> Either [p a] [p a]
go V2 a
dir p a
p1 l :: [p a]
l@(p a
p2:[p a]
rest)
| a -> Bool
test forall a b. (a -> b) -> a -> b
$ V2 a
dir forall n. Num n => V2 n -> V2 n -> n
`cross2` Diff p a
dir' = forall a b. a -> Either a b
Left [p a]
l
| Bool
otherwise =
case V2 a -> p a -> [p a] -> Either [p a] [p a]
go Diff p a
dir' p a
p2 [p a]
rest of
Left [p a]
m -> V2 a -> p a -> [p a] -> Either [p a] [p a]
go V2 a
dir p a
p1 [p a]
m
Right [p a]
m -> forall a b. b -> Either a b
Right (p a
p1forall a. a -> [a] -> [a]
:[p a]
m)
where
dir' :: Diff p a
dir' = p a
p2 forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. p a
p1
go V2 a
_ p a
p1 [p a]
p = forall a b. b -> Either a b
Right (p a
p1forall a. a -> [a] -> [a]
:[p a]
p)
chain Bool
_ [p a]
l = [p a]
l