--------------------------------------------------------------------------------
-- |
-- Module      :  Algorithms.Geometry.ConvexHull.GrahamScan
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Algorithms.Geometry.ConvexHull.GrahamScan( convexHull
                                                , upperHull, upperHull'
                                                , lowerHull, lowerHull'

                                                , upperHullFromSorted, upperHullFromSorted'
                                                ) where

import           Control.Lens ((^.))
import           Data.Ext
import           Data.Geometry.Point
import           Data.Geometry.Polygon
import           Data.Geometry.Polygon.Convex (ConvexPolygon(..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.List.NonEmpty (NonEmpty(..))


-- | \(O(n \log n)\) time ConvexHull using Graham-Scan. The resulting polygon is
-- given in clockwise order.
convexHull            :: (Ord r, Num r)
                      => NonEmpty (Point 2 r :+ p) -> ConvexPolygon p r
convexHull :: NonEmpty (Point 2 r :+ p) -> ConvexPolygon p r
convexHull (Point 2 r :+ p
p :| []) = SimplePolygon p r -> ConvexPolygon p r
forall p r. SimplePolygon p r -> ConvexPolygon p r
ConvexPolygon (SimplePolygon p r -> ConvexPolygon p r)
-> ([Point 2 r :+ p] -> SimplePolygon p r)
-> [Point 2 r :+ p]
-> ConvexPolygon p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point 2 r :+ p] -> SimplePolygon p r
forall r p. [Point 2 r :+ p] -> SimplePolygon p r
unsafeFromPoints ([Point 2 r :+ p] -> ConvexPolygon p r)
-> [Point 2 r :+ p] -> ConvexPolygon p r
forall a b. (a -> b) -> a -> b
$ [Point 2 r :+ p
p]
convexHull NonEmpty (Point 2 r :+ p)
ps        = let ps' :: [Point 2 r :+ p]
ps' = NonEmpty (Point 2 r :+ p) -> [Point 2 r :+ p]
forall a. NonEmpty a -> [a]
NonEmpty.toList (NonEmpty (Point 2 r :+ p) -> [Point 2 r :+ p])
-> (NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p))
-> NonEmpty (Point 2 r :+ p)
-> [Point 2 r :+ p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NonEmpty.sortBy (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
forall r p q.
Ord r =>
(Point 2 r :+ p) -> (Point 2 r :+ q) -> Ordering
incXdecY (NonEmpty (Point 2 r :+ p) -> [Point 2 r :+ p])
-> NonEmpty (Point 2 r :+ p) -> [Point 2 r :+ p]
forall a b. (a -> b) -> a -> b
$ NonEmpty (Point 2 r :+ p)
ps
                           uh :: [Point 2 r :+ p]
uh  = NonEmpty (Point 2 r :+ p) -> [Point 2 r :+ p]
forall a. NonEmpty a -> [a]
NonEmpty.tail (NonEmpty (Point 2 r :+ p) -> [Point 2 r :+ p])
-> ([Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p))
-> [Point 2 r :+ p]
-> [Point 2 r :+ p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p)
forall r p.
(Ord r, Num r) =>
[Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p)
hull' ([Point 2 r :+ p] -> [Point 2 r :+ p])
-> [Point 2 r :+ p] -> [Point 2 r :+ p]
forall a b. (a -> b) -> a -> b
$         [Point 2 r :+ p]
ps'
                           lh :: [Point 2 r :+ p]
lh  = NonEmpty (Point 2 r :+ p) -> [Point 2 r :+ p]
forall a. NonEmpty a -> [a]
NonEmpty.tail (NonEmpty (Point 2 r :+ p) -> [Point 2 r :+ p])
-> ([Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p))
-> [Point 2 r :+ p]
-> [Point 2 r :+ p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p)
forall r p.
(Ord r, Num r) =>
[Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p)
hull' ([Point 2 r :+ p] -> [Point 2 r :+ p])
-> [Point 2 r :+ p] -> [Point 2 r :+ p]
forall a b. (a -> b) -> a -> b
$ [Point 2 r :+ p] -> [Point 2 r :+ p]
forall a. [a] -> [a]
reverse [Point 2 r :+ p]
ps'
                       in SimplePolygon p r -> ConvexPolygon p r
forall p r. SimplePolygon p r -> ConvexPolygon p r
ConvexPolygon (SimplePolygon p r -> ConvexPolygon p r)
-> ([Point 2 r :+ p] -> SimplePolygon p r)
-> [Point 2 r :+ p]
-> ConvexPolygon p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point 2 r :+ p] -> SimplePolygon p r
forall r p. [Point 2 r :+ p] -> SimplePolygon p r
unsafeFromPoints ([Point 2 r :+ p] -> SimplePolygon p r)
-> ([Point 2 r :+ p] -> [Point 2 r :+ p])
-> [Point 2 r :+ p]
-> SimplePolygon p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point 2 r :+ p] -> [Point 2 r :+ p]
forall a. [a] -> [a]
reverse ([Point 2 r :+ p] -> ConvexPolygon p r)
-> [Point 2 r :+ p] -> ConvexPolygon p r
forall a b. (a -> b) -> a -> b
$ [Point 2 r :+ p]
lh [Point 2 r :+ p] -> [Point 2 r :+ p] -> [Point 2 r :+ p]
forall a. [a] -> [a] -> [a]
++ [Point 2 r :+ p]
uh

-- | Computes the upper hull. The upper hull is given from left to right.
--
-- Specifically. A pair of points defines an edge of the upper hull
-- iff all other points are strictly to the right of its supporting
-- line.
--
-- Note that this definition implies that the segment may be
-- vertical. Use 'upperHull'' if such an edge should not be reported.
--
-- running time: \(O(n\log n)\)
upperHull  :: (Ord r, Num r) => NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
upperHull :: NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
upperHull = NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse (NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p))
-> (NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p))
-> NonEmpty (Point 2 r :+ p)
-> NonEmpty (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Point 2 r :+ p] -> [Point 2 r :+ p])
-> NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall r p.
(Ord r, Num r) =>
([Point 2 r :+ p] -> [Point 2 r :+ p])
-> NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
hull [Point 2 r :+ p] -> [Point 2 r :+ p]
forall a. a -> a
id

-- | Computes the upper hull, making sure that there are no vertical segments.
--
-- The upper hull is given from left to right
--
upperHull'  :: (Ord r, Num r) => NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
upperHull' :: NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
upperHull' = NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse (NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p))
-> (NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p))
-> NonEmpty (Point 2 r :+ p)
-> NonEmpty (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall r p.
Eq r =>
NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
dropVertical (NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p))
-> (NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p))
-> NonEmpty (Point 2 r :+ p)
-> NonEmpty (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Point 2 r :+ p] -> [Point 2 r :+ p])
-> NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall r p.
(Ord r, Num r) =>
([Point 2 r :+ p] -> [Point 2 r :+ p])
-> NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
hull [Point 2 r :+ p] -> [Point 2 r :+ p]
forall a. a -> a
id

-- | Helper function to remove vertical segments from the hull.
--
-- Tests if the first two points are on a vertical line, if so removes
-- the first point.
dropVertical :: Eq r => NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
dropVertical :: NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
dropVertical = \case
  h :: NonEmpty (Point 2 r :+ p)
h@(Point 2 r :+ p
_ :| [])                                            -> NonEmpty (Point 2 r :+ p)
h
  h :: NonEmpty (Point 2 r :+ p)
h@(Point 2 r :+ p
p :| (Point 2 r :+ p
q : [Point 2 r :+ p]
rest)) | Point 2 r :+ p
p(Point 2 r :+ p) -> Getting r (Point 2 r :+ p) r -> r
forall s a. s -> Getting a s a -> a
^.(Point 2 r -> Const r (Point 2 r))
-> (Point 2 r :+ p) -> Const r (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((Point 2 r -> Const r (Point 2 r))
 -> (Point 2 r :+ p) -> Const r (Point 2 r :+ p))
-> ((r -> Const r r) -> Point 2 r -> Const r (Point 2 r))
-> Getting r (Point 2 r :+ p) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> Point 2 r -> Const r (Point 2 r)
forall (d :: Nat) (point :: Nat -> * -> *) r.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== Point 2 r :+ p
q(Point 2 r :+ p) -> Getting r (Point 2 r :+ p) r -> r
forall s a. s -> Getting a s a -> a
^.(Point 2 r -> Const r (Point 2 r))
-> (Point 2 r :+ p) -> Const r (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((Point 2 r -> Const r (Point 2 r))
 -> (Point 2 r :+ p) -> Const r (Point 2 r :+ p))
-> ((r -> Const r r) -> Point 2 r -> Const r (Point 2 r))
-> Getting r (Point 2 r :+ p) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> Point 2 r -> Const r (Point 2 r)
forall (d :: Nat) (point :: Nat -> * -> *) r.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord -> Point 2 r :+ p
q (Point 2 r :+ p) -> [Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p)
forall a. a -> [a] -> NonEmpty a
:| [Point 2 r :+ p]
rest
                      | Bool
otherwise                        -> NonEmpty (Point 2 r :+ p)
h


-- | Computes the upper hull. The upper hull is given from left to right.
--
-- Specifically. A pair of points defines an edge of the lower hull
-- iff all other points are strictly to the left of its supporting
-- line.
--
-- Note that this definition implies that the segment may be
-- vertical. Use 'lowerHull'' if such an edge should not be reported.
--
-- running time: \(O(n\log n)\)
lowerHull :: (Ord r, Num r) => NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
lowerHull :: NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
lowerHull = ([Point 2 r :+ p] -> [Point 2 r :+ p])
-> NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall r p.
(Ord r, Num r) =>
([Point 2 r :+ p] -> [Point 2 r :+ p])
-> NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
hull [Point 2 r :+ p] -> [Point 2 r :+ p]
forall a. [a] -> [a]
reverse

-- | Computes the lower hull, making sure there are no vertical
-- segments. (Note that the only such segment could be the first
-- segment).
lowerHull' :: (Ord r, Num r) => NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
lowerHull' :: NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
lowerHull' = NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall r p.
Eq r =>
NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
dropVertical (NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p))
-> (NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p))
-> NonEmpty (Point 2 r :+ p)
-> NonEmpty (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Point 2 r :+ p] -> [Point 2 r :+ p])
-> NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall r p.
(Ord r, Num r) =>
([Point 2 r :+ p] -> [Point 2 r :+ p])
-> NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
hull [Point 2 r :+ p] -> [Point 2 r :+ p]
forall a. [a] -> [a]
reverse

-- | Helper function so that that can compute both the upper or the lower hull, depending
-- on the function f
hull               :: (Ord r, Num r)
                   => ([Point 2 r :+ p] -> [Point 2 r :+ p])
                   -> NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
hull :: ([Point 2 r :+ p] -> [Point 2 r :+ p])
-> NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
hull [Point 2 r :+ p] -> [Point 2 r :+ p]
_ h :: NonEmpty (Point 2 r :+ p)
h@(Point 2 r :+ p
_ :| []) = NonEmpty (Point 2 r :+ p)
h
hull [Point 2 r :+ p] -> [Point 2 r :+ p]
f NonEmpty (Point 2 r :+ p)
pts         = [Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p)
forall r p.
(Ord r, Num r) =>
[Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p)
hull' ([Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p))
-> (NonEmpty (Point 2 r :+ p) -> [Point 2 r :+ p])
-> NonEmpty (Point 2 r :+ p)
-> NonEmpty (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  [Point 2 r :+ p] -> [Point 2 r :+ p]
f
                   ([Point 2 r :+ p] -> [Point 2 r :+ p])
-> (NonEmpty (Point 2 r :+ p) -> [Point 2 r :+ p])
-> NonEmpty (Point 2 r :+ p)
-> [Point 2 r :+ p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Point 2 r :+ p) -> [Point 2 r :+ p]
forall a. NonEmpty a -> [a]
NonEmpty.toList (NonEmpty (Point 2 r :+ p) -> [Point 2 r :+ p])
-> (NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p))
-> NonEmpty (Point 2 r :+ p)
-> [Point 2 r :+ p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NonEmpty.sortBy (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
forall r p q.
Ord r =>
(Point 2 r :+ p) -> (Point 2 r :+ q) -> Ordering
incXdecY (NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p))
-> NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Point 2 r :+ p)
pts

incXdecY  :: Ord r => Point 2 r :+ p -> Point 2 r :+ q -> Ordering
incXdecY :: (Point 2 r :+ p) -> (Point 2 r :+ q) -> Ordering
incXdecY (Point2 r
px r
py :+ p
_) (Point2 r
qx r
qy :+ q
_) =
  r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
compare r
px r
qx Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
compare r
qy r
py


-- | Given a sequence of points that is sorted on increasing
-- x-coordinate and decreasing y-coordinate, computes the upper
-- hull, in *right to left order*.
--
-- Specifically. A pair of points defines an edge of the upper hull
-- iff all other points are strictly to the right of its supporting
-- line.
--
--
-- Note that In constrast to the 'upperHull' function, the result is
-- returned *from right to left* !!!
--
-- running time: \(O(n)\).
upperHullFromSorted :: (Ord r, Num r) => NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
upperHullFromSorted :: NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
upperHullFromSorted = \case
  h :: NonEmpty (Point 2 r :+ p)
h@(Point 2 r :+ p
_ :| [])  -> NonEmpty (Point 2 r :+ p)
h
  NonEmpty (Point 2 r :+ p)
pts          -> [Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p)
forall r p.
(Ord r, Num r) =>
[Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p)
hull' ([Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p))
-> [Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Point 2 r :+ p) -> [Point 2 r :+ p]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Point 2 r :+ p)
pts

-- | Computes the upper hull from a sorted input. Removes the last vertical segment.
--
--
-- running time: \(O(n)\).
upperHullFromSorted' :: (Ord r, Num r) => NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
upperHullFromSorted' :: NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
upperHullFromSorted' = NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall r p.
Eq r =>
NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
dropVertical (NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p))
-> (NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p))
-> NonEmpty (Point 2 r :+ p)
-> NonEmpty (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall r p.
(Ord r, Num r) =>
NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
upperHullFromSorted


-- | Precondition: The list of input points is sorted
hull'          :: (Ord r, Num r) => [Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p)
hull' :: [Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p)
hull' (Point 2 r :+ p
a:Point 2 r :+ p
b:[Point 2 r :+ p]
ps) = [Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p)
forall a. [a] -> NonEmpty a
NonEmpty.fromList ([Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p))
-> [Point 2 r :+ p] -> NonEmpty (Point 2 r :+ p)
forall a b. (a -> b) -> a -> b
$ [Point 2 r :+ p] -> [Point 2 r :+ p] -> [Point 2 r :+ p]
forall r extra.
(Ord r, Num r) =>
[Point 2 r :+ extra]
-> [Point 2 r :+ extra] -> [Point 2 r :+ extra]
hull'' [Point 2 r :+ p
b,Point 2 r :+ p
a] [Point 2 r :+ p]
ps
  where
    hull'' :: [Point 2 r :+ extra]
-> [Point 2 r :+ extra] -> [Point 2 r :+ extra]
hull'' [Point 2 r :+ extra]
h []      = [Point 2 r :+ extra]
h
    hull'' [Point 2 r :+ extra]
h (Point 2 r :+ extra
p:[Point 2 r :+ extra]
ps') = [Point 2 r :+ extra]
-> [Point 2 r :+ extra] -> [Point 2 r :+ extra]
hull'' ([Point 2 r :+ extra] -> [Point 2 r :+ extra]
forall r extra.
(Ord r, Num r) =>
[Point 2 r :+ extra] -> [Point 2 r :+ extra]
cleanMiddle (Point 2 r :+ extra
p(Point 2 r :+ extra)
-> [Point 2 r :+ extra] -> [Point 2 r :+ extra]
forall a. a -> [a] -> [a]
:[Point 2 r :+ extra]
h)) [Point 2 r :+ extra]
ps'

    cleanMiddle :: [Point 2 r :+ extra] -> [Point 2 r :+ extra]
cleanMiddle h :: [Point 2 r :+ extra]
h@[Point 2 r :+ extra
_,Point 2 r :+ extra
_]                         = [Point 2 r :+ extra]
h
    cleanMiddle h :: [Point 2 r :+ extra]
h@(Point 2 r :+ extra
z:Point 2 r :+ extra
y:Point 2 r :+ extra
x:[Point 2 r :+ extra]
rest)
      | Point 2 r -> Point 2 r -> Point 2 r -> Bool
forall r.
(Ord r, Num r) =>
Point 2 r -> Point 2 r -> Point 2 r -> Bool
rightTurn (Point 2 r :+ extra
x(Point 2 r :+ extra)
-> Getting (Point 2 r) (Point 2 r :+ extra) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ extra) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point 2 r :+ extra
y(Point 2 r :+ extra)
-> Getting (Point 2 r) (Point 2 r :+ extra) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ extra) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point 2 r :+ extra
z(Point 2 r :+ extra)
-> Getting (Point 2 r) (Point 2 r :+ extra) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ extra) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) = [Point 2 r :+ extra]
h
      | Bool
otherwise                               = [Point 2 r :+ extra] -> [Point 2 r :+ extra]
cleanMiddle (Point 2 r :+ extra
z(Point 2 r :+ extra)
-> [Point 2 r :+ extra] -> [Point 2 r :+ extra]
forall a. a -> [a] -> [a]
:Point 2 r :+ extra
x(Point 2 r :+ extra)
-> [Point 2 r :+ extra] -> [Point 2 r :+ extra]
forall a. a -> [a] -> [a]
:[Point 2 r :+ extra]
rest)
    cleanMiddle [Point 2 r :+ extra]
_                               = [Char] -> [Point 2 r :+ extra]
forall a. HasCallStack => [Char] -> a
error [Char]
"cleanMiddle: too few points"
hull' [Point 2 r :+ p]
_ = [Char] -> NonEmpty (Point 2 r :+ p)
forall a. HasCallStack => [Char] -> a
error
  [Char]
"Algorithms.Geometry.ConvexHull.GrahamScan.hull' requires a list with at least \
  \two elements."

rightTurn       :: (Ord r, Num r) => Point 2 r -> Point 2 r -> Point 2 r -> Bool
rightTurn :: Point 2 r -> Point 2 r -> Point 2 r -> Bool
rightTurn Point 2 r
a Point 2 r
b Point 2 r
c = Point 2 r -> Point 2 r -> Point 2 r -> CCW
forall r.
(Ord r, Num r) =>
Point 2 r -> Point 2 r -> Point 2 r -> CCW
ccw Point 2 r
a Point 2 r
b Point 2 r
c CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
CW