{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      :  Diagrams.TwoD.Points
-- Copyright   :  (c) 2014 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Special functions for points in R2.
module Diagrams.TwoD.Points where

import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Diagrams.Core
import Diagrams.TwoD.Types (P2)
import Diagrams.TwoD.Vector

import Linear.Affine

-- | Find the convex hull of a list of points using Andrew's monotone chain
--   algorithm O(n log n).
--
--   Returns clockwise list of points starting from the left-most point.
convexHull2D :: OrderedField n => [P2 n] -> [P2 n]
convexHull2D :: forall n. OrderedField n => [P2 n] -> [P2 n]
convexHull2D [] = []
convexHull2D (P2 n
p : [P2 n]
ps) = NonEmpty (P2 n) -> [P2 n]
forall a. NonEmpty a -> [a]
NE.init NonEmpty (P2 n)
upper [P2 n] -> [P2 n] -> [P2 n]
forall a. [a] -> [a] -> [a]
++ [P2 n] -> [P2 n]
forall a. [a] -> [a]
reverse (NonEmpty (P2 n) -> [P2 n]
forall a. NonEmpty a -> [a]
NE.tail NonEmpty (P2 n)
lower)
 where
  (NonEmpty (P2 n)
upper, NonEmpty (P2 n)
lower) = NonEmpty (P2 n) -> (NonEmpty (P2 n), NonEmpty (P2 n))
forall n.
OrderedField n =>
NonEmpty (P2 n) -> (NonEmpty (P2 n), NonEmpty (P2 n))
sortedConvexHull (NonEmpty (P2 n) -> NonEmpty (P2 n)
forall a. Ord a => NonEmpty a -> NonEmpty a
NE.sort (P2 n
p P2 n -> [P2 n] -> NonEmpty (P2 n)
forall a. a -> [a] -> NonEmpty a
:| [P2 n]
ps))

-- | Find the convex hull of a set of points already sorted in the x direction.
--   The first list of the tuple is the upper hull going clockwise from
--   left-most to right-most point. The second is the lower hull from
--   right-most to left-most in the anti-clockwise direction.
sortedConvexHull :: OrderedField n => NonEmpty (P2 n) -> (NonEmpty (P2 n), NonEmpty (P2 n))
sortedConvexHull :: forall n.
OrderedField n =>
NonEmpty (P2 n) -> (NonEmpty (P2 n), NonEmpty (P2 n))
sortedConvexHull NonEmpty (P2 n)
ps = (Bool -> NonEmpty (P2 n) -> NonEmpty (P2 n)
forall {p :: * -> *} {a}.
(Diff p ~ V2, Ord a, Affine p, Num a) =>
Bool -> NonEmpty (p a) -> NonEmpty (p a)
chain Bool
True NonEmpty (P2 n)
ps, Bool -> NonEmpty (P2 n) -> NonEmpty (P2 n)
forall {p :: * -> *} {a}.
(Diff p ~ V2, Ord a, Affine p, Num a) =>
Bool -> NonEmpty (p a) -> NonEmpty (p a)
chain Bool
False NonEmpty (P2 n)
ps)
 where
  chain :: Bool -> NonEmpty (p a) -> NonEmpty (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_ p a -> p a -> Diff p a
forall a. Num a => p a -> p a -> Diff p a
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_ p a -> [p a] -> NonEmpty (p a)
forall a. a -> [a] -> NonEmpty a
:| [p a]
l
      Left [p a]
l -> Bool -> NonEmpty (p a) -> NonEmpty (p a)
chain Bool
upper (p a
p1_ p a -> [p a] -> NonEmpty (p a)
forall a. a -> [a] -> NonEmpty a
:| [p a]
l)
   where
    test :: a -> Bool
test = if Bool
upper then (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0) else (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0)
    -- find the convex hull by comparing the angles of the vectors with
    -- the cross product and backtracking if necessary
    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)
      -- backtrack if the direction is outward
      | a -> Bool
test (a -> Bool) -> a -> Bool
forall a b. (a -> b) -> a -> b
$ V2 a
dir V2 a -> V2 a -> a
forall n. Num n => V2 n -> V2 n -> n
`cross2` V2 a
Diff p a
dir' = [p a] -> Either [p a] [p a]
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 V2 a
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 -> [p a] -> Either [p a] [p a]
forall a b. b -> Either a b
Right (p a
p1 p a -> [p a] -> [p a]
forall a. a -> [a] -> [a]
: [p a]
m)
     where
      dir' :: Diff p a
dir' = p a
p2 p a -> p a -> Diff p a
forall a. Num a => p a -> p a -> Diff p a
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 = [p a] -> Either [p a] [p a]
forall a b. b -> Either a b
Right (p a
p1 p a -> [p a] -> [p a]
forall a. a -> [a] -> [a]
: [p a]
p)
  chain Bool
_ NonEmpty (p a)
l = NonEmpty (p a)
l