{-# LANGUAGE ScopedTypeVariables #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.Polygon.Convex
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Convex Polygons
--
--------------------------------------------------------------------------------
module Data.Geometry.Polygon.Convex
  ( ConvexPolygon(..), simplePolygon
  , convexPolygon
  , isConvex, verifyConvex
  , merge
  , lowerTangent, lowerTangent'
  , upperTangent, upperTangent'

  , extremes
  , maxInDirection

  , leftTangent, rightTangent

  , minkowskiSum
  , bottomMost
  , inConvex
  , randomConvex

  , diameter
  , diametralPair
  , diametralIndexPair
  ) where


import           Control.DeepSeq                (NFData)
import           Control.Lens                   (Iso, iso, over, view, (%~), (&), (^.))
import           Control.Monad.Random
import           Control.Monad.ST
import           Control.Monad.State
import           Data.Coerce
import           Data.Ext
import qualified Data.Foldable                  as F
import           Data.Function                  (on)
import           Data.Geometry.Boundary
import           Data.Geometry.Box              (IsBoxable (..))
import           Data.Geometry.LineSegment
import           Data.Geometry.Point
import           Data.Geometry.Polygon.Core     (Polygon (..), SimplePolygon, centroid,
                                                 outerBoundaryVector, outerVertex, size,
                                                 unsafeFromPoints, unsafeFromVector,
                                                 unsafeOuterBoundaryVector)
import           Data.Geometry.Polygon.Extremes (cmpExtreme)
import           Data.Geometry.Properties
import           Data.Geometry.Transformation
import           Data.Geometry.Triangle
import           Data.Geometry.Vector
import qualified Data.IntSet                    as IS
import           Data.List.NonEmpty             (NonEmpty (..))
import qualified Data.List.NonEmpty             as NonEmpty
import           Data.Maybe                     (fromJust)
import           Data.Ord                       (comparing)
import           Data.Semigroup.Foldable        (Foldable1 (..))
import           Data.Util
import qualified Data.Vector                    as V
import           Data.Vector.Circular           (CircularVector)
import qualified Data.Vector.Circular           as CV
import qualified Data.Vector.Circular.Util      as CV
import qualified Data.Vector.Mutable            as Mut
import qualified Data.Vector.NonEmpty           as NE
import qualified Data.Vector.Unboxed            as VU
-- import           Data.Geometry.Ipe
-- import Data.Ratio
-- import Data.RealNumber.Rational
-- import Debug.Trace

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

-- | Data Type representing a convex polygon
newtype ConvexPolygon p r = ConvexPolygon {ConvexPolygon p r -> SimplePolygon p r
_simplePolygon :: SimplePolygon p r }
                          deriving (Int -> ConvexPolygon p r -> ShowS
[ConvexPolygon p r] -> ShowS
ConvexPolygon p r -> String
(Int -> ConvexPolygon p r -> ShowS)
-> (ConvexPolygon p r -> String)
-> ([ConvexPolygon p r] -> ShowS)
-> Show (ConvexPolygon p r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p r. (Show p, Show r) => Int -> ConvexPolygon p r -> ShowS
forall p r. (Show p, Show r) => [ConvexPolygon p r] -> ShowS
forall p r. (Show p, Show r) => ConvexPolygon p r -> String
showList :: [ConvexPolygon p r] -> ShowS
$cshowList :: forall p r. (Show p, Show r) => [ConvexPolygon p r] -> ShowS
show :: ConvexPolygon p r -> String
$cshow :: forall p r. (Show p, Show r) => ConvexPolygon p r -> String
showsPrec :: Int -> ConvexPolygon p r -> ShowS
$cshowsPrec :: forall p r. (Show p, Show r) => Int -> ConvexPolygon p r -> ShowS
Show,ConvexPolygon p r -> ConvexPolygon p r -> Bool
(ConvexPolygon p r -> ConvexPolygon p r -> Bool)
-> (ConvexPolygon p r -> ConvexPolygon p r -> Bool)
-> Eq (ConvexPolygon p r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall p r.
(Eq p, Eq r) =>
ConvexPolygon p r -> ConvexPolygon p r -> Bool
/= :: ConvexPolygon p r -> ConvexPolygon p r -> Bool
$c/= :: forall p r.
(Eq p, Eq r) =>
ConvexPolygon p r -> ConvexPolygon p r -> Bool
== :: ConvexPolygon p r -> ConvexPolygon p r -> Bool
$c== :: forall p r.
(Eq p, Eq r) =>
ConvexPolygon p r -> ConvexPolygon p r -> Bool
Eq,ConvexPolygon p r -> ()
(ConvexPolygon p r -> ()) -> NFData (ConvexPolygon p r)
forall a. (a -> ()) -> NFData a
forall p r. (NFData p, NFData r) => ConvexPolygon p r -> ()
rnf :: ConvexPolygon p r -> ()
$crnf :: forall p r. (NFData p, NFData r) => ConvexPolygon p r -> ()
NFData)

-- | ConvexPolygons are isomorphic to SimplePolygons with the added constraint that they have no
--   reflex vertices.
simplePolygon :: Iso (ConvexPolygon p1 r1) (ConvexPolygon p2 r2) (SimplePolygon p1 r1) (SimplePolygon p2 r2)
simplePolygon :: p (SimplePolygon p1 r1) (f (SimplePolygon p2 r2))
-> p (ConvexPolygon p1 r1) (f (ConvexPolygon p2 r2))
simplePolygon = (ConvexPolygon p1 r1 -> SimplePolygon p1 r1)
-> (SimplePolygon p2 r2 -> ConvexPolygon p2 r2)
-> Iso
     (ConvexPolygon p1 r1)
     (ConvexPolygon p2 r2)
     (SimplePolygon p1 r1)
     (SimplePolygon p2 r2)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ConvexPolygon p1 r1 -> SimplePolygon p1 r1
forall p r. ConvexPolygon p r -> SimplePolygon p r
_simplePolygon SimplePolygon p2 r2 -> ConvexPolygon p2 r2
forall p r. SimplePolygon p r -> ConvexPolygon p r
ConvexPolygon

instance PointFunctor (ConvexPolygon p) where
  pmap :: (Point (Dimension (ConvexPolygon p r)) r
 -> Point (Dimension (ConvexPolygon p s)) s)
-> ConvexPolygon p r -> ConvexPolygon p s
pmap Point (Dimension (ConvexPolygon p r)) r
-> Point (Dimension (ConvexPolygon p s)) s
f (ConvexPolygon SimplePolygon p r
p) = SimplePolygon p s -> ConvexPolygon p s
forall p r. SimplePolygon p r -> ConvexPolygon p r
ConvexPolygon (SimplePolygon p s -> ConvexPolygon p s)
-> SimplePolygon p s -> ConvexPolygon p s
forall a b. (a -> b) -> a -> b
$ (Point (Dimension (SimplePolygon p r)) r
 -> Point (Dimension (SimplePolygon p s)) s)
-> SimplePolygon p r -> SimplePolygon p s
forall (g :: * -> *) r s.
PointFunctor g =>
(Point (Dimension (g r)) r -> Point (Dimension (g s)) s)
-> g r -> g s
pmap Point (Dimension (SimplePolygon p r)) r
-> Point (Dimension (SimplePolygon p s)) s
Point (Dimension (ConvexPolygon p r)) r
-> Point (Dimension (ConvexPolygon p s)) s
f SimplePolygon p r
p

-- | Polygons are per definition 2 dimensional
type instance Dimension (ConvexPolygon p r) = 2
type instance NumType   (ConvexPolygon p r) = r


instance Fractional r => IsTransformable (ConvexPolygon p r) where
  transformBy :: Transformation
  (Dimension (ConvexPolygon p r)) (NumType (ConvexPolygon p r))
-> ConvexPolygon p r -> ConvexPolygon p r
transformBy = Transformation
  (Dimension (ConvexPolygon p r)) (NumType (ConvexPolygon p r))
-> ConvexPolygon p r -> ConvexPolygon p r
forall (g :: * -> *) r (d :: Nat).
(PointFunctor g, Fractional r, d ~ Dimension (g r), Arity d,
 Arity (d + 1)) =>
Transformation d r -> g r -> g r
transformPointFunctor

instance IsBoxable (ConvexPolygon p r) where
  boundingBox :: ConvexPolygon p r
-> Box
     (Dimension (ConvexPolygon p r)) () (NumType (ConvexPolygon p r))
boundingBox = SimplePolygon p r -> Box 2 () r
forall g.
(IsBoxable g, Ord (NumType g)) =>
g -> Box (Dimension g) () (NumType g)
boundingBox (SimplePolygon p r -> Box 2 () r)
-> (ConvexPolygon p r -> SimplePolygon p r)
-> ConvexPolygon p r
-> Box 2 () r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConvexPolygon p r -> SimplePolygon p r
forall p r. ConvexPolygon p r -> SimplePolygon p r
_simplePolygon



--------------------------------------------------------------------------------
-- Convex hull of simple polygon.

type M s v a = StateT (Mut.MVector s v, Int) (ST s) a

runM :: Int -> M s v () -> ST s (Mut.MVector s v)
runM :: Int -> M s v () -> ST s (MVector s v)
runM Int
s M s v ()
action = do
  MVector s v
v <- Int -> ST s (MVector (PrimState (ST s)) v)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
Mut.new (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s)
  (MVector s v
v', Int
f) <- M s v () -> (MVector s v, Int) -> ST s (MVector s v, Int)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT M s v ()
action (Int -> MVector s v -> MVector s v
forall s a. Int -> MVector s a -> MVector s a
Mut.drop Int
s MVector s v
v, Int
0)
  MVector s v -> ST s (MVector s v)
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector s v -> ST s (MVector s v))
-> MVector s v -> ST s (MVector s v)
forall a b. (a -> b) -> a -> b
$ MVector s v -> MVector s v
forall s a. MVector s a -> MVector s a
Mut.tail (MVector s v -> MVector s v) -> MVector s v -> MVector s v
forall a b. (a -> b) -> a -> b
$ Int -> MVector s v -> MVector s v
forall s a. Int -> MVector s a -> MVector s a
Mut.take Int
f MVector s v
v'

dequeRemove :: M s a ()
dequeRemove :: M s a ()
dequeRemove = do
  ((MVector s a, Int) -> (MVector s a, Int)) -> M s a ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((MVector s a, Int) -> (MVector s a, Int)) -> M s a ())
-> ((MVector s a, Int) -> (MVector s a, Int)) -> M s a ()
forall a b. (a -> b) -> a -> b
$ \(Mut.MVector Int
offset Int
len MutableArray s a
arr, Int
f) -> (Int -> Int -> MutableArray s a -> MVector s a
forall s a. Int -> Int -> MutableArray s a -> MVector s a
Mut.MVector (Int
offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MutableArray s a
arr, Int
fInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

dequeInsert :: a -> M s a ()
dequeInsert :: a -> M s a ()
dequeInsert a
a = do
  ((MVector s a, Int) -> (MVector s a, Int)) -> M s a ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((MVector s a, Int) -> (MVector s a, Int)) -> M s a ())
-> ((MVector s a, Int) -> (MVector s a, Int)) -> M s a ()
forall a b. (a -> b) -> a -> b
$ \(Mut.MVector Int
offset Int
len MutableArray s a
arr, Int
f) -> (Int -> Int -> MutableArray s a -> MVector s a
forall s a. Int -> Int -> MutableArray s a -> MVector s a
Mut.MVector (Int
offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MutableArray s a
arr, Int
fInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  (MVector s a
v,Int
_) <- StateT (MVector s a, Int) (ST s) (MVector s a, Int)
forall s (m :: * -> *). MonadState s m => m s
get
  MVector (PrimState (StateT (MVector s a, Int) (ST s))) a
-> Int -> a -> M s a ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
Mut.write MVector s a
MVector (PrimState (StateT (MVector s a, Int) (ST s))) a
v Int
0 a
a

dequePush :: a -> M s a ()
dequePush :: a -> M s a ()
dequePush a
a = do
  (MVector s a
v, Int
f) <- StateT (MVector s a, Int) (ST s) (MVector s a, Int)
forall s (m :: * -> *). MonadState s m => m s
get
  MVector (PrimState (StateT (MVector s a, Int) (ST s))) a
-> Int -> a -> M s a ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
Mut.write MVector s a
MVector (PrimState (StateT (MVector s a, Int) (ST s))) a
v Int
f a
a
  (MVector s a, Int) -> M s a ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (MVector s a
v,Int
fInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

dequePop :: M s a ()
dequePop :: M s a ()
dequePop = do
  ((MVector s a, Int) -> (MVector s a, Int)) -> M s a ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((MVector s a, Int) -> (MVector s a, Int)) -> M s a ())
-> ((MVector s a, Int) -> (MVector s a, Int)) -> M s a ()
forall a b. (a -> b) -> a -> b
$ \(MVector s a
v,Int
f) -> (MVector s a
v,Int
fInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

dequeBottom :: Int -> M s a a
dequeBottom :: Int -> M s a a
dequeBottom Int
idx = do
  (MVector s a
v,Int
_) <- StateT (MVector s a, Int) (ST s) (MVector s a, Int)
forall s (m :: * -> *). MonadState s m => m s
get
  MVector (PrimState (StateT (MVector s a, Int) (ST s))) a
-> Int -> M s a a
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
Mut.read MVector s a
MVector (PrimState (StateT (MVector s a, Int) (ST s))) a
v Int
idx

dequeTop :: Int -> M s a a
dequeTop :: Int -> M s a a
dequeTop Int
idx = do
  (MVector s a
v,Int
f) <- StateT (MVector s a, Int) (ST s) (MVector s a, Int)
forall s (m :: * -> *). MonadState s m => m s
get
  MVector (PrimState (StateT (MVector s a, Int) (ST s))) a
-> Int -> M s a a
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
Mut.read MVector s a
MVector (PrimState (StateT (MVector s a, Int) (ST s))) a
v (Int
fInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

-- Melkman's algorithm: http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.512.9681&rep=rep1&type=pdf

-- | \( O(n) \) Convex hull of a simple polygon.
--
--   For algorithmic details see: <https://en.wikipedia.org/wiki/Convex_hull_of_a_simple_polygon>
convexPolygon :: forall t p r. (Ord r, Num r, Show r, Show p) => Polygon t p r -> ConvexPolygon p r
convexPolygon :: Polygon t p r -> ConvexPolygon p r
convexPolygon Polygon t p r
p = SimplePolygon p r -> ConvexPolygon p r
forall p r. SimplePolygon p r -> ConvexPolygon p r
ConvexPolygon (SimplePolygon p r -> ConvexPolygon p r)
-> SimplePolygon p r -> ConvexPolygon p r
forall a b. (a -> b) -> a -> b
$ Vector (Point 2 r :+ p) -> SimplePolygon p r
forall r p. Vector (Point 2 r :+ p) -> SimplePolygon p r
unsafeFromVector (Vector (Point 2 r :+ p) -> SimplePolygon p r)
-> Vector (Point 2 r :+ p) -> SimplePolygon p r
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (MVector s (Point 2 r :+ p)))
-> Vector (Point 2 r :+ p)
forall a. (forall s. ST s (MVector s a)) -> Vector a
V.create ((forall s. ST s (MVector s (Point 2 r :+ p)))
 -> Vector (Point 2 r :+ p))
-> (forall s. ST s (MVector s (Point 2 r :+ p)))
-> Vector (Point 2 r :+ p)
forall a b. (a -> b) -> a -> b
$ Int -> M s (Point 2 r :+ p) () -> ST s (MVector s (Point 2 r :+ p))
forall s v. Int -> M s v () -> ST s (MVector s v)
runM (Polygon t p r -> Int
forall (t :: PolygonType) p r. Polygon t p r -> Int
size Polygon t p r
p) (M s (Point 2 r :+ p) () -> ST s (MVector s (Point 2 r :+ p)))
-> M s (Point 2 r :+ p) () -> ST s (MVector s (Point 2 r :+ p))
forall a b. (a -> b) -> a -> b
$
    Int -> M s (Point 2 r :+ p) ()
forall s. Int -> M s (Point 2 r :+ p) ()
findStartingPoint Int
2
  where
    -- Find the first spot where 0,n-1,n is not colinear.
    findStartingPoint :: Int -> M s (Point 2 r :+ p) ()
    findStartingPoint :: Int -> M s (Point 2 r :+ p) ()
findStartingPoint Int
nth = do
      let vPrev :: Point 2 r :+ p
vPrev = NonEmptyVector (Point 2 r :+ p) -> Int -> Point 2 r :+ p
forall a. NonEmptyVector a -> Int -> a
NE.unsafeIndex NonEmptyVector (Point 2 r :+ p)
vs (Int
nthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
          vNth :: Point 2 r :+ p
vNth = NonEmptyVector (Point 2 r :+ p) -> Int -> Point 2 r :+ p
forall a. NonEmptyVector a -> Int -> a
NE.unsafeIndex NonEmptyVector (Point 2 r :+ p)
vs Int
nth
      case (Point 2 r :+ p) -> (Point 2 r :+ p) -> (Point 2 r :+ p) -> CCW
forall r a b c.
(Ord r, Num r) =>
(Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
ccw' Point 2 r :+ p
v1 Point 2 r :+ p
vPrev Point 2 r :+ p
vNth of
        CCW
CoLinear -> Int -> M s (Point 2 r :+ p) ()
forall s. Int -> M s (Point 2 r :+ p) ()
findStartingPoint (Int
nthInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        CCW
CCW -> do
          (Point 2 r :+ p) -> M s (Point 2 r :+ p) ()
forall a s. a -> M s a ()
dequePush Point 2 r :+ p
v1 M s (Point 2 r :+ p) ()
-> M s (Point 2 r :+ p) () -> M s (Point 2 r :+ p) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Point 2 r :+ p) -> M s (Point 2 r :+ p) ()
forall a s. a -> M s a ()
dequePush Point 2 r :+ p
vPrev
          (Point 2 r :+ p) -> M s (Point 2 r :+ p) ()
forall a s. a -> M s a ()
dequePush Point 2 r :+ p
vNth; (Point 2 r :+ p) -> M s (Point 2 r :+ p) ()
forall a s. a -> M s a ()
dequeInsert Point 2 r :+ p
vNth
          ((Point 2 r :+ p) -> M s (Point 2 r :+ p) ())
-> Vector (Point 2 r :+ p) -> M s (Point 2 r :+ p) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (Point 2 r :+ p) -> M s (Point 2 r :+ p) ()
forall r c s.
(Ord r, Num r) =>
(Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
build (Int -> NonEmptyVector (Point 2 r :+ p) -> Vector (Point 2 r :+ p)
forall a. Int -> NonEmptyVector a -> Vector a
NE.drop (Int
nthInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) NonEmptyVector (Point 2 r :+ p)
vs)
        CCW
CW -> do
          (Point 2 r :+ p) -> M s (Point 2 r :+ p) ()
forall a s. a -> M s a ()
dequePush Point 2 r :+ p
vPrev M s (Point 2 r :+ p) ()
-> M s (Point 2 r :+ p) () -> M s (Point 2 r :+ p) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Point 2 r :+ p) -> M s (Point 2 r :+ p) ()
forall a s. a -> M s a ()
dequePush Point 2 r :+ p
v1
          (Point 2 r :+ p) -> M s (Point 2 r :+ p) ()
forall a s. a -> M s a ()
dequePush Point 2 r :+ p
vNth; (Point 2 r :+ p) -> M s (Point 2 r :+ p) ()
forall a s. a -> M s a ()
dequeInsert Point 2 r :+ p
vNth
          ((Point 2 r :+ p) -> M s (Point 2 r :+ p) ())
-> Vector (Point 2 r :+ p) -> M s (Point 2 r :+ p) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (Point 2 r :+ p) -> M s (Point 2 r :+ p) ()
forall r c s.
(Ord r, Num r) =>
(Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
build (Int -> NonEmptyVector (Point 2 r :+ p) -> Vector (Point 2 r :+ p)
forall a. Int -> NonEmptyVector a -> Vector a
NE.drop (Int
nthInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) NonEmptyVector (Point 2 r :+ p)
vs)

    v1 :: Point 2 r :+ p
v1 = NonEmptyVector (Point 2 r :+ p) -> Int -> Point 2 r :+ p
forall a. NonEmptyVector a -> Int -> a
NE.unsafeIndex NonEmptyVector (Point 2 r :+ p)
vs Int
0
    vs :: NonEmptyVector (Point 2 r :+ p)
vs = CircularVector (Point 2 r :+ p) -> NonEmptyVector (Point 2 r :+ p)
forall a. CircularVector a -> NonEmptyVector a
CV.vector (Polygon t p r
pPolygon t p r
-> Getting
     (CircularVector (Point 2 r :+ p))
     (Polygon t p r)
     (CircularVector (Point 2 r :+ p))
-> CircularVector (Point 2 r :+ p)
forall s a. s -> Getting a s a -> a
^.Getting
  (CircularVector (Point 2 r :+ p))
  (Polygon t p r)
  (CircularVector (Point 2 r :+ p))
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector)
    build :: (Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
build Point 2 r :+ c
v = do
      CCW
botTurn <- (Point 2 r :+ c) -> (Point 2 r :+ c) -> (Point 2 r :+ c) -> CCW
forall r a b c.
(Ord r, Num r) =>
(Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
ccw' ((Point 2 r :+ c) -> (Point 2 r :+ c) -> (Point 2 r :+ c) -> CCW)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ c)
-> StateT
     (MVector s (Point 2 r :+ c), Int)
     (ST s)
     ((Point 2 r :+ c) -> (Point 2 r :+ c) -> CCW)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Point 2 r :+ c
v     StateT
  (MVector s (Point 2 r :+ c), Int)
  (ST s)
  ((Point 2 r :+ c) -> (Point 2 r :+ c) -> CCW)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ c)
-> StateT
     (MVector s (Point 2 r :+ c), Int) (ST s) ((Point 2 r :+ c) -> CCW)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ c)
forall s a. Int -> M s a a
dequeBottom Int
0 StateT
  (MVector s (Point 2 r :+ c), Int) (ST s) ((Point 2 r :+ c) -> CCW)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) CCW
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ c)
forall s a. Int -> M s a a
dequeBottom Int
1
      CCW
topTurn <- (Point 2 r :+ c) -> (Point 2 r :+ c) -> (Point 2 r :+ c) -> CCW
forall r a b c.
(Ord r, Num r) =>
(Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
ccw' ((Point 2 r :+ c) -> (Point 2 r :+ c) -> (Point 2 r :+ c) -> CCW)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ c)
-> StateT
     (MVector s (Point 2 r :+ c), Int)
     (ST s)
     ((Point 2 r :+ c) -> (Point 2 r :+ c) -> CCW)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ c)
forall s a. Int -> M s a a
dequeTop Int
1 StateT
  (MVector s (Point 2 r :+ c), Int)
  (ST s)
  ((Point 2 r :+ c) -> (Point 2 r :+ c) -> CCW)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ c)
-> StateT
     (MVector s (Point 2 r :+ c), Int) (ST s) ((Point 2 r :+ c) -> CCW)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ c)
forall s a. Int -> M s a a
dequeTop Int
0    StateT
  (MVector s (Point 2 r :+ c), Int) (ST s) ((Point 2 r :+ c) -> CCW)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) CCW
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Point 2 r :+ c
v
      Bool
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CCW
botTurn CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
CW Bool -> Bool -> Bool
|| CCW
topTurn CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
CW) (StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
 -> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ())
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
forall a b. (a -> b) -> a -> b
$ do
        (Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
forall r c s b.
(Ord r, Num r) =>
(Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ b), Int) (ST s) ()
backtrackTop Point 2 r :+ c
v; (Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
forall a s. a -> M s a ()
dequePush Point 2 r :+ c
v
        (Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
forall r c s b.
(Ord r, Num r) =>
(Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ b), Int) (ST s) ()
backtrackBot Point 2 r :+ c
v; (Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
forall a s. a -> M s a ()
dequeInsert Point 2 r :+ c
v
    backtrackTop :: (Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ b), Int) (ST s) ()
backtrackTop Point 2 r :+ c
v = do
      CCW
turn <- (Point 2 r :+ b) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
forall r a b c.
(Ord r, Num r) =>
(Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
ccw' ((Point 2 r :+ b) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW)
-> StateT (MVector s (Point 2 r :+ b), Int) (ST s) (Point 2 r :+ b)
-> StateT
     (MVector s (Point 2 r :+ b), Int)
     (ST s)
     ((Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> StateT (MVector s (Point 2 r :+ b), Int) (ST s) (Point 2 r :+ b)
forall s a. Int -> M s a a
dequeTop Int
1 StateT
  (MVector s (Point 2 r :+ b), Int)
  (ST s)
  ((Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW)
-> StateT (MVector s (Point 2 r :+ b), Int) (ST s) (Point 2 r :+ b)
-> StateT
     (MVector s (Point 2 r :+ b), Int) (ST s) ((Point 2 r :+ c) -> CCW)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int
-> StateT (MVector s (Point 2 r :+ b), Int) (ST s) (Point 2 r :+ b)
forall s a. Int -> M s a a
dequeTop Int
0 StateT
  (MVector s (Point 2 r :+ b), Int) (ST s) ((Point 2 r :+ c) -> CCW)
-> StateT (MVector s (Point 2 r :+ b), Int) (ST s) (Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ b), Int) (ST s) CCW
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ b), Int) (ST s) (Point 2 r :+ c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Point 2 r :+ c
v
      Bool
-> StateT (MVector s (Point 2 r :+ b), Int) (ST s) ()
-> StateT (MVector s (Point 2 r :+ b), Int) (ST s) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CCW
turn CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
CCW) (StateT (MVector s (Point 2 r :+ b), Int) (ST s) ()
 -> StateT (MVector s (Point 2 r :+ b), Int) (ST s) ())
-> StateT (MVector s (Point 2 r :+ b), Int) (ST s) ()
-> StateT (MVector s (Point 2 r :+ b), Int) (ST s) ()
forall a b. (a -> b) -> a -> b
$ do
        StateT (MVector s (Point 2 r :+ b), Int) (ST s) ()
forall s a. M s a ()
dequePop
        (Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ b), Int) (ST s) ()
backtrackTop Point 2 r :+ c
v
    backtrackBot :: (Point 2 r :+ a)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
backtrackBot Point 2 r :+ a
v = do
      CCW
turn <- (Point 2 r :+ a) -> (Point 2 r :+ c) -> (Point 2 r :+ c) -> CCW
forall r a b c.
(Ord r, Num r) =>
(Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
ccw' ((Point 2 r :+ a) -> (Point 2 r :+ c) -> (Point 2 r :+ c) -> CCW)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ a)
-> StateT
     (MVector s (Point 2 r :+ c), Int)
     (ST s)
     ((Point 2 r :+ c) -> (Point 2 r :+ c) -> CCW)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Point 2 r :+ a)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Point 2 r :+ a
v StateT
  (MVector s (Point 2 r :+ c), Int)
  (ST s)
  ((Point 2 r :+ c) -> (Point 2 r :+ c) -> CCW)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ c)
-> StateT
     (MVector s (Point 2 r :+ c), Int) (ST s) ((Point 2 r :+ c) -> CCW)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ c)
forall s a. Int -> M s a a
dequeBottom Int
0 StateT
  (MVector s (Point 2 r :+ c), Int) (ST s) ((Point 2 r :+ c) -> CCW)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ c)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) CCW
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) (Point 2 r :+ c)
forall s a. Int -> M s a a
dequeBottom Int
1
      Bool
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CCW
turn CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
CCW) (StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
 -> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ())
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
forall a b. (a -> b) -> a -> b
$ do
        StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
forall s a. M s a ()
dequeRemove
        (Point 2 r :+ a)
-> StateT (MVector s (Point 2 r :+ c), Int) (ST s) ()
backtrackBot Point 2 r :+ a
v







-- | \( O(n) \) Check if a polygon is strictly convex.
isConvex :: (Ord r, Num r) => SimplePolygon p r -> Bool
isConvex :: SimplePolygon p r -> Bool
isConvex SimplePolygon p r
s =
    CircularVector Bool -> Bool
CV.and (((Point 2 r :+ p) -> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Bool)
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
-> CircularVector Bool
forall a b c d.
(a -> b -> c -> d)
-> CircularVector a
-> CircularVector b
-> CircularVector c
-> CircularVector d
CV.zipWith3 (Point 2 r :+ p) -> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Bool
forall r a b c.
(Ord r, Num r) =>
(Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> Bool
f (Int
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
forall a. Int -> CircularVector a -> CircularVector a
CV.rotateLeft Int
1 CircularVector (Point 2 r :+ p)
vs) CircularVector (Point 2 r :+ p)
vs (Int
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
forall a. Int -> CircularVector a -> CircularVector a
CV.rotateRight Int
1 CircularVector (Point 2 r :+ p)
vs))
  where
    f :: (Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> Bool
f Point 2 r :+ a
a Point 2 r :+ b
b Point 2 r :+ c
c = (Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
forall r a b c.
(Ord r, Num r) =>
(Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
ccw' Point 2 r :+ a
a Point 2 r :+ b
b Point 2 r :+ c
c CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
CCW
    vs :: CircularVector (Point 2 r :+ p)
vs = SimplePolygon p r
s SimplePolygon p r
-> Getting
     (CircularVector (Point 2 r :+ p))
     (SimplePolygon p r)
     (CircularVector (Point 2 r :+ p))
-> CircularVector (Point 2 r :+ p)
forall s a. s -> Getting a s a -> a
^. Getting
  (CircularVector (Point 2 r :+ p))
  (SimplePolygon p r)
  (CircularVector (Point 2 r :+ p))
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector

-- | \( O(n) \) Verify that a convex polygon is strictly convex.
verifyConvex :: (Ord r, Num r) => ConvexPolygon p r -> Bool
verifyConvex :: ConvexPolygon p r -> Bool
verifyConvex = SimplePolygon p r -> Bool
forall r p. (Ord r, Num r) => SimplePolygon p r -> Bool
isConvex (SimplePolygon p r -> Bool)
-> (ConvexPolygon p r -> SimplePolygon p r)
-> ConvexPolygon p r
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConvexPolygon p r -> SimplePolygon p r
forall p r. ConvexPolygon p r -> SimplePolygon p r
_simplePolygon

-- mainWith inFile outFile = do
--     ePage <- readSinglePageFile inFile
--     case ePage of
--       Left err                         -> error "" -- err
--       Right (page :: IpePage Rational) -> case page^..content.traverse._withAttrs _IpePath _asSimplePolygon.core of
--         []         -> error "No points found"
--         polies@(_:_) -> do
--            -- let out  = [asIpe drawTriangulation dt, asIpe drawTree' emst]
--            -- print $ length $ edges' dt
--            -- print $ toPlaneGraph (Proxy :: Proxy DT) dt
--            -- writeIpeFile outFile . singlePageFromContent $ out
--            -- mapM_ (print . extremesNaive (v2 1 0)) polies
--            pure $ map (flip rightTangent (Point2 80 528)) polies




-- | Finds the extreme points, minimum and maximum, in a given direction
--
-- pre: The input polygon is strictly convex.
--
-- running time: \(O(\log n)\)
--
--
extremes     :: (Num r, Ord r) => Vector 2 r -> ConvexPolygon p r
             -> (Point 2 r :+ p, Point 2 r :+ p)
extremes :: Vector 2 r -> ConvexPolygon p r -> (Point 2 r :+ p, Point 2 r :+ p)
extremes Vector 2 r
u ConvexPolygon p r
p = (Vector 2 r -> ConvexPolygon p r -> Point 2 r :+ p
forall r p.
(Num r, Ord r) =>
Vector 2 r -> ConvexPolygon p r -> Point 2 r :+ p
maxInDirection ((-r
1) r -> Vector 2 r -> Vector 2 r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Vector 2 r
u) ConvexPolygon p r
p, Vector 2 r -> ConvexPolygon p r -> Point 2 r :+ p
forall r p.
(Num r, Ord r) =>
Vector 2 r -> ConvexPolygon p r -> Point 2 r :+ p
maxInDirection Vector 2 r
u ConvexPolygon p r
p)

-- | Finds the extreme maximum point in the given direction. Based on
-- http://geomalgorithms.com/a14-_extreme_pts.html
--
--
-- pre: The input polygon is strictly convex.
--
-- running time: \(O(\log n)\)
maxInDirection   :: (Num r, Ord r) => Vector 2 r -> ConvexPolygon p r -> Point 2 r :+ p
maxInDirection :: Vector 2 r -> ConvexPolygon p r -> Point 2 r :+ p
maxInDirection Vector 2 r
u = ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> ConvexPolygon p r -> Point 2 r :+ p
forall r p.
((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> ConvexPolygon p r -> Point 2 r :+ p
findMaxWith (Vector 2 r -> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
forall r p q.
(Num r, Ord r) =>
Vector 2 r -> (Point 2 r :+ p) -> (Point 2 r :+ q) -> Ordering
cmpExtreme Vector 2 r
u)

-- FIXME: c+1 is always less than n so we don't need to use `mod` or do bounds checking.
--        Use unsafe indexing.
-- \( O(\log n) \)
findMaxWith :: (Point 2 r :+ p -> Point 2 r :+ p -> Ordering)
             -> ConvexPolygon p r -> Point 2 r :+ p
findMaxWith :: ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> ConvexPolygon p r -> Point 2 r :+ p
findMaxWith (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
cmp ConvexPolygon p r
p = CircularVector (Point 2 r :+ p) -> Int -> Point 2 r :+ p
forall a. CircularVector a -> Int -> a
CV.index CircularVector (Point 2 r :+ p)
v (Int -> Int -> Int
worker Int
0 (CircularVector (Point 2 r :+ p) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length CircularVector (Point 2 r :+ p)
v))
  where
    v :: CircularVector (Point 2 r :+ p)
v = ConvexPolygon p r
p ConvexPolygon p r
-> Getting
     (CircularVector (Point 2 r :+ p))
     (ConvexPolygon p r)
     (CircularVector (Point 2 r :+ p))
-> CircularVector (Point 2 r :+ p)
forall s a. s -> Getting a s a -> a
^. (SimplePolygon p r
 -> Const (CircularVector (Point 2 r :+ p)) (SimplePolygon p r))
-> ConvexPolygon p r
-> Const (CircularVector (Point 2 r :+ p)) (ConvexPolygon p r)
forall p1 r1 p2 r2.
Iso
  (ConvexPolygon p1 r1)
  (ConvexPolygon p2 r2)
  (SimplePolygon p1 r1)
  (SimplePolygon p2 r2)
simplePolygon((SimplePolygon p r
  -> Const (CircularVector (Point 2 r :+ p)) (SimplePolygon p r))
 -> ConvexPolygon p r
 -> Const (CircularVector (Point 2 r :+ p)) (ConvexPolygon p r))
-> ((CircularVector (Point 2 r :+ p)
     -> Const
          (CircularVector (Point 2 r :+ p))
          (CircularVector (Point 2 r :+ p)))
    -> SimplePolygon p r
    -> Const (CircularVector (Point 2 r :+ p)) (SimplePolygon p r))
-> Getting
     (CircularVector (Point 2 r :+ p))
     (ConvexPolygon p r)
     (CircularVector (Point 2 r :+ p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CircularVector (Point 2 r :+ p)
 -> Const
      (CircularVector (Point 2 r :+ p))
      (CircularVector (Point 2 r :+ p)))
-> SimplePolygon p r
-> Const (CircularVector (Point 2 r :+ p)) (SimplePolygon p r)
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector
    Int
a icmp :: Int -> Int -> Ordering
`icmp` Int
b = CircularVector (Point 2 r :+ p) -> Int -> Point 2 r :+ p
forall a. CircularVector a -> Int -> a
CV.index CircularVector (Point 2 r :+ p)
v Int
a (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
`cmp` CircularVector (Point 2 r :+ p) -> Int -> Point 2 r :+ p
forall a. CircularVector a -> Int -> a
CV.index CircularVector (Point 2 r :+ p)
v Int
b
    worker :: Int -> Int -> Int
worker Int
a Int
b
      | Int -> Bool
localMaximum Int
c = Int
c
      | Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
b         = Int
b
      | Bool
otherwise      =
        case  (Int -> Bool
isUpwards Int
a, Int -> Bool
isUpwards Int
c, Int
c Int -> Int -> Ordering
`icmp` Int
a Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT) of
          (Bool
True, Bool
False, Bool
_)      -> Int -> Int -> Int
worker Int
a Int
c -- A is up, C is down, pick [a,c]
          (Bool
True, Bool
True, Bool
True)    -> Int -> Int -> Int
worker Int
c Int
b -- A is up, C is up, C is GTE A, pick [c,b]
          (Bool
True, Bool
True, Bool
False)   -> Int -> Int -> Int
worker Int
a Int
c -- A is up, C is LT A, pick [a,c]
          (Bool
False, Bool
True, Bool
_)      -> Int -> Int -> Int
worker Int
c Int
b -- A is down, C is up, pick [c,b]
          (Bool
False, Bool
False, Bool
False) -> Int -> Int -> Int
worker Int
c Int
b -- A is down, C is down, C is LT A, pick [c,b]
          (Bool
False, Bool
_, Bool
True)      -> Int -> Int -> Int
worker Int
a Int
c -- A is down, C is GTE A, pick [a,c]
      where
        c :: Int
c = (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        localMaximum :: Int -> Bool
localMaximum Int
idx = Int
idx Int -> Int -> Ordering
`icmp` (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT Bool -> Bool -> Bool
&& Int
idx Int -> Int -> Ordering
`icmp` (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
    isUpwards :: Int -> Bool
isUpwards Int
idx = Int
idx Int -> Int -> Ordering
`icmp` (Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT

{- Convex binary search using sequences in \( O(log^2 n) \)

findMaxWith       :: (Point 2 r :+ p -> Point 2 r :+ p -> Ordering)
                  -> ConvexPolygon p r -> Point 2 r :+ p
findMaxWith cmp = findMaxStart . S.fromList . F.toList . getVertices
  where
    p' >=. q = (p' `cmp` q) /= LT

    findMaxStart s@(viewl -> (a:<r))
      | isLocalMax r a r = a
      | otherwise        = findMax s
    findMaxStart _       = error "absurd"

    findMax s = let i         = F.length s `div` 2
                    (ac,cb')  = S.splitAt i s
                    (c :< cb) = viewl cb'
                in findMax' ac c cb

    findMax' ac c cb
      | isLocalMax ac c cb = c
      | otherwise          = binSearch ac c cb

    -- | Given the vertices [a..] c [..b] find the exteral vtx
    binSearch ac@(viewl -> a:<r) c cb = case (isUpwards a (r |> c), isUpwards c cb, a >=. c) of
        (True,False,_)      -> findMax (ac |> c)
        (True,True,True)    -> findMax (ac |> c)
        (True,True,False)   -> findMax (c <| cb)
        (False,True,_)      -> findMax (c <| cb)
        (False,False,False) -> findMax (ac |> c)
        (False,False,True)  -> findMax (c <| cb)
    binSearch _                  _ _ = error "maxInDirection, binSearch: empty chain"

    isLocalMax (viewr -> _ :> l) c (viewl -> r :< _) = c >=. l && c >=. r
    isLocalMax (viewr -> _ :> l) c _                 = c >=. l
    isLocalMax _                 c (viewl -> r :< _) = c >=. r
    isLocalMax _                 _ _                 = True

    -- the Edge from a to b is upwards w.r.t b if a is not larger than b
    isUpwards a (viewl -> b :< _) = (a `cmp` b) /= GT
    isUpwards _ _                 = error "isUpwards: no edge endpoint"
-}

tangentCmp       :: (Num r, Ord r)
                 => Point 2 r -> Point 2 r :+ p -> Point 2 r :+ q -> Ordering
tangentCmp :: Point 2 r -> (Point 2 r :+ p) -> (Point 2 r :+ q) -> Ordering
tangentCmp Point 2 r
o Point 2 r :+ p
p Point 2 r :+ q
q = case 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
o (Point 2 r :+ p
p(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point 2 r :+ q
q(Point 2 r :+ q)
-> Getting (Point 2 r) (Point 2 r :+ q) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ q) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) of
                     CCW
CCW      -> Ordering
LT -- q is left of the line from o to p
                     CCW
CoLinear -> Ordering
EQ -- q is *on* the line from o to p
                     CCW
CW       -> Ordering
GT -- q is right of the line from o to p


-- | Given a convex polygon poly, and a point outside the polygon, find the
--  left tangent of q and the polygon, i.e. the vertex v of the convex polygon
--  s.t. the polygon lies completely to the right of the line from q to v.
--
-- running time: \(O(\log n)\).
leftTangent        :: (Ord r, Num r) => ConvexPolygon p r -> Point 2 r -> Point 2 r :+ p
leftTangent :: ConvexPolygon p r -> Point 2 r -> Point 2 r :+ p
leftTangent ConvexPolygon p r
poly Point 2 r
q = ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> ConvexPolygon p r -> Point 2 r :+ p
forall r p.
((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> ConvexPolygon p r -> Point 2 r :+ p
findMaxWith (Point 2 r -> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
forall r p q.
(Num r, Ord r) =>
Point 2 r -> (Point 2 r :+ p) -> (Point 2 r :+ q) -> Ordering
tangentCmp Point 2 r
q) ConvexPolygon p r
poly

-- | Given a convex polygon poly, and a point outside the polygon, find the
--  right tangent of q and the polygon, i.e. the vertex v of the convex polygon
--  s.t. the polygon lies completely to the left of the line from q to v.
--
-- running time: \(O(\log n)\).
rightTangent        :: (Ord r, Num r) => ConvexPolygon p r -> Point 2 r -> Point 2 r :+ p
rightTangent :: ConvexPolygon p r -> Point 2 r -> Point 2 r :+ p
rightTangent ConvexPolygon p r
poly Point 2 r
q = ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> ConvexPolygon p r -> Point 2 r :+ p
forall r p.
((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> ConvexPolygon p r -> Point 2 r :+ p
findMaxWith (((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
 -> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> (Point 2 r :+ p)
-> (Point 2 r :+ p)
-> Ordering
forall a b. (a -> b) -> a -> b
$ Point 2 r -> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
forall r p q.
(Num r, Ord r) =>
Point 2 r -> (Point 2 r :+ p) -> (Point 2 r :+ q) -> Ordering
tangentCmp Point 2 r
q) ConvexPolygon p r
poly






-- * Merging Two convex Hulls


-- | Rotating Right <-> rotate clockwise
--
-- Merging two convex hulls, based on the paper:
--
-- Two Algorithms for Constructing a Delaunay Triangulation
-- Lee and Schachter
-- International Journal of Computer and Information Sciences, Vol 9, No. 3, 1980
--
-- : (combined hull, lower tangent that was added, upper tangent thtat was
-- added)

-- pre: - lp and rp are disjoint, and there is a vertical line separating
--        the two polygons.
--      - The vertices of the polygons are given in clockwise order
--
-- Running time: O(n+m), where n and m are the sizes of the two polygons respectively
merge       :: (Num r, Ord r) => ConvexPolygon p r  -> ConvexPolygon p r
            -> (ConvexPolygon p r, LineSegment 2 p r, LineSegment 2 p r)
merge :: ConvexPolygon p r
-> ConvexPolygon p r
-> (ConvexPolygon p r, LineSegment 2 p r, LineSegment 2 p r)
merge ConvexPolygon p r
lp ConvexPolygon p r
rp = (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]
r' [Point 2 r :+ p] -> [Point 2 r :+ p] -> [Point 2 r :+ p]
forall a. [a] -> [a] -> [a]
++ [Point 2 r :+ p]
l', LineSegment 2 p r
lt, LineSegment 2 p r
ut)
  where
    lt :: LineSegment 2 p r
lt@(ClosedLineSegment Point 2 r :+ p
a Point 2 r :+ p
b) = ConvexPolygon p r -> ConvexPolygon p r -> LineSegment 2 p r
forall r p.
(Num r, Ord r) =>
ConvexPolygon p r -> ConvexPolygon p r -> LineSegment 2 p r
lowerTangent ConvexPolygon p r
lp ConvexPolygon p r
rp
    ut :: LineSegment 2 p r
ut@(ClosedLineSegment Point 2 r :+ p
c Point 2 r :+ p
d) = ConvexPolygon p r -> ConvexPolygon p r -> LineSegment 2 p r
forall r p.
(Num r, Ord r) =>
ConvexPolygon p r -> ConvexPolygon p r -> LineSegment 2 p r
upperTangent ConvexPolygon p r
lp ConvexPolygon p r
rp

    takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil a -> Bool
p [a]
xs = let ([a]
xs',a
x:[a]
_) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
xs in [a]
xs' [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x]
    rightElems :: CircularVector a -> [a]
rightElems  = NonEmptyVector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (NonEmptyVector a -> [a])
-> (CircularVector a -> NonEmptyVector a)
-> CircularVector a
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CircularVector a -> NonEmptyVector a
forall a. CircularVector a -> NonEmptyVector a
CV.rightElements
    takeAndRotate :: (Point 2 r :+ b)
-> (Point 2 r :+ b) -> ConvexPolygon b r -> [Point 2 r :+ b]
takeAndRotate Point 2 r :+ b
x Point 2 r :+ b
y = ((Point 2 r :+ b) -> Bool) -> [Point 2 r :+ b] -> [Point 2 r :+ b]
forall a. (a -> Bool) -> [a] -> [a]
takeUntil ((Point 2 r :+ b) -> (Point 2 r :+ b) -> Bool
forall a b. Eq a => (a :+ b) -> (a :+ b) -> Bool
coreEq Point 2 r :+ b
x) ([Point 2 r :+ b] -> [Point 2 r :+ b])
-> (ConvexPolygon b r -> [Point 2 r :+ b])
-> ConvexPolygon b r
-> [Point 2 r :+ b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CircularVector (Point 2 r :+ b) -> [Point 2 r :+ b]
forall a. CircularVector a -> [a]
rightElems (CircularVector (Point 2 r :+ b) -> [Point 2 r :+ b])
-> (ConvexPolygon b r -> CircularVector (Point 2 r :+ b))
-> ConvexPolygon b r
-> [Point 2 r :+ b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point 2 r :+ b)
-> CircularVector (Point 2 r :+ b)
-> CircularVector (Point 2 r :+ b)
forall a b.
Eq a =>
(a :+ b) -> CircularVector (a :+ b) -> CircularVector (a :+ b)
rotateTo' Point 2 r :+ b
y (CircularVector (Point 2 r :+ b)
 -> CircularVector (Point 2 r :+ b))
-> (ConvexPolygon b r -> CircularVector (Point 2 r :+ b))
-> ConvexPolygon b r
-> CircularVector (Point 2 r :+ b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConvexPolygon b r -> CircularVector (Point 2 r :+ b)
forall p r. ConvexPolygon p r -> CircularVector (Point 2 r :+ p)
getVertices

    r' :: [Point 2 r :+ p]
r' = (Point 2 r :+ p)
-> (Point 2 r :+ p) -> ConvexPolygon p r -> [Point 2 r :+ p]
forall r b.
Eq r =>
(Point 2 r :+ b)
-> (Point 2 r :+ b) -> ConvexPolygon b r -> [Point 2 r :+ b]
takeAndRotate Point 2 r :+ p
b Point 2 r :+ p
d ConvexPolygon p r
rp
    l' :: [Point 2 r :+ p]
l' = (Point 2 r :+ p)
-> (Point 2 r :+ p) -> ConvexPolygon p r -> [Point 2 r :+ p]
forall r b.
Eq r =>
(Point 2 r :+ b)
-> (Point 2 r :+ b) -> ConvexPolygon b r -> [Point 2 r :+ b]
takeAndRotate Point 2 r :+ p
c Point 2 r :+ p
a ConvexPolygon p r
lp


rotateTo'   :: Eq a => (a :+ b) -> CircularVector (a :+ b) -> CircularVector (a :+ b)
rotateTo' :: (a :+ b) -> CircularVector (a :+ b) -> CircularVector (a :+ b)
rotateTo' a :+ b
x = Maybe (CircularVector (a :+ b)) -> CircularVector (a :+ b)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (CircularVector (a :+ b)) -> CircularVector (a :+ b))
-> (CircularVector (a :+ b) -> Maybe (CircularVector (a :+ b)))
-> CircularVector (a :+ b)
-> CircularVector (a :+ b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a :+ b) -> Bool)
-> CircularVector (a :+ b) -> Maybe (CircularVector (a :+ b))
forall a.
(a -> Bool) -> CircularVector a -> Maybe (CircularVector a)
CV.findRotateTo ((a :+ b) -> (a :+ b) -> Bool
forall a b. Eq a => (a :+ b) -> (a :+ b) -> Bool
coreEq a :+ b
x)

coreEq :: Eq a => (a :+ b) -> (a :+ b) -> Bool
coreEq :: (a :+ b) -> (a :+ b) -> Bool
coreEq = a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) (a -> a -> Bool) -> ((a :+ b) -> a) -> (a :+ b) -> (a :+ b) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ((a :+ b) -> Getting a (a :+ b) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (a :+ b) a
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)


--------------------------------------------------------------------------------
-- * Computing Tangents

-- | Compute the lower tangent of the two polgyons
--
--   pre: - polygons lp and rp have at least 1 vertex
--        - lp and rp are disjoint, and there is a vertical line separating
--          the two polygons.
--        - The vertices of the polygons are given in clockwise order
--
-- Running time: O(n+m), where n and m are the sizes of the two polygons respectively
lowerTangent       :: (Num r, Ord r)
                   => ConvexPolygon p r
                   -> ConvexPolygon p r
                   -> LineSegment 2 p r
lowerTangent :: ConvexPolygon p r -> ConvexPolygon p r -> LineSegment 2 p r
lowerTangent ConvexPolygon p r
lp ConvexPolygon p r
rp = (Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point 2 r :+ p
l Point 2 r :+ p
r
  where
    lh :: NonEmptyVector (Point 2 r :+ p)
lh = CircularVector (Point 2 r :+ p) -> NonEmptyVector (Point 2 r :+ p)
forall a. CircularVector a -> NonEmptyVector a
CV.rightElements (CircularVector (Point 2 r :+ p)
 -> NonEmptyVector (Point 2 r :+ p))
-> (ConvexPolygon p r -> CircularVector (Point 2 r :+ p))
-> ConvexPolygon p r
-> NonEmptyVector (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
forall r p.
Ord r =>
CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
rightMost (CircularVector (Point 2 r :+ p)
 -> CircularVector (Point 2 r :+ p))
-> (ConvexPolygon p r -> CircularVector (Point 2 r :+ p))
-> ConvexPolygon p r
-> CircularVector (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConvexPolygon p r -> CircularVector (Point 2 r :+ p)
forall p r. ConvexPolygon p r -> CircularVector (Point 2 r :+ p)
getVertices (ConvexPolygon p r -> NonEmptyVector (Point 2 r :+ p))
-> ConvexPolygon p r -> NonEmptyVector (Point 2 r :+ p)
forall a b. (a -> b) -> a -> b
$ ConvexPolygon p r
lp
    rh :: NonEmptyVector (Point 2 r :+ p)
rh = CircularVector (Point 2 r :+ p) -> NonEmptyVector (Point 2 r :+ p)
forall a. CircularVector a -> NonEmptyVector a
CV.leftElements  (CircularVector (Point 2 r :+ p)
 -> NonEmptyVector (Point 2 r :+ p))
-> (ConvexPolygon p r -> CircularVector (Point 2 r :+ p))
-> ConvexPolygon p r
-> NonEmptyVector (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
forall r p.
Ord r =>
CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
leftMost  (CircularVector (Point 2 r :+ p)
 -> CircularVector (Point 2 r :+ p))
-> (ConvexPolygon p r -> CircularVector (Point 2 r :+ p))
-> ConvexPolygon p r
-> CircularVector (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConvexPolygon p r -> CircularVector (Point 2 r :+ p)
forall p r. ConvexPolygon p r -> CircularVector (Point 2 r :+ p)
getVertices (ConvexPolygon p r -> NonEmptyVector (Point 2 r :+ p))
-> ConvexPolygon p r -> NonEmptyVector (Point 2 r :+ p)
forall a b. (a -> b) -> a -> b
$ ConvexPolygon p r
rp
    (Two (Point 2 r :+ p
l :+ [Point 2 r :+ p]
_) (Point 2 r :+ p
r :+ [Point 2 r :+ p]
_)) = NonEmptyVector (Point 2 r :+ p)
-> NonEmptyVector (Point 2 r :+ p)
-> Two ((Point 2 r :+ p) :+ [Point 2 r :+ p])
forall r (f :: * -> *) p.
(Ord r, Num r, Foldable1 f) =>
f (Point 2 r :+ p)
-> f (Point 2 r :+ p) -> Two ((Point 2 r :+ p) :+ [Point 2 r :+ p])
lowerTangent' NonEmptyVector (Point 2 r :+ p)
lh NonEmptyVector (Point 2 r :+ p)
rh

-- | Compute the lower tangent of the two convex chains lp and rp
--
--   pre: - the chains lp and rp have at least 1 vertex
--        - lp and rp are disjoint, and there is a vertical line
--          having lp on the left and rp on the right.
--        - The vertices in the left-chain are given in clockwise order, (right to left)
--        - The vertices in the right chain are given in counterclockwise order (left-to-right)
--
-- The result returned is the two endpoints l and r of the tangents,
-- and the remainders lc and rc of the chains (i.e.)  such that the lower hull
-- of both chains is: (reverse lc) ++ [l,h] ++ rc
--
-- Running time: \(O(n+m)\), where n and m are the sizes of the two chains
-- respectively
lowerTangent'       :: (Ord r, Num r, Foldable1 f)
                    => f (Point 2 r :+ p) -> f (Point 2 r :+ p)
                    -> Two ((Point 2 r :+ p) :+ [Point 2 r :+ p])
lowerTangent' :: f (Point 2 r :+ p)
-> f (Point 2 r :+ p) -> Two ((Point 2 r :+ p) :+ [Point 2 r :+ p])
lowerTangent' f (Point 2 r :+ p)
l0 f (Point 2 r :+ p)
r0 = NonEmpty (Point 2 r :+ p)
-> NonEmpty (Point 2 r :+ p)
-> Two ((Point 2 r :+ p) :+ [Point 2 r :+ p])
forall r a.
(Ord r, Num r) =>
NonEmpty (Point 2 r :+ a)
-> NonEmpty (Point 2 r :+ a)
-> Two ((Point 2 r :+ a) :+ [Point 2 r :+ a])
go (f (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty f (Point 2 r :+ p)
l0) (f (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty f (Point 2 r :+ p)
r0)
  where
    ne :: [a] -> NonEmpty a
ne = [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NonEmpty.fromList
    isRight' :: [Point 2 r :+ c] -> (Point 2 r :+ a) -> (Point 2 r :+ b) -> Bool
isRight' []    Point 2 r :+ a
_ Point 2 r :+ b
_ = Bool
False
    isRight' (Point 2 r :+ c
x:[Point 2 r :+ c]
_) Point 2 r :+ a
l Point 2 r :+ b
r = (Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
forall r a b c.
(Ord r, Num r) =>
(Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
ccw' Point 2 r :+ a
l Point 2 r :+ b
r Point 2 r :+ c
x CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
/= CCW
CCW

    go :: NonEmpty (Point 2 r :+ a)
-> NonEmpty (Point 2 r :+ a)
-> Two ((Point 2 r :+ a) :+ [Point 2 r :+ a])
go lh :: NonEmpty (Point 2 r :+ a)
lh@(Point 2 r :+ a
l:|[Point 2 r :+ a]
ls) rh :: NonEmpty (Point 2 r :+ a)
rh@(Point 2 r :+ a
r:|[Point 2 r :+ a]
rs) | [Point 2 r :+ a] -> (Point 2 r :+ a) -> (Point 2 r :+ a) -> Bool
forall r c a b.
(Ord r, Num r) =>
[Point 2 r :+ c] -> (Point 2 r :+ a) -> (Point 2 r :+ b) -> Bool
isRight' [Point 2 r :+ a]
rs Point 2 r :+ a
l Point 2 r :+ a
r = NonEmpty (Point 2 r :+ a)
-> NonEmpty (Point 2 r :+ a)
-> Two ((Point 2 r :+ a) :+ [Point 2 r :+ a])
go NonEmpty (Point 2 r :+ a)
lh      ([Point 2 r :+ a] -> NonEmpty (Point 2 r :+ a)
forall a. [a] -> NonEmpty a
ne [Point 2 r :+ a]
rs)
                             | [Point 2 r :+ a] -> (Point 2 r :+ a) -> (Point 2 r :+ a) -> Bool
forall r c a b.
(Ord r, Num r) =>
[Point 2 r :+ c] -> (Point 2 r :+ a) -> (Point 2 r :+ b) -> Bool
isRight' [Point 2 r :+ a]
ls Point 2 r :+ a
l Point 2 r :+ a
r = NonEmpty (Point 2 r :+ a)
-> NonEmpty (Point 2 r :+ a)
-> Two ((Point 2 r :+ a) :+ [Point 2 r :+ a])
go ([Point 2 r :+ a] -> NonEmpty (Point 2 r :+ a)
forall a. [a] -> NonEmpty a
ne [Point 2 r :+ a]
ls) NonEmpty (Point 2 r :+ a)
rh
                             | Bool
otherwise       = ((Point 2 r :+ a) :+ [Point 2 r :+ a])
-> ((Point 2 r :+ a) :+ [Point 2 r :+ a])
-> Two ((Point 2 r :+ a) :+ [Point 2 r :+ a])
forall a. a -> a -> Two a
Two (Point 2 r :+ a
l (Point 2 r :+ a)
-> [Point 2 r :+ a] -> (Point 2 r :+ a) :+ [Point 2 r :+ a]
forall core extra. core -> extra -> core :+ extra
:+ [Point 2 r :+ a]
ls) (Point 2 r :+ a
r (Point 2 r :+ a)
-> [Point 2 r :+ a] -> (Point 2 r :+ a) :+ [Point 2 r :+ a]
forall core extra. core -> extra -> core :+ extra
:+ [Point 2 r :+ a]
rs)


-- | Compute the upper tangent of the two polgyons
--
--   pre: - polygons lp and rp have at least 1 vertex
--        - lp and rp are disjoint, and there is a vertical line separating
--          the two polygons.
--        - The vertices of the polygons are given in clockwise order
--
-- Running time: \( O(n+m) \), where n and m are the sizes of the two polygons respectively
upperTangent       :: (Num r, Ord r)
                   => ConvexPolygon p r
                   -> ConvexPolygon p r
                   -> LineSegment 2 p r
upperTangent :: ConvexPolygon p r -> ConvexPolygon p r -> LineSegment 2 p r
upperTangent ConvexPolygon p r
lp ConvexPolygon p r
rp = (Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point 2 r :+ p
l Point 2 r :+ p
r
  where
    lh :: NonEmptyVector (Point 2 r :+ p)
lh = CircularVector (Point 2 r :+ p) -> NonEmptyVector (Point 2 r :+ p)
forall a. CircularVector a -> NonEmptyVector a
CV.leftElements  (CircularVector (Point 2 r :+ p)
 -> NonEmptyVector (Point 2 r :+ p))
-> (ConvexPolygon p r -> CircularVector (Point 2 r :+ p))
-> ConvexPolygon p r
-> NonEmptyVector (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
forall r p.
Ord r =>
CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
rightMost (CircularVector (Point 2 r :+ p)
 -> CircularVector (Point 2 r :+ p))
-> (ConvexPolygon p r -> CircularVector (Point 2 r :+ p))
-> ConvexPolygon p r
-> CircularVector (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConvexPolygon p r -> CircularVector (Point 2 r :+ p)
forall p r. ConvexPolygon p r -> CircularVector (Point 2 r :+ p)
getVertices (ConvexPolygon p r -> NonEmptyVector (Point 2 r :+ p))
-> ConvexPolygon p r -> NonEmptyVector (Point 2 r :+ p)
forall a b. (a -> b) -> a -> b
$ ConvexPolygon p r
lp
    rh :: NonEmptyVector (Point 2 r :+ p)
rh = CircularVector (Point 2 r :+ p) -> NonEmptyVector (Point 2 r :+ p)
forall a. CircularVector a -> NonEmptyVector a
CV.rightElements (CircularVector (Point 2 r :+ p)
 -> NonEmptyVector (Point 2 r :+ p))
-> (ConvexPolygon p r -> CircularVector (Point 2 r :+ p))
-> ConvexPolygon p r
-> NonEmptyVector (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
forall r p.
Ord r =>
CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
leftMost  (CircularVector (Point 2 r :+ p)
 -> CircularVector (Point 2 r :+ p))
-> (ConvexPolygon p r -> CircularVector (Point 2 r :+ p))
-> ConvexPolygon p r
-> CircularVector (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConvexPolygon p r -> CircularVector (Point 2 r :+ p)
forall p r. ConvexPolygon p r -> CircularVector (Point 2 r :+ p)
getVertices (ConvexPolygon p r -> NonEmptyVector (Point 2 r :+ p))
-> ConvexPolygon p r -> NonEmptyVector (Point 2 r :+ p)
forall a b. (a -> b) -> a -> b
$ ConvexPolygon p r
rp
    (Two (Point 2 r :+ p
l :+ [Point 2 r :+ p]
_) (Point 2 r :+ p
r :+ [Point 2 r :+ p]
_)) = NonEmptyVector (Point 2 r :+ p)
-> NonEmptyVector (Point 2 r :+ p)
-> Two ((Point 2 r :+ p) :+ [Point 2 r :+ p])
forall r (f :: * -> *) p.
(Ord r, Num r, Foldable1 f) =>
f (Point 2 r :+ p)
-> f (Point 2 r :+ p) -> Two ((Point 2 r :+ p) :+ [Point 2 r :+ p])
upperTangent' NonEmptyVector (Point 2 r :+ p)
lh NonEmptyVector (Point 2 r :+ p)
rh

-- | Compute the upper tangent of the two convex chains lp and rp
--
--   pre: - the chains lp and rp have at least 1 vertex
--        - lp and rp are disjoint, and there is a vertical line
--          having lp on the left and rp on the right.
--        - The vertices in the left-chain are given in clockwise order, (right to left)
--        - The vertices in the right chain are given in counterclockwise order (left-to-right)
--
-- The result returned is the two endpoints l and r of the tangents,
-- and the remainders lc and rc of the chains (i.e.)  such that the upper hull
-- of both chains is: (reverse lc) ++ [l,h] ++ rc
--
-- Running time: \(O(n+m)\), where n and m are the sizes of the two chains
-- respectively
upperTangent'       :: (Ord r, Num r, Foldable1 f)
                    => f (Point 2 r :+ p) -> f (Point 2 r :+ p)
                    -> Two ((Point 2 r :+ p) :+ [Point 2 r :+ p])
upperTangent' :: f (Point 2 r :+ p)
-> f (Point 2 r :+ p) -> Two ((Point 2 r :+ p) :+ [Point 2 r :+ p])
upperTangent' f (Point 2 r :+ p)
l0 f (Point 2 r :+ p)
r0 = NonEmpty (Point 2 r :+ p)
-> NonEmpty (Point 2 r :+ p)
-> Two ((Point 2 r :+ p) :+ [Point 2 r :+ p])
forall r a.
(Ord r, Num r) =>
NonEmpty (Point 2 r :+ a)
-> NonEmpty (Point 2 r :+ a)
-> Two ((Point 2 r :+ a) :+ [Point 2 r :+ a])
go (f (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty f (Point 2 r :+ p)
l0) (f (Point 2 r :+ p) -> NonEmpty (Point 2 r :+ p)
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty f (Point 2 r :+ p)
r0)
  where
    ne :: [a] -> NonEmpty a
ne = [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NonEmpty.fromList
    isLeft' :: [Point 2 r :+ c] -> (Point 2 r :+ a) -> (Point 2 r :+ b) -> Bool
isLeft' []    Point 2 r :+ a
_ Point 2 r :+ b
_ = Bool
False
    isLeft' (Point 2 r :+ c
x:[Point 2 r :+ c]
_) Point 2 r :+ a
l Point 2 r :+ b
r = (Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
forall r a b c.
(Ord r, Num r) =>
(Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
ccw' Point 2 r :+ a
l Point 2 r :+ b
r Point 2 r :+ c
x CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
/= CCW
CW

    go :: NonEmpty (Point 2 r :+ a)
-> NonEmpty (Point 2 r :+ a)
-> Two ((Point 2 r :+ a) :+ [Point 2 r :+ a])
go lh :: NonEmpty (Point 2 r :+ a)
lh@(Point 2 r :+ a
l:|[Point 2 r :+ a]
ls) rh :: NonEmpty (Point 2 r :+ a)
rh@(Point 2 r :+ a
r:|[Point 2 r :+ a]
rs) | [Point 2 r :+ a] -> (Point 2 r :+ a) -> (Point 2 r :+ a) -> Bool
forall r c a b.
(Ord r, Num r) =>
[Point 2 r :+ c] -> (Point 2 r :+ a) -> (Point 2 r :+ b) -> Bool
isLeft' [Point 2 r :+ a]
rs Point 2 r :+ a
l Point 2 r :+ a
r = NonEmpty (Point 2 r :+ a)
-> NonEmpty (Point 2 r :+ a)
-> Two ((Point 2 r :+ a) :+ [Point 2 r :+ a])
go NonEmpty (Point 2 r :+ a)
lh      ([Point 2 r :+ a] -> NonEmpty (Point 2 r :+ a)
forall a. [a] -> NonEmpty a
ne [Point 2 r :+ a]
rs)
                             | [Point 2 r :+ a] -> (Point 2 r :+ a) -> (Point 2 r :+ a) -> Bool
forall r c a b.
(Ord r, Num r) =>
[Point 2 r :+ c] -> (Point 2 r :+ a) -> (Point 2 r :+ b) -> Bool
isLeft' [Point 2 r :+ a]
ls Point 2 r :+ a
l Point 2 r :+ a
r = NonEmpty (Point 2 r :+ a)
-> NonEmpty (Point 2 r :+ a)
-> Two ((Point 2 r :+ a) :+ [Point 2 r :+ a])
go ([Point 2 r :+ a] -> NonEmpty (Point 2 r :+ a)
forall a. [a] -> NonEmpty a
ne [Point 2 r :+ a]
ls) NonEmpty (Point 2 r :+ a)
rh
                             | Bool
otherwise      = ((Point 2 r :+ a) :+ [Point 2 r :+ a])
-> ((Point 2 r :+ a) :+ [Point 2 r :+ a])
-> Two ((Point 2 r :+ a) :+ [Point 2 r :+ a])
forall a. a -> a -> Two a
Two (Point 2 r :+ a
l (Point 2 r :+ a)
-> [Point 2 r :+ a] -> (Point 2 r :+ a) :+ [Point 2 r :+ a]
forall core extra. core -> extra -> core :+ extra
:+ [Point 2 r :+ a]
ls) (Point 2 r :+ a
r (Point 2 r :+ a)
-> [Point 2 r :+ a] -> (Point 2 r :+ a) :+ [Point 2 r :+ a]
forall core extra. core -> extra -> core :+ extra
:+ [Point 2 r :+ a]
rs)

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

-- | Computes the Minkowski sum of the two input polygons with $n$ and $m$
-- vertices respectively.
--
-- pre: input polygons are in CCW order.
--
-- running time: \(O(n+m)\).
minkowskiSum     :: (Ord r, Num r)
                 => ConvexPolygon p r -> ConvexPolygon q r -> ConvexPolygon (p,q) r
minkowskiSum :: ConvexPolygon p r -> ConvexPolygon q r -> ConvexPolygon (p, q) r
minkowskiSum ConvexPolygon p r
p ConvexPolygon q r
q = SimplePolygon (p, q) r -> ConvexPolygon (p, q) r
forall p r. SimplePolygon p r -> ConvexPolygon p r
ConvexPolygon (SimplePolygon (p, q) r -> ConvexPolygon (p, q) r)
-> ([Point 2 r :+ (p, q)] -> SimplePolygon (p, q) r)
-> [Point 2 r :+ (p, q)]
-> ConvexPolygon (p, q) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point 2 r :+ (p, q)] -> SimplePolygon (p, q) r
forall r p. [Point 2 r :+ p] -> SimplePolygon p r
unsafeFromPoints ([Point 2 r :+ (p, q)] -> ConvexPolygon (p, q) r)
-> [Point 2 r :+ (p, q)] -> ConvexPolygon (p, q) r
forall a b. (a -> b) -> a -> b
$ [Point 2 r :+ p] -> [Point 2 r :+ q] -> [Point 2 r :+ (p, q)]
forall r (p :: * -> *) a b.
(Num r, Affine p, Ord r, Diff p ~ Vector 2) =>
[p r :+ a] -> [Point 2 r :+ b] -> [p r :+ (a, b)]
merge' (ConvexPolygon p r -> [Point 2 r :+ p]
forall r p. Ord r => ConvexPolygon p r -> [Point 2 r :+ p]
f ConvexPolygon p r
p) (ConvexPolygon q r -> [Point 2 r :+ q]
forall r p. Ord r => ConvexPolygon p r -> [Point 2 r :+ p]
f ConvexPolygon q r
q)
  where
    f :: ConvexPolygon p r -> [Point 2 r :+ p]
f ConvexPolygon p r
p' = let (Point 2 r :+ p
v:[Point 2 r :+ p]
xs) = CircularVector (Point 2 r :+ p) -> [Point 2 r :+ p]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (CircularVector (Point 2 r :+ p) -> [Point 2 r :+ p])
-> (ConvexPolygon p r -> CircularVector (Point 2 r :+ p))
-> ConvexPolygon p r
-> [Point 2 r :+ p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
forall r p.
Ord r =>
CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
bottomMost (CircularVector (Point 2 r :+ p)
 -> CircularVector (Point 2 r :+ p))
-> (ConvexPolygon p r -> CircularVector (Point 2 r :+ p))
-> ConvexPolygon p r
-> CircularVector (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConvexPolygon p r -> CircularVector (Point 2 r :+ p)
forall p r. ConvexPolygon p r -> CircularVector (Point 2 r :+ p)
getVertices (ConvexPolygon p r -> [Point 2 r :+ p])
-> ConvexPolygon p r -> [Point 2 r :+ p]
forall a b. (a -> b) -> a -> b
$ ConvexPolygon p r
p'
           in Point 2 r :+ p
v(Point 2 r :+ p) -> [Point 2 r :+ p] -> [Point 2 r :+ p]
forall a. a -> [a] -> [a]
:[Point 2 r :+ p]
xs[Point 2 r :+ p] -> [Point 2 r :+ p] -> [Point 2 r :+ p]
forall a. [a] -> [a] -> [a]
++[Point 2 r :+ p
v]
    (p a
v :+ a
ve) .+. :: (p a :+ a) -> (Point d a :+ b) -> p a :+ (a, b)
.+. (Point d a
w :+ b
we) = p a
v p a -> Diff p a -> p a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ Point d a -> Vector d a
forall (d :: Nat) r. Point d r -> Vector d r
toVec Point d a
w p a -> (a, b) -> p a :+ (a, b)
forall core extra. core -> extra -> core :+ extra
:+ (a
ve,b
we)

    cmpAngle :: p r -> p r -> p r -> p r -> Ordering
cmpAngle p r
v p r
v' p r
w p r
w' =
      Point 2 r -> Point 2 r -> Point 2 r -> Ordering
forall r.
(Num r, Ord r) =>
Point 2 r -> Point 2 r -> Point 2 r -> Ordering
ccwCmpAround Point 2 r
forall (d :: Nat) r. (Arity d, Num r) => Point d r
origin (Vector 2 r -> Point 2 r
forall (d :: Nat) r. Vector d r -> Point d r
Point (Vector 2 r -> Point 2 r) -> Vector 2 r -> Point 2 r
forall a b. (a -> b) -> a -> b
$ p r
v' p r -> p r -> Diff p r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. p r
v) (Vector 2 r -> Point 2 r
forall (d :: Nat) r. Vector d r -> Point d r
Point (Vector 2 r -> Point 2 r) -> Vector 2 r -> Point 2 r
forall a b. (a -> b) -> a -> b
$ p r
w' p r -> p r -> Diff p r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. p r
w)

    merge' :: [p r :+ a] -> [Point 2 r :+ b] -> [p r :+ (a, b)]
merge' [p r :+ a
_]       [Point 2 r :+ b
_]       = []
    merge' vs :: [p r :+ a]
vs@[p r :+ a
v]    (Point 2 r :+ b
w:[Point 2 r :+ b]
ws)    = p r :+ a
v (p r :+ a) -> (Point 2 r :+ b) -> p r :+ (a, b)
forall a (p :: * -> *) (d :: Nat) a b.
(Num a, Affine p, Diff p ~ Vector d) =>
(p a :+ a) -> (Point d a :+ b) -> p a :+ (a, b)
.+. Point 2 r :+ b
w (p r :+ (a, b)) -> [p r :+ (a, b)] -> [p r :+ (a, b)]
forall a. a -> [a] -> [a]
: [p r :+ a] -> [Point 2 r :+ b] -> [p r :+ (a, b)]
merge' [p r :+ a]
vs [Point 2 r :+ b]
ws
    merge' (p r :+ a
v:[p r :+ a]
vs)    ws :: [Point 2 r :+ b]
ws@[Point 2 r :+ b
w]    = p r :+ a
v (p r :+ a) -> (Point 2 r :+ b) -> p r :+ (a, b)
forall a (p :: * -> *) (d :: Nat) a b.
(Num a, Affine p, Diff p ~ Vector d) =>
(p a :+ a) -> (Point d a :+ b) -> p a :+ (a, b)
.+. Point 2 r :+ b
w (p r :+ (a, b)) -> [p r :+ (a, b)] -> [p r :+ (a, b)]
forall a. a -> [a] -> [a]
: [p r :+ a] -> [Point 2 r :+ b] -> [p r :+ (a, b)]
merge' [p r :+ a]
vs [Point 2 r :+ b]
ws
    merge' (p r :+ a
v:p r :+ a
v':[p r :+ a]
vs) (Point 2 r :+ b
w:Point 2 r :+ b
w':[Point 2 r :+ b]
ws) = p r :+ a
v (p r :+ a) -> (Point 2 r :+ b) -> p r :+ (a, b)
forall a (p :: * -> *) (d :: Nat) a b.
(Num a, Affine p, Diff p ~ Vector d) =>
(p a :+ a) -> (Point d a :+ b) -> p a :+ (a, b)
.+. Point 2 r :+ b
w (p r :+ (a, b)) -> [p r :+ (a, b)] -> [p r :+ (a, b)]
forall a. a -> [a] -> [a]
:
      case p r -> p r -> Point 2 r -> Point 2 r -> Ordering
forall r (p :: * -> *) (p :: * -> *).
(Num r, Ord r, Affine p, Affine p, Diff p ~ Vector 2,
 Diff p ~ Vector 2) =>
p r -> p r -> p r -> p r -> Ordering
cmpAngle (p r :+ a
v(p r :+ a) -> Getting (p r) (p r :+ a) (p r) -> p r
forall s a. s -> Getting a s a -> a
^.Getting (p r) (p r :+ a) (p r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (p r :+ a
v'(p r :+ a) -> Getting (p r) (p r :+ a) (p r) -> p r
forall s a. s -> Getting a s a -> a
^.Getting (p r) (p r :+ a) (p r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point 2 r :+ b
w(Point 2 r :+ b)
-> Getting (Point 2 r) (Point 2 r :+ b) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ b) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point 2 r :+ b
w'(Point 2 r :+ b)
-> Getting (Point 2 r) (Point 2 r :+ b) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ b) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) of
        Ordering
LT -> [p r :+ a] -> [Point 2 r :+ b] -> [p r :+ (a, b)]
merge' (p r :+ a
v'(p r :+ a) -> [p r :+ a] -> [p r :+ a]
forall a. a -> [a] -> [a]
:[p r :+ a]
vs)   (Point 2 r :+ b
w(Point 2 r :+ b) -> [Point 2 r :+ b] -> [Point 2 r :+ b]
forall a. a -> [a] -> [a]
:Point 2 r :+ b
w'(Point 2 r :+ b) -> [Point 2 r :+ b] -> [Point 2 r :+ b]
forall a. a -> [a] -> [a]
:[Point 2 r :+ b]
ws)
        Ordering
GT -> [p r :+ a] -> [Point 2 r :+ b] -> [p r :+ (a, b)]
merge' (p r :+ a
v(p r :+ a) -> [p r :+ a] -> [p r :+ a]
forall a. a -> [a] -> [a]
:p r :+ a
v'(p r :+ a) -> [p r :+ a] -> [p r :+ a]
forall a. a -> [a] -> [a]
:[p r :+ a]
vs) (Point 2 r :+ b
w'(Point 2 r :+ b) -> [Point 2 r :+ b] -> [Point 2 r :+ b]
forall a. a -> [a] -> [a]
:[Point 2 r :+ b]
ws)
        Ordering
EQ -> [p r :+ a] -> [Point 2 r :+ b] -> [p r :+ (a, b)]
merge' (p r :+ a
v'(p r :+ a) -> [p r :+ a] -> [p r :+ a]
forall a. a -> [a] -> [a]
:[p r :+ a]
vs)   (Point 2 r :+ b
w'(Point 2 r :+ b) -> [Point 2 r :+ b] -> [Point 2 r :+ b]
forall a. a -> [a] -> [a]
:[Point 2 r :+ b]
ws)
    merge' [p r :+ a]
_         [Point 2 r :+ b]
_         = String -> [p r :+ (a, b)]
forall a. HasCallStack => String -> a
error String
"minkowskiSum: Should not happen"


--------------------------------------------------------------------------------
-- inConvex

-- 1. Check if p is on left edge or right edge.
-- 2. Do binary search:
--       Find the largest n where p is on the right of 0 to n.
-- 3. Check if p is on segment n,n+1
-- 4. Check if p is in triangle 0,n,n+1

-- | \( O(\log n) \)
--   Check if a point lies inside a convex polygon, on the boundary, or outside of the
--   convex polygon.
inConvex :: forall p r. (Fractional r, Ord r)
         => Point 2 r -> ConvexPolygon p r
         -> PointLocationResult
inConvex :: Point 2 r -> ConvexPolygon p r -> PointLocationResult
inConvex Point 2 r
p (ConvexPolygon SimplePolygon p r
poly)
  | Point 2 r
p Point 2 r -> LineSegment 2 p r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` LineSegment 2 p r
leftEdge  = PointLocationResult
OnBoundary
  | Point 2 r
p Point 2 r -> LineSegment 2 p r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` LineSegment 2 p r
rightEdge = PointLocationResult
OnBoundary
  | Bool
otherwise                = Int -> Int -> PointLocationResult
worker Int
1 Int
n
  where
    p' :: Point 2 r :+ Any
p'        = Point 2 r
p Point 2 r -> Any -> Point 2 r :+ Any
forall core extra. core -> extra -> core :+ extra
:+ Any
forall a. HasCallStack => a
undefined
    n :: Int
n         = SimplePolygon p r -> Int
forall (t :: PolygonType) p r. Polygon t p r -> Int
size SimplePolygon p r
poly Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    point0 :: Point 2 r :+ p
point0    = Int -> Point 2 r :+ p
point Int
0
    leftEdge :: LineSegment 2 p r
leftEdge  = (Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point 2 r :+ p
point0 (Int -> Point 2 r :+ p
point Int
n)
    rightEdge :: LineSegment 2 p r
rightEdge = (Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point 2 r :+ p
point0 (Int -> Point 2 r :+ p
point Int
1)
    worker :: Int -> Int -> PointLocationResult
worker Int
a Int
b
      | Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b                        =
        if Point 2 r
p Point 2 r -> LineSegment 2 p r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` ((Point 2 r :+ p) -> (Point 2 r :+ p) -> LineSegment 2 p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment (Int -> Point 2 r :+ p
point Int
a) (Int -> Point 2 r :+ p
point Int
b))
          then PointLocationResult
OnBoundary
          else
            if Point 2 r -> Triangle 2 p r -> PointLocationResult
forall r p.
(Ord r, Fractional r) =>
Point 2 r -> Triangle 2 p r -> PointLocationResult
inTriangle Point 2 r
p ((Point 2 r :+ p)
-> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Triangle 2 p r
forall (d :: Nat) p r.
(Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Triangle d p r
Triangle Point 2 r :+ p
point0 (Int -> Point 2 r :+ p
point Int
a) (Int -> Point 2 r :+ p
point Int
b)) PointLocationResult -> PointLocationResult -> Bool
forall a. Eq a => a -> a -> Bool
== PointLocationResult
Outside
              then PointLocationResult
Outside
              else PointLocationResult
Inside
      | (Point 2 r :+ p) -> (Point 2 r :+ p) -> (Point 2 r :+ Any) -> CCW
forall r a b c.
(Ord r, Num r) =>
(Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
ccw' Point 2 r :+ p
point0 (Int -> Point 2 r :+ p
point Int
c) Point 2 r :+ Any
p' CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
CCW = Int -> Int -> PointLocationResult
worker Int
c Int
b
      | Bool
otherwise                       = Int -> Int -> PointLocationResult
worker Int
a Int
c
      where c :: Int
c = (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
    point :: Int -> Point 2 r :+ p
point Int
x = SimplePolygon p r
poly SimplePolygon p r
-> Getting (Point 2 r :+ p) (SimplePolygon p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^. Int -> Getter (SimplePolygon p r) (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Int -> Getter (Polygon t p r) (Point 2 r :+ p)
outerVertex Int
x

--------------------------------------------------------------------------------
-- Diameter

-- | \( O(n) \) Computes the Euclidean diameter by scanning antipodal pairs.
diameter :: (Ord r, Floating r) => ConvexPolygon p r -> r
diameter :: ConvexPolygon p r -> r
diameter ConvexPolygon p r
p = Point 2 r -> Point 2 r -> r
forall r (d :: Nat).
(Floating r, Arity d) =>
Point d r -> Point d r -> r
euclideanDist (Point 2 r :+ p
a(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point 2 r :+ p
b(Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)
  where
    (Point 2 r :+ p
a,Point 2 r :+ p
b) = ConvexPolygon p r -> (Point 2 r :+ p, Point 2 r :+ p)
forall r p.
(Ord r, Num r) =>
ConvexPolygon p r -> (Point 2 r :+ p, Point 2 r :+ p)
diametralPair ConvexPolygon p r
p

-- | \( O(n) \)
--   Computes the Euclidean diametral pair by scanning antipodal pairs.
diametralPair :: (Ord r, Num r) => ConvexPolygon p r -> (Point 2 r :+ p, Point 2 r :+ p)
diametralPair :: ConvexPolygon p r -> (Point 2 r :+ p, Point 2 r :+ p)
diametralPair ConvexPolygon p r
p = (ConvexPolygon p r
pConvexPolygon p r
-> Getting (Point 2 r :+ p) (ConvexPolygon p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.(SimplePolygon p r -> Const (Point 2 r :+ p) (SimplePolygon p r))
-> ConvexPolygon p r -> Const (Point 2 r :+ p) (ConvexPolygon p r)
forall p1 r1 p2 r2.
Iso
  (ConvexPolygon p1 r1)
  (ConvexPolygon p2 r2)
  (SimplePolygon p1 r1)
  (SimplePolygon p2 r2)
simplePolygon((SimplePolygon p r -> Const (Point 2 r :+ p) (SimplePolygon p r))
 -> ConvexPolygon p r -> Const (Point 2 r :+ p) (ConvexPolygon p r))
-> (((Point 2 r :+ p) -> Const (Point 2 r :+ p) (Point 2 r :+ p))
    -> SimplePolygon p r -> Const (Point 2 r :+ p) (SimplePolygon p r))
-> Getting (Point 2 r :+ p) (ConvexPolygon p r) (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Getter (SimplePolygon p r) (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Int -> Getter (Polygon t p r) (Point 2 r :+ p)
outerVertex Int
a, ConvexPolygon p r
pConvexPolygon p r
-> Getting (Point 2 r :+ p) (ConvexPolygon p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.(SimplePolygon p r -> Const (Point 2 r :+ p) (SimplePolygon p r))
-> ConvexPolygon p r -> Const (Point 2 r :+ p) (ConvexPolygon p r)
forall p1 r1 p2 r2.
Iso
  (ConvexPolygon p1 r1)
  (ConvexPolygon p2 r2)
  (SimplePolygon p1 r1)
  (SimplePolygon p2 r2)
simplePolygon((SimplePolygon p r -> Const (Point 2 r :+ p) (SimplePolygon p r))
 -> ConvexPolygon p r -> Const (Point 2 r :+ p) (ConvexPolygon p r))
-> (((Point 2 r :+ p) -> Const (Point 2 r :+ p) (Point 2 r :+ p))
    -> SimplePolygon p r -> Const (Point 2 r :+ p) (SimplePolygon p r))
-> Getting (Point 2 r :+ p) (ConvexPolygon p r) (Point 2 r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Getter (SimplePolygon p r) (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Int -> Getter (Polygon t p r) (Point 2 r :+ p)
outerVertex Int
b)
  where
    (Int
a,Int
b) = ConvexPolygon p r -> (Int, Int)
forall r p. (Ord r, Num r) => ConvexPolygon p r -> (Int, Int)
diametralIndexPair ConvexPolygon p r
p

-- | \( O(n) \)
--   Computes the Euclidean diametral pair by scanning antipodal pairs.
diametralIndexPair :: (Ord r, Num r) => ConvexPolygon p r -> (Int, Int)
diametralIndexPair :: ConvexPolygon p r -> (Int, Int)
diametralIndexPair ConvexPolygon p r
p = ((Int, Int) -> (Int, Int) -> Ordering)
-> [(Int, Int)] -> (Int, Int)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
F.maximumBy (Int, Int) -> (Int, Int) -> Ordering
fn ([(Int, Int)] -> (Int, Int)) -> [(Int, Int)] -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ ConvexPolygon p r -> [(Int, Int)]
forall p r. (Ord r, Num r) => ConvexPolygon p r -> [(Int, Int)]
antipodalPairs ConvexPolygon p r
p
  where
    fn :: (Int, Int) -> (Int, Int) -> Ordering
fn (Int
a1,Int
b1) (Int
a2,Int
b2) =
      Point 2 r -> Point 2 r -> r
forall r (d :: Nat).
(Num r, Arity d) =>
Point d r -> Point d r -> r
squaredEuclideanDist (ConvexPolygon p r
pConvexPolygon p r
-> Getting (Point 2 r) (ConvexPolygon p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(SimplePolygon p r -> Const (Point 2 r) (SimplePolygon p r))
-> ConvexPolygon p r -> Const (Point 2 r) (ConvexPolygon p r)
forall p1 r1 p2 r2.
Iso
  (ConvexPolygon p1 r1)
  (ConvexPolygon p2 r2)
  (SimplePolygon p1 r1)
  (SimplePolygon p2 r2)
simplePolygon((SimplePolygon p r -> Const (Point 2 r) (SimplePolygon p r))
 -> ConvexPolygon p r -> Const (Point 2 r) (ConvexPolygon p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> SimplePolygon p r -> Const (Point 2 r) (SimplePolygon p r))
-> Getting (Point 2 r) (ConvexPolygon p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Getter (SimplePolygon p r) (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Int -> Getter (Polygon t p r) (Point 2 r :+ p)
outerVertex Int
a1(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> SimplePolygon p r -> Const (Point 2 r) (SimplePolygon p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> SimplePolygon p r
-> Const (Point 2 r) (SimplePolygon p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (ConvexPolygon p r
pConvexPolygon p r
-> Getting (Point 2 r) (ConvexPolygon p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(SimplePolygon p r -> Const (Point 2 r) (SimplePolygon p r))
-> ConvexPolygon p r -> Const (Point 2 r) (ConvexPolygon p r)
forall p1 r1 p2 r2.
Iso
  (ConvexPolygon p1 r1)
  (ConvexPolygon p2 r2)
  (SimplePolygon p1 r1)
  (SimplePolygon p2 r2)
simplePolygon((SimplePolygon p r -> Const (Point 2 r) (SimplePolygon p r))
 -> ConvexPolygon p r -> Const (Point 2 r) (ConvexPolygon p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> SimplePolygon p r -> Const (Point 2 r) (SimplePolygon p r))
-> Getting (Point 2 r) (ConvexPolygon p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Getter (SimplePolygon p r) (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Int -> Getter (Polygon t p r) (Point 2 r :+ p)
outerVertex Int
b1(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> SimplePolygon p r -> Const (Point 2 r) (SimplePolygon p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> SimplePolygon p r
-> Const (Point 2 r) (SimplePolygon p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)
        r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare`
      Point 2 r -> Point 2 r -> r
forall r (d :: Nat).
(Num r, Arity d) =>
Point d r -> Point d r -> r
squaredEuclideanDist (ConvexPolygon p r
pConvexPolygon p r
-> Getting (Point 2 r) (ConvexPolygon p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(SimplePolygon p r -> Const (Point 2 r) (SimplePolygon p r))
-> ConvexPolygon p r -> Const (Point 2 r) (ConvexPolygon p r)
forall p1 r1 p2 r2.
Iso
  (ConvexPolygon p1 r1)
  (ConvexPolygon p2 r2)
  (SimplePolygon p1 r1)
  (SimplePolygon p2 r2)
simplePolygon((SimplePolygon p r -> Const (Point 2 r) (SimplePolygon p r))
 -> ConvexPolygon p r -> Const (Point 2 r) (ConvexPolygon p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> SimplePolygon p r -> Const (Point 2 r) (SimplePolygon p r))
-> Getting (Point 2 r) (ConvexPolygon p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Getter (SimplePolygon p r) (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Int -> Getter (Polygon t p r) (Point 2 r :+ p)
outerVertex Int
a2(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> SimplePolygon p r -> Const (Point 2 r) (SimplePolygon p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> SimplePolygon p r
-> Const (Point 2 r) (SimplePolygon p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (ConvexPolygon p r
pConvexPolygon p r
-> Getting (Point 2 r) (ConvexPolygon p r) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(SimplePolygon p r -> Const (Point 2 r) (SimplePolygon p r))
-> ConvexPolygon p r -> Const (Point 2 r) (ConvexPolygon p r)
forall p1 r1 p2 r2.
Iso
  (ConvexPolygon p1 r1)
  (ConvexPolygon p2 r2)
  (SimplePolygon p1 r1)
  (SimplePolygon p2 r2)
simplePolygon((SimplePolygon p r -> Const (Point 2 r) (SimplePolygon p r))
 -> ConvexPolygon p r -> Const (Point 2 r) (ConvexPolygon p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> SimplePolygon p r -> Const (Point 2 r) (SimplePolygon p r))
-> Getting (Point 2 r) (ConvexPolygon p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Getter (SimplePolygon p r) (Point 2 r :+ p)
forall (t :: PolygonType) p r.
Int -> Getter (Polygon t p r) (Point 2 r :+ p)
outerVertex Int
b2(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> SimplePolygon p r -> Const (Point 2 r) (SimplePolygon p r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> SimplePolygon p r
-> Const (Point 2 r) (SimplePolygon p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)

antipodalPairs :: forall p r. (Ord r, Num r) => ConvexPolygon p r -> [(Int, Int)]
antipodalPairs :: ConvexPolygon p r -> [(Int, Int)]
antipodalPairs ConvexPolygon p r
p = Int -> Point 2 r -> Int -> [(Int, Int)]
worker Int
0 (CircularVector (Point 2 r) -> Int -> Point 2 r
forall a. CircularVector a -> Int -> a
CV.index CircularVector (Point 2 r)
vectors Int
0) Int
1
  where
    n :: Int
n = Polygon 'Simple p r -> Int
forall (t :: PolygonType) p r. Polygon t p r -> Int
size (ConvexPolygon p r
pConvexPolygon p r
-> Getting
     (Polygon 'Simple p r) (ConvexPolygon p r) (Polygon 'Simple p r)
-> Polygon 'Simple p r
forall s a. s -> Getting a s a -> a
^.Getting
  (Polygon 'Simple p r) (ConvexPolygon p r) (Polygon 'Simple p r)
forall p1 r1 p2 r2.
Iso
  (ConvexPolygon p1 r1)
  (ConvexPolygon p2 r2)
  (SimplePolygon p1 r1)
  (SimplePolygon p2 r2)
simplePolygon)
    vs :: CircularVector (Point 2 r :+ p)
vs = ConvexPolygon p r
pConvexPolygon p r
-> Getting
     (CircularVector (Point 2 r :+ p))
     (ConvexPolygon p r)
     (CircularVector (Point 2 r :+ p))
-> CircularVector (Point 2 r :+ p)
forall s a. s -> Getting a s a -> a
^.(Polygon 'Simple p r
 -> Const (CircularVector (Point 2 r :+ p)) (Polygon 'Simple p r))
-> ConvexPolygon p r
-> Const (CircularVector (Point 2 r :+ p)) (ConvexPolygon p r)
forall p1 r1 p2 r2.
Iso
  (ConvexPolygon p1 r1)
  (ConvexPolygon p2 r2)
  (SimplePolygon p1 r1)
  (SimplePolygon p2 r2)
simplePolygon((Polygon 'Simple p r
  -> Const (CircularVector (Point 2 r :+ p)) (Polygon 'Simple p r))
 -> ConvexPolygon p r
 -> Const (CircularVector (Point 2 r :+ p)) (ConvexPolygon p r))
-> ((CircularVector (Point 2 r :+ p)
     -> Const
          (CircularVector (Point 2 r :+ p))
          (CircularVector (Point 2 r :+ p)))
    -> Polygon 'Simple p r
    -> Const (CircularVector (Point 2 r :+ p)) (Polygon 'Simple p r))
-> Getting
     (CircularVector (Point 2 r :+ p))
     (ConvexPolygon p r)
     (CircularVector (Point 2 r :+ p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CircularVector (Point 2 r :+ p)
 -> Const
      (CircularVector (Point 2 r :+ p))
      (CircularVector (Point 2 r :+ p)))
-> Polygon 'Simple p r
-> Const (CircularVector (Point 2 r :+ p)) (Polygon 'Simple p r)
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector

    worker :: Int -> Point 2 r -> Int -> [(Int, Int)]
worker Int
a Point 2 r
aElt Int
b
      | Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = []
      | Bool
otherwise =
        case 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
aElt (r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 r
0 r
0) (CircularVector (Point 2 r) -> Int -> Point 2 r
forall a. CircularVector a -> Int -> a
CV.index CircularVector (Point 2 r)
vectors Int
b) of
          CCW
CW -> Int -> Point 2 r -> Int -> [(Int, Int)]
worker Int
a Point 2 r
aElt (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
          CCW
_  ->
            (Int
a, Int
b Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n) (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
:
            Int -> Point 2 r -> Int -> [(Int, Int)]
worker (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (CircularVector (Point 2 r) -> Int -> Point 2 r
forall a. CircularVector a -> Int -> a
CV.index CircularVector (Point 2 r)
vectors (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) Int
b

    vectors :: CircularVector (Point 2 r)
    vectors :: CircularVector (Point 2 r)
vectors = Vector (Point 2 r) -> CircularVector (Point 2 r)
forall a. Vector a -> CircularVector a
CV.unsafeFromVector (Vector (Point 2 r) -> CircularVector (Point 2 r))
-> Vector (Point 2 r) -> CircularVector (Point 2 r)
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Point 2 r) -> Vector (Point 2 r)
forall a. Int -> (Int -> a) -> Vector a
V.generate Int
n ((Int -> Point 2 r) -> Vector (Point 2 r))
-> (Int -> Point 2 r) -> Vector (Point 2 r)
forall a b. (a -> b) -> a -> b
$ \Int
i ->
      let Point Vector 2 r
p1 = Int -> Point 2 r
point Int
i
          p2 :: Point 2 r
p2 = Int -> Point 2 r
point (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
      in Point 2 r
p2 Point 2 r -> Diff (Point 2) r -> Point 2 r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.-^ Diff (Point 2) r
Vector 2 r
p1

    point :: Int -> Point 2 r
point Int
x = CircularVector (Point 2 r :+ p) -> Int -> Point 2 r :+ p
forall a. CircularVector a -> Int -> a
CV.index CircularVector (Point 2 r :+ p)
vs Int
x (Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^. Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core

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

-- | Rotate to the rightmost point (rightmost and topmost in case of ties)
rightMost :: Ord r => CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
rightMost :: CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
rightMost = ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
forall a.
(a -> a -> Ordering) -> CircularVector a -> CircularVector a
CV.rotateToMaximumBy (((Point 2 r :+ p) -> Point 2 r)
-> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core))

-- | Rotate to the leftmost point (and bottommost in case of ties)
leftMost :: Ord r => CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
leftMost :: CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
leftMost = ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
forall a.
(a -> a -> Ordering) -> CircularVector a -> CircularVector a
CV.rotateToMinimumBy (((Point 2 r :+ p) -> Point 2 r)
-> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((Point 2 r :+ p)
-> Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core))

-- | Rotate to the bottommost point (and leftmost in case of ties)
bottomMost :: Ord r => CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
bottomMost :: CircularVector (Point 2 r :+ p) -> CircularVector (Point 2 r :+ p)
bottomMost = ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> CircularVector (Point 2 r :+ p)
-> CircularVector (Point 2 r :+ p)
forall a.
(a -> a -> Ordering) -> CircularVector a -> CircularVector a
CV.rotateToMinimumBy (((Point 2 r :+ p) -> (r, r))
-> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Point 2 r :+ p) -> (r, r)
forall (d :: Nat) (point :: Nat -> * -> *) b extra.
(ImplicitPeano (Peano d), ArityPeano (Peano (FromPeano (Peano d))),
 KnownNat (FromPeano (Peano d)), KnownNat d, AsAPoint point,
 (1 <=? d) ~ 'True, (2 <=? d) ~ 'True,
 Peano (FromPeano (Peano d) + 1)
 ~ 'S (Peano (FromPeano (Peano d)))) =>
(point d b :+ extra) -> (b, b)
f)
  where
    f :: (point d b :+ extra) -> (b, b)
f point d b :+ extra
p = (point d b :+ extra
p(point d b :+ extra) -> Getting b (point d b :+ extra) b -> b
forall s a. s -> Getting a s a -> a
^.(point d b -> Const b (point d b))
-> (point d b :+ extra) -> Const b (point d b :+ extra)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((point d b -> Const b (point d b))
 -> (point d b :+ extra) -> Const b (point d b :+ extra))
-> ((b -> Const b b) -> point d b -> Const b (point d b))
-> Getting b (point d b :+ extra) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(b -> Const b b) -> point d b -> Const b (point d b)
forall (d :: Nat) (point :: Nat -> * -> *) r.
(2 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
yCoord,point d b :+ extra
p(point d b :+ extra) -> Getting b (point d b :+ extra) b -> b
forall s a. s -> Getting a s a -> a
^.(point d b -> Const b (point d b))
-> (point d b :+ extra) -> Const b (point d b :+ extra)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((point d b -> Const b (point d b))
 -> (point d b :+ extra) -> Const b (point d b :+ extra))
-> ((b -> Const b b) -> point d b -> Const b (point d b))
-> Getting b (point d b :+ extra) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(b -> Const b b) -> point d b -> Const b (point d b)
forall (d :: Nat) (point :: Nat -> * -> *) r.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord)



-- | Helper to get the vertices of a convex polygon
getVertices :: ConvexPolygon p r -> CircularVector (Point 2 r :+ p)
getVertices :: ConvexPolygon p r -> CircularVector (Point 2 r :+ p)
getVertices = Getting
  (CircularVector (Point 2 r :+ p))
  (ConvexPolygon p r)
  (CircularVector (Point 2 r :+ p))
-> ConvexPolygon p r -> CircularVector (Point 2 r :+ p)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SimplePolygon p r
 -> Const (CircularVector (Point 2 r :+ p)) (SimplePolygon p r))
-> ConvexPolygon p r
-> Const (CircularVector (Point 2 r :+ p)) (ConvexPolygon p r)
forall p1 r1 p2 r2.
Iso
  (ConvexPolygon p1 r1)
  (ConvexPolygon p2 r2)
  (SimplePolygon p1 r1)
  (SimplePolygon p2 r2)
simplePolygon((SimplePolygon p r
  -> Const (CircularVector (Point 2 r :+ p)) (SimplePolygon p r))
 -> ConvexPolygon p r
 -> Const (CircularVector (Point 2 r :+ p)) (ConvexPolygon p r))
-> ((CircularVector (Point 2 r :+ p)
     -> Const
          (CircularVector (Point 2 r :+ p))
          (CircularVector (Point 2 r :+ p)))
    -> SimplePolygon p r
    -> Const (CircularVector (Point 2 r :+ p)) (SimplePolygon p r))
-> Getting
     (CircularVector (Point 2 r :+ p))
     (ConvexPolygon p r)
     (CircularVector (Point 2 r :+ p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CircularVector (Point 2 r :+ p)
 -> Const
      (CircularVector (Point 2 r :+ p))
      (CircularVector (Point 2 r :+ p)))
-> SimplePolygon p r
-> Const (CircularVector (Point 2 r :+ p)) (SimplePolygon p r)
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector)

-- -- | rotate right while p 'current' 'rightNeibhour' is true
-- rotateRWhile      :: (a -> a -> Bool) -> C.CList a -> C.CList a
-- rotateRWhile p lst
--   | C.isEmpty lst = lst
--   | otherwise     = go lst
--     where
--       go xs = let cur = focus xs
--                   xs' = C.rotR xs
--                   nxt = focus' xs'
--               in if p cur nxt then go xs' else xs

-- test1 :: Num r => ConvexPolygon () r
-- test1 = ConvexPolygon . fromPoints . map ext . reverse $ [origin, Point2 1 4, Point2 5 6, Point2 10 3]

-- test2 :: Num r => ConvexPolygon () r
-- test2 = ConvexPolygon . fromPoints . map ext . reverse $ [Point2 11 6, Point2 10 10, Point2 15 18, Point2 12 5]

-- testA :: Num r => ConvexPolygon () r
-- testA = ConvexPolygon . fromPoints . map ext $ [origin, Point2 5 1, Point2 2 2]

-- testB :: Num r => ConvexPolygon () r
-- testB = ConvexPolygon . fromPoints . map ext $ [origin, Point2 5 3, Point2 (-2) 2, Point2 (-2) 1]




--------------------------------------------------------------------------------
-- Random convex polygons

-- This is true for all convex polygons:
--   1. the sum of all edge vectors is (0,0). This is even true for all polygons.
--   2. edges are sorted by angle. Ie. all vertices are convex, not reflex.
--
-- So, if we can generate a set of vectors that sum to zero then we can sort them
-- and place them end-to-end and the result will be a convex polygon.
--
-- So, we need to generate N points that sum to 0. This can be done by generating
-- two sets of N points that sum to M, and the subtracting them from each other.
--
-- Generating N points that sum to M is done like this: Generate (N-1) unique points
-- between (but not including) 0 and M. Write down the distance between the points.
-- Imagine a scale from 0 to M:
--   0            M
--   |            |
-- Then we add two randomly selected points:
--   0            M
--   |  *      *  |
-- Then we look at the distance between 0 and point1, point1 and point2, and point2 to M:
--   0            M
--   |--*------*--|
--    2     6    2
-- 2+6+2 = 10 = M
--
-- Doing this again might yield [5,2,3]. Subtract them:
--     [2,   6,   2  ]
--   - [5,   2,   3  ]
--   = [2-5, 6-2, 2-3]
--   = [-3,  4,   -1 ]
-- And the sum of [-3, 4, -1] = -3+4-1 = 0.

-- O(n log n)
randomBetween :: RandomGen g => Int -> Int -> Rand g (VU.Vector Int)
randomBetween :: Int -> Int -> Rand g (Vector Int)
randomBetween Int
n Int
vMax | Int
vMax Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 = Vector Int -> Rand g (Vector Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector Int -> Rand g (Vector Int))
-> Vector Int -> Rand g (Vector Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector Int
forall a. Unbox a => Int -> a -> Vector a
VU.replicate Int
vMax Int
1
randomBetween Int
n Int
vMax = Int -> IntSet -> Rand g (Vector Int)
worker (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) IntSet
IS.empty
  where
    gen :: Int -> [Int] -> [Int]
gen Int
from []     = [Int
vMaxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
from]
    gen Int
from (Int
x:[Int]
xs) = (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
from) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> [Int] -> [Int]
gen Int
x [Int]
xs
    worker :: Int -> IntSet -> Rand g (Vector Int)
worker Int
0 IntSet
seen = Vector Int -> Rand g (Vector Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int] -> Vector Int
forall a. Unbox a => [a] -> Vector a
VU.fromList (Int -> [Int] -> [Int]
gen Int
0 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ IntSet -> [Int]
IS.elems IntSet
seen))
    worker Int
i IntSet
seen = do
      Int
v <- (Int, Int) -> RandT g Identity Int
forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Int
1, Int
vMaxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
      if Int -> IntSet -> Bool
IS.member Int
v IntSet
seen
        then Int -> IntSet -> Rand g (Vector Int)
worker Int
i IntSet
seen
        else Int -> IntSet -> Rand g (Vector Int)
worker (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int -> IntSet -> IntSet
IS.insert Int
v IntSet
seen)

randomBetweenZero :: RandomGen g => Int -> Int -> Rand g (VU.Vector Int)
randomBetweenZero :: Int -> Int -> Rand g (Vector Int)
randomBetweenZero Int
n Int
vMax = (Int -> Int -> Int) -> Vector Int -> Vector Int -> Vector Int
forall a b c.
(Unbox a, Unbox b, Unbox c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
VU.zipWith (-) (Vector Int -> Vector Int -> Vector Int)
-> Rand g (Vector Int)
-> RandT g Identity (Vector Int -> Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Rand g (Vector Int)
forall g. RandomGen g => Int -> Int -> Rand g (Vector Int)
randomBetween Int
n Int
vMax RandT g Identity (Vector Int -> Vector Int)
-> Rand g (Vector Int) -> Rand g (Vector Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> Rand g (Vector Int)
forall g. RandomGen g => Int -> Int -> Rand g (Vector Int)
randomBetween Int
n Int
vMax

randomEdges :: RandomGen g => Int -> Int -> Rand g [Vector 2 Int]
randomEdges :: Int -> Int -> Rand g [Vector 2 Int]
randomEdges Int
n Int
vMax = do
  (Int -> Int -> Vector 2 Int) -> [Int] -> [Int] -> [Vector 2 Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Vector 2 Int
forall r. r -> r -> Vector 2 r
Vector2
    ([Int] -> [Int] -> [Vector 2 Int])
-> RandT g Identity [Int]
-> RandT g Identity ([Int] -> [Vector 2 Int])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Vector Int -> [Int])
-> RandT g Identity (Vector Int) -> RandT g Identity [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Int -> [Int]
forall a. Unbox a => Vector a -> [a]
VU.toList (Int -> Int -> RandT g Identity (Vector Int)
forall g. RandomGen g => Int -> Int -> Rand g (Vector Int)
randomBetweenZero Int
n Int
vMax)
    RandT g Identity ([Int] -> [Vector 2 Int])
-> RandT g Identity [Int] -> Rand g [Vector 2 Int]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Vector Int -> [Int])
-> RandT g Identity (Vector Int) -> RandT g Identity [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Int -> [Int]
forall a. Unbox a => Vector a -> [a]
VU.toList (Int -> Int -> RandT g Identity (Vector Int)
forall g. RandomGen g => Int -> Int -> Rand g (Vector Int)
randomBetweenZero Int
n Int
vMax)

-- | \( O(n \log n) \)
--   Generate a uniformly random ConvexPolygon with @N@ vertices and a granularity of @vMax@.
randomConvex :: RandomGen g => Int -> Int -> Rand g (ConvexPolygon () Rational)
randomConvex :: Int -> Int -> Rand g (ConvexPolygon () Rational)
randomConvex Int
n Int
_vMax | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 =
  String -> Rand g (ConvexPolygon () Rational)
forall a. HasCallStack => String -> a
error String
"Data.Geometry.Polygon.Convex.randomConvex: At least 3 edges are required."
randomConvex Int
n Int
vMax = do
  ~(Vector 2 Int
v:[Vector 2 Int]
vs) <- [Point 2 Int] -> [Vector 2 Int]
coerce ([Point 2 Int] -> [Vector 2 Int])
-> ([Vector 2 Int] -> [Point 2 Int])
-> [Vector 2 Int]
-> [Vector 2 Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point 2 Int -> [Point 2 Int] -> [Point 2 Int]
forall r. (Ord r, Num r) => Point 2 r -> [Point 2 r] -> [Point 2 r]
sortAround Point 2 Int
forall (d :: Nat) r. (Arity d, Num r) => Point d r
origin ([Point 2 Int] -> [Point 2 Int])
-> ([Vector 2 Int] -> [Point 2 Int])
-> [Vector 2 Int]
-> [Point 2 Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vector 2 Int] -> [Point 2 Int]
coerce ([Vector 2 Int] -> [Vector 2 Int])
-> RandT g Identity [Vector 2 Int]
-> RandT g Identity [Vector 2 Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> RandT g Identity [Vector 2 Int]
forall g. RandomGen g => Int -> Int -> Rand g [Vector 2 Int]
randomEdges Int
n Int
vMax
  let vertices :: [Point 2 Rational]
vertices = (Int -> Rational) -> Point 2 Int -> Point 2 Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Int -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
vMax) (Rational -> Rational) -> (Int -> Rational) -> Int -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac) (Point 2 Int -> Point 2 Rational)
-> [Point 2 Int] -> [Point 2 Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Point 2 Int -> Vector 2 Int -> Point 2 Int)
-> Point 2 Int -> [Vector 2 Int] -> [Point 2 Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Point 2 Int -> Vector 2 Int -> Point 2 Int
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
(.+^) (Vector 2 Int -> Point 2 Int
forall (d :: Nat) r. Vector d r -> Point d r
Point Vector 2 Int
v) [Vector 2 Int]
vs
      pRational :: SimplePolygon () Rational
pRational = [Point 2 Rational :+ ()] -> SimplePolygon () Rational
forall r p. [Point 2 r :+ p] -> SimplePolygon p r
unsafeFromPoints ([Point 2 Rational :+ ()] -> SimplePolygon () Rational)
-> [Point 2 Rational :+ ()] -> SimplePolygon () Rational
forall a b. (a -> b) -> a -> b
$ (Point 2 Rational -> Point 2 Rational :+ ())
-> [Point 2 Rational] -> [Point 2 Rational :+ ()]
forall a b. (a -> b) -> [a] -> [b]
map Point 2 Rational -> Point 2 Rational :+ ()
forall a. a -> a :+ ()
ext [Point 2 Rational]
vertices
      Point Vector 2 Rational
c = SimplePolygon () Rational -> Point 2 Rational
forall r p. Fractional r => SimplePolygon p r -> Point 2 r
centroid SimplePolygon () Rational
pRational
      pFinal :: SimplePolygon () Rational
pFinal = SimplePolygon () Rational
pRational SimplePolygon () Rational
-> (SimplePolygon () Rational -> SimplePolygon () Rational)
-> SimplePolygon () Rational
forall a b. a -> (a -> b) -> b
& (CircularVector (Point 2 Rational :+ ())
 -> Identity (CircularVector (Point 2 Rational :+ ())))
-> SimplePolygon () Rational
-> Identity (SimplePolygon () Rational)
forall (t :: PolygonType) p r.
Lens' (Polygon t p r) (CircularVector (Point 2 r :+ p))
unsafeOuterBoundaryVector ((CircularVector (Point 2 Rational :+ ())
  -> Identity (CircularVector (Point 2 Rational :+ ())))
 -> SimplePolygon () Rational
 -> Identity (SimplePolygon () Rational))
-> (CircularVector (Point 2 Rational :+ ())
    -> CircularVector (Point 2 Rational :+ ()))
-> SimplePolygon () Rational
-> SimplePolygon () Rational
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((Point 2 Rational :+ ()) -> Point 2 Rational :+ ())
-> CircularVector (Point 2 Rational :+ ())
-> CircularVector (Point 2 Rational :+ ())
forall a b. (a -> b) -> CircularVector a -> CircularVector b
CV.map (ASetter
  (Point 2 Rational :+ ())
  (Point 2 Rational :+ ())
  (Point 2 Rational)
  (Point 2 Rational)
-> (Point 2 Rational -> Point 2 Rational)
-> (Point 2 Rational :+ ())
-> Point 2 Rational :+ ()
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Point 2 Rational :+ ())
  (Point 2 Rational :+ ())
  (Point 2 Rational)
  (Point 2 Rational)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core (Point 2 Rational -> Diff (Point 2) Rational -> Point 2 Rational
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.-^ Diff (Point 2) Rational
Vector 2 Rational
c))
  ConvexPolygon () Rational -> Rand g (ConvexPolygon () Rational)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConvexPolygon () Rational -> Rand g (ConvexPolygon () Rational))
-> ConvexPolygon () Rational -> Rand g (ConvexPolygon () Rational)
forall a b. (a -> b) -> a -> b
$ SimplePolygon () Rational -> ConvexPolygon () Rational
forall p r. SimplePolygon p r -> ConvexPolygon p r
ConvexPolygon SimplePolygon () Rational
pFinal