module Data.Geometry.Point.Orientation.Degenerate(
    CCW(..)
  , pattern CCW, pattern CW, pattern CoLinear

  , ccw, ccw'

  , isCoLinear

  , sortAround, sortAround'

  , ccwCmpAroundWith, ccwCmpAroundWith'
  , cwCmpAroundWith, cwCmpAroundWith'
  , ccwCmpAround, ccwCmpAround'
  , cwCmpAround, cwCmpAround'

  , insertIntoCyclicOrder
  ) where

import           Control.Lens
import qualified Data.CircularList as C
import qualified Data.CircularList.Util as CU
import           Data.Ext
import           Data.Geometry.Point.Internal
import           Data.Geometry.Vector
import qualified Data.List as L

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

-- $setup
-- >>> import Data.Double.Approximate

-- | Data type for expressing the orientation of three points, with
-- the option of allowing Colinearities.
newtype CCW = CCWWrap Ordering deriving CCW -> CCW -> Bool
(CCW -> CCW -> Bool) -> (CCW -> CCW -> Bool) -> Eq CCW
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CCW -> CCW -> Bool
$c/= :: CCW -> CCW -> Bool
== :: CCW -> CCW -> Bool
$c== :: CCW -> CCW -> Bool
Eq

-- | CounterClockwise orientation. Also called a left-turn.
pattern CCW      :: CCW
pattern $bCCW :: CCW
$mCCW :: forall r. CCW -> (Void# -> r) -> (Void# -> r) -> r
CCW      = CCWWrap GT

-- | Clockwise orientation. Also called a right-turn.
pattern CW       :: CCW
pattern $bCW :: CCW
$mCW :: forall r. CCW -> (Void# -> r) -> (Void# -> r) -> r
CW       = CCWWrap LT

-- | CoLinear orientation. Also called a straight line.
pattern CoLinear :: CCW
pattern $bCoLinear :: CCW
$mCoLinear :: forall r. CCW -> (Void# -> r) -> (Void# -> r) -> r
CoLinear = CCWWrap EQ
{-# COMPLETE CCW, CW, CoLinear #-}

instance Show CCW where
  show :: CCW -> String
show = \case
    CCW
CCW      -> String
"CCW"
    CCW
CW       -> String
"CW"
    CCW
CoLinear -> String
"CoLinear"


-- | Given three points p q and r determine the orientation when going from p to r via q.
--
-- Be vary of numerical instability:
-- >>> ccw (Point2 0 0.3) (Point2 1 0.6) (Point2 2 (0.9::Double))
-- CCW
--
-- >>> ccw (Point2 0 0.3) (Point2 1 0.6) (Point2 2 (0.9::Rational))
-- CoLinear
--
-- If you can't use 'Rational', try 'SafeDouble' instead of 'Double':
-- >>> ccw (Point2 0 0.3) (Point2 1 0.6) (Point2 2 (0.9::SafeDouble))
-- CoLinear
--
ccw :: (Ord r, Num r) => Point 2 r -> Point 2 r -> Point 2 r -> CCW
ccw :: Point 2 r -> Point 2 r -> Point 2 r -> CCW
ccw Point 2 r
p Point 2 r
q Point 2 r
r = Ordering -> CCW
CCWWrap (Ordering -> CCW) -> Ordering -> CCW
forall a b. (a -> b) -> a -> b
$ (r
uxr -> r -> r
forall a. Num a => a -> a -> a
*r
vy) r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (r
uyr -> r -> r
forall a. Num a => a -> a -> a
*r
vx)
-- ccw p q r = CCWWrap $ z `compare` 0 -- Comparing against 0 is bad for numerical robustness.
                                       -- I've added a testcase that fails if comparing against 0.
            -- case z `compare` 0 of
            --   LT -> CW
            --   GT -> CCW
            --   EQ -> CoLinear
     where
       Vector2 r
ux r
uy = Point 2 r
q Point 2 r -> Point 2 r -> Diff (Point 2) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point 2 r
p
       Vector2 r
vx r
vy = Point 2 r
r Point 2 r -> Point 2 r -> Diff (Point 2) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point 2 r
p
      --  _z             = ux * vy - uy * vx

-- | Given three points p q and r determine if the line from p to r via q is straight/colinear.
--
-- This is identical to `ccw p q r == CoLinear` but doesn't have the `Ord` constraint.
isCoLinear :: (Eq r, Num r) => Point 2 r -> Point 2 r -> Point 2 r -> Bool
isCoLinear :: Point 2 r -> Point 2 r -> Point 2 r -> Bool
isCoLinear Point 2 r
p Point 2 r
q Point 2 r
r = (r
ux r -> r -> r
forall a. Num a => a -> a -> a
* r
vy) r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== (r
uy r -> r -> r
forall a. Num a => a -> a -> a
* r
vx)
     where
       Vector2 r
ux r
uy = Point 2 r
q Point 2 r -> Point 2 r -> Diff (Point 2) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point 2 r
p
       Vector2 r
vx r
vy = Point 2 r
r Point 2 r -> Point 2 r -> Diff (Point 2) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point 2 r
p

-- | Given three points p q and r determine the orientation when going from p to r via q.
ccw' :: (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 :+ b) -> (Point 2 r :+ c) -> CCW
ccw' Point 2 r :+ a
p Point 2 r :+ b
q Point 2 r :+ c
r = Point 2 r -> Point 2 r -> Point 2 r -> CCW
forall r.
(Ord r, Num r) =>
Point 2 r -> Point 2 r -> Point 2 r -> CCW
ccw (Point 2 r :+ a
p(Point 2 r :+ a)
-> Getting (Point 2 r) (Point 2 r :+ a) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ a) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point 2 r :+ b
q(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 :+ c
r(Point 2 r :+ c)
-> Getting (Point 2 r) (Point 2 r :+ c) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ c) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)

-- | \( O(n log n) \)
-- Sort the points arround the given point p in counter clockwise order with
-- respect to the rightward horizontal ray starting from p.  If two points q
-- and r are colinear with p, the closest one to p is reported first.
sortAround   :: (Ord r, Num r)
             => Point 2 r -> [Point 2 r] -> [Point 2 r]
sortAround :: Point 2 r -> [Point 2 r] -> [Point 2 r]
sortAround Point 2 r
c = (Point 2 r -> Point 2 r -> Ordering) -> [Point 2 r] -> [Point 2 r]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (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
c (Point 2 r -> Point 2 r -> Ordering)
-> (Point 2 r -> Point 2 r -> Ordering)
-> Point 2 r
-> Point 2 r
-> Ordering
forall a. Semigroup a => a -> a -> a
<> Point 2 r -> Point 2 r -> Point 2 r -> Ordering
forall r (d :: Nat).
(Ord r, Num r, Arity d) =>
Point d r -> Point d r -> Point d r -> Ordering
cmpByDistanceTo Point 2 r
c)

-- | \( O(n log n) \)
-- Sort the points arround the given point p in counter clockwise order with
-- respect to the rightward horizontal ray starting from p.  If two points q
-- and r are colinear with p, the closest one to p is reported first.
sortAround'   :: (Ord r, Num r)
             => Point 2 r :+ q -> [Point 2 r :+ p] -> [Point 2 r :+ p]
sortAround' :: (Point 2 r :+ q) -> [Point 2 r :+ p] -> [Point 2 r :+ p]
sortAround' Point 2 r :+ q
c = ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> [Point 2 r :+ p] -> [Point 2 r :+ p]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy ((Point 2 r :+ q)
-> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
forall r qc p q.
(Num r, Ord r) =>
(Point 2 r :+ qc)
-> (Point 2 r :+ p) -> (Point 2 r :+ q) -> Ordering
ccwCmpAround' Point 2 r :+ q
c ((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. Semigroup a => a -> a -> a
<> (Point 2 r :+ q)
-> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
forall r (d :: Nat) c p q.
(Ord r, Num r, Arity d) =>
(Point d r :+ c)
-> (Point d r :+ p) -> (Point d r :+ q) -> Ordering
cmpByDistanceTo' Point 2 r :+ q
c)


-- | Given a zero vector z, a center c, and two points p and q,
-- compute the ccw ordering of p and q around c with this vector as zero
-- direction.
--
-- pre: the points p,q /= c
ccwCmpAroundWith                              :: (Ord r, Num r)
                                              => Vector 2 r
                                              -> Point 2 r
                                              -> Point 2 r -> Point 2 r
                                              -> Ordering
ccwCmpAroundWith :: Vector 2 r -> Point 2 r -> Point 2 r -> Point 2 r -> Ordering
ccwCmpAroundWith z :: Vector 2 r
z@(Vector2 r
zx r
zy) Point 2 r
c Point 2 r
q Point 2 r
r =
    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
c Point 2 r
a Point 2 r
q, 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
c Point 2 r
a Point 2 r
r) of
      (CCW
CCW,CCW
CCW)      -> Ordering
cmp
      (CCW
CCW,CCW
CW)       -> Ordering
LT
      (CCW
CCW,CCW
CoLinear) | Point 2 r -> Bool
onZero Point 2 r
r  -> Ordering
GT
                     | Bool
otherwise -> Ordering
LT

      (CCW
CW, CCW
CCW)      -> Ordering
GT
      (CCW
CW, CCW
CW)       -> Ordering
cmp
      (CCW
CW, CCW
CoLinear) -> Ordering
GT

      (CCW
CoLinear, CCW
CCW) | Point 2 r -> Bool
onZero Point 2 r
q  -> Ordering
LT
                      | Bool
otherwise -> Ordering
GT

      (CCW
CoLinear, CCW
CW)      -> Ordering
LT
      (CCW
CoLinear,CCW
CoLinear) -> case (Point 2 r -> Bool
onZero Point 2 r
q, Point 2 r -> Bool
onZero Point 2 r
r) of
                               (Bool
True, Bool
True)   -> Ordering
EQ
                               (Bool
False, Bool
False) -> Ordering
EQ
                               (Bool
True, Bool
False)  -> Ordering
LT
                               (Bool
False, Bool
True)  -> Ordering
GT
  where
    a :: Point 2 r
a = Point 2 r
c 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
z
    b :: Point 2 r
b = Point 2 r
c Point 2 r -> Diff (Point 2) r -> Point 2 r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 (-r
zy) r
zx
    -- b is on a perpendicular vector to z

    -- test if the point lies on the ray defined by z, starting in c
    onZero :: Point 2 r -> Bool
onZero Point 2 r
d = 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
c Point 2 r
b Point 2 r
d of
                 CCW
CCW      -> Bool
False
                 CCW
CW       -> Bool
True
                 CCW
CoLinear -> Bool
True -- this shouldh appen only when you ask for c itself

    cmp :: Ordering
cmp = 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
c Point 2 r
q Point 2 r
r of
            CCW
CCW      -> Ordering
LT
            CCW
CW       -> Ordering
GT
            CCW
CoLinear -> Ordering
EQ

-- | Given a zero vector z, a center c, and two points p and q,
-- compute the ccw ordering of p and q around c with this vector as zero
-- direction.
--
-- pre: the points p,q /= c
ccwCmpAroundWith'                              :: (Ord r, Num r)
                                               => Vector 2 r
                                               -> Point 2 r :+ c
                                               -> Point 2 r :+ a -> Point 2 r :+ b
                                               -> Ordering
ccwCmpAroundWith' :: Vector 2 r
-> (Point 2 r :+ c)
-> (Point 2 r :+ a)
-> (Point 2 r :+ b)
-> Ordering
ccwCmpAroundWith' Vector 2 r
z (Point 2 r
c :+ c
_) (Point 2 r
q :+ a
_) (Point 2 r
r :+ b
_) = Vector 2 r -> Point 2 r -> Point 2 r -> Point 2 r -> Ordering
forall r.
(Ord r, Num r) =>
Vector 2 r -> Point 2 r -> Point 2 r -> Point 2 r -> Ordering
ccwCmpAroundWith Vector 2 r
z Point 2 r
c Point 2 r
q Point 2 r
r

-- | Given a zero vector z, a center c, and two points p and q,
-- compute the cw ordering of p and q around c with this vector as zero
-- direction.
--
-- pre: the points p,q /= c
cwCmpAroundWith     :: (Ord r, Num r)
                    => Vector 2 r
                    -> Point 2 r
                    -> Point 2 r -> Point 2 r
                    -> Ordering
cwCmpAroundWith :: Vector 2 r -> Point 2 r -> Point 2 r -> Point 2 r -> Ordering
cwCmpAroundWith Vector 2 r
z Point 2 r
c = (Point 2 r -> Point 2 r -> Ordering)
-> Point 2 r -> Point 2 r -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Vector 2 r -> Point 2 r -> Point 2 r -> Point 2 r -> Ordering
forall r.
(Ord r, Num r) =>
Vector 2 r -> Point 2 r -> Point 2 r -> Point 2 r -> Ordering
ccwCmpAroundWith Vector 2 r
z Point 2 r
c)


-- | Given a zero vector z, a center c, and two points p and q,
-- compute the cw ordering of p and q around c with this vector as zero
-- direction.
--
-- pre: the points p,q /= c
cwCmpAroundWith'    :: (Ord r, Num r)
                    => Vector 2 r
                    -> Point 2 r :+ a
                    -> Point 2 r :+ b -> Point 2 r :+ c
                    -> Ordering
cwCmpAroundWith' :: Vector 2 r
-> (Point 2 r :+ a)
-> (Point 2 r :+ b)
-> (Point 2 r :+ c)
-> Ordering
cwCmpAroundWith' Vector 2 r
z Point 2 r :+ a
c = ((Point 2 r :+ c) -> (Point 2 r :+ b) -> Ordering)
-> (Point 2 r :+ b) -> (Point 2 r :+ c) -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Vector 2 r
-> (Point 2 r :+ a)
-> (Point 2 r :+ c)
-> (Point 2 r :+ b)
-> Ordering
forall r c a b.
(Ord r, Num r) =>
Vector 2 r
-> (Point 2 r :+ c)
-> (Point 2 r :+ a)
-> (Point 2 r :+ b)
-> Ordering
ccwCmpAroundWith' Vector 2 r
z Point 2 r :+ a
c)

-- | Counter clockwise ordering of the points around c. Points are ordered with
-- respect to the positive x-axis.
ccwCmpAround :: (Num r, Ord r)
             => Point 2 r -> Point 2 r -> Point 2 r -> Ordering
ccwCmpAround :: Point 2 r -> Point 2 r -> Point 2 r -> Ordering
ccwCmpAround = Vector 2 r -> Point 2 r -> Point 2 r -> Point 2 r -> Ordering
forall r.
(Ord r, Num r) =>
Vector 2 r -> Point 2 r -> Point 2 r -> Point 2 r -> Ordering
ccwCmpAroundWith (r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 r
1 r
0)

-- | Counter clockwise ordering of the points around c. Points are ordered with
-- respect to the positive x-axis.
ccwCmpAround' :: (Num r, Ord r)
             => Point 2 r :+ qc -> Point 2 r :+ p -> Point 2 r :+ q -> Ordering
ccwCmpAround' :: (Point 2 r :+ qc)
-> (Point 2 r :+ p) -> (Point 2 r :+ q) -> Ordering
ccwCmpAround' = Vector 2 r
-> (Point 2 r :+ qc)
-> (Point 2 r :+ p)
-> (Point 2 r :+ q)
-> Ordering
forall r c a b.
(Ord r, Num r) =>
Vector 2 r
-> (Point 2 r :+ c)
-> (Point 2 r :+ a)
-> (Point 2 r :+ b)
-> Ordering
ccwCmpAroundWith' (r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 r
1 r
0)

-- | Clockwise ordering of the points around c. Points are ordered with
-- respect to the positive x-axis.
cwCmpAround :: (Num r, Ord r)
            => Point 2 r -> Point 2 r -> Point 2 r -> Ordering
cwCmpAround :: Point 2 r -> Point 2 r -> Point 2 r -> Ordering
cwCmpAround = Vector 2 r -> Point 2 r -> Point 2 r -> Point 2 r -> Ordering
forall r.
(Ord r, Num r) =>
Vector 2 r -> Point 2 r -> Point 2 r -> Point 2 r -> Ordering
cwCmpAroundWith (r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 r
1 r
0)

-- | Clockwise ordering of the points around c. Points are ordered with
-- respect to the positive x-axis.
cwCmpAround' :: (Num r, Ord r)
            => Point 2 r :+ qc -> Point 2 r :+ p -> Point 2 r :+ q -> Ordering
cwCmpAround' :: (Point 2 r :+ qc)
-> (Point 2 r :+ p) -> (Point 2 r :+ q) -> Ordering
cwCmpAround' Point 2 r :+ qc
a Point 2 r :+ p
b Point 2 r :+ q
c = 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
cwCmpAround (Point 2 r :+ qc
a(Point 2 r :+ qc)
-> Getting (Point 2 r) (Point 2 r :+ qc) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ qc) (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) (Point 2 r :+ q
c(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)

-- | \( O(n) \)
-- Given a center c, a new point p, and a list of points ps, sorted in
-- counter clockwise order around c. Insert p into the cyclic order. The focus
-- of the returned cyclic list is the new point p.
insertIntoCyclicOrder   :: (Ord r, Num r)
                        => Point 2 r :+ q -> Point 2 r :+ p
                        -> C.CList (Point 2 r :+ p) -> C.CList (Point 2 r :+ p)
insertIntoCyclicOrder :: (Point 2 r :+ q)
-> (Point 2 r :+ p)
-> CList (Point 2 r :+ p)
-> CList (Point 2 r :+ p)
insertIntoCyclicOrder Point 2 r :+ q
c = ((Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering)
-> (Point 2 r :+ p)
-> CList (Point 2 r :+ p)
-> CList (Point 2 r :+ p)
forall a. (a -> a -> Ordering) -> a -> CList a -> CList a
CU.insertOrdBy ((Point 2 r :+ q)
-> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
forall r qc p q.
(Num r, Ord r) =>
(Point 2 r :+ qc)
-> (Point 2 r :+ p) -> (Point 2 r :+ q) -> Ordering
ccwCmpAround' Point 2 r :+ q
c ((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. Semigroup a => a -> a -> a
<> (Point 2 r :+ q)
-> (Point 2 r :+ p) -> (Point 2 r :+ p) -> Ordering
forall r (d :: Nat) c p q.
(Ord r, Num r, Arity d) =>
(Point d r :+ c)
-> (Point d r :+ p) -> (Point d r :+ q) -> Ordering
cmpByDistanceTo' Point 2 r :+ q
c)