--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Point.Orientation.Degenerate
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- orientation tests, allowing for degeneracies
--
--------------------------------------------------------------------------------
module HGeometry.Point.Orientation.Degenerate(
    CCW(CCW,CW,CoLinear)
  , ccw
  , isCoLinear

  , sortAround

  , ccwCmpAroundWith
  , cwCmpAroundWith
  , ccwCmpAround
  , cwCmpAround

  , insertIntoCyclicOrder
  ) where

import           Control.Lens ((^.))
import qualified Data.CircularList as C
import qualified Data.List as L
import qualified HGeometry.CircularList.Util as CU
import           HGeometry.Point.Class
import           HGeometry.Point.EuclideanDistance
import           HGeometry.Vector

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

-- $setup
-- >>> import HGeometry.Point

-- | 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
$c== :: CCW -> CCW -> Bool
== :: CCW -> CCW -> Bool
$c/= :: CCW -> CCW -> Bool
/= :: CCW -> CCW -> Bool
Eq

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

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

-- | CoLinear orientation. Also called a straight line.
pattern CoLinear :: CCW
pattern $bCoLinear :: CCW
$mCoLinear :: forall {r}. CCW -> ((# #) -> r) -> ((# #) -> 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 wary 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
--
ccw       :: (Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r, Ord r)
          => point -> point' -> point'' -> CCW
ccw :: forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw point
p point'
q point''
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)
     where
       Vector2 r
ux r
uy = (point'
qpoint' -> Getting (Vector 2 r) point' (Vector 2 r) -> Vector 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Vector 2 r) point' (Vector 2 r)
forall (d :: Nat) r s.
(Dimension point' ~ d, NumType point' ~ r, Dimension point' ~ d,
 NumType point' ~ s) =>
Lens point' point' (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point' point' (Vector 2 r) (Vector 2 r)
vector) Vector 2 r -> Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
^-^ Vector 2 r
pv
       Vector2 r
vx r
vy = (point''
rpoint'' -> Getting (Vector 2 r) point'' (Vector 2 r) -> Vector 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Vector 2 r) point'' (Vector 2 r)
forall (d :: Nat) r s.
(Dimension point'' ~ d, NumType point'' ~ r, Dimension point'' ~ d,
 NumType point'' ~ s) =>
Lens point'' point'' (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point'' point'' (Vector 2 r) (Vector 2 r)
vector) Vector 2 r -> Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
^-^ Vector 2 r
pv
       pv :: Vector 2 r
pv = point
ppoint -> Getting (Vector 2 r) point (Vector 2 r) -> Vector 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Vector 2 r) point (Vector 2 r)
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point point (Vector 2 r) (Vector 2 r)
vector
{-# INLINE ccw #-}

-- | 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       :: (Point_ point 2 r, Num r, Eq r) => point -> point -> point -> Bool
isCoLinear :: forall point r.
(Point_ point 2 r, Num r, Eq r) =>
point -> point -> point -> Bool
isCoLinear point
p point
q point
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
q point -> point -> Vector 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
.-. point
p
       Vector2 r
vx r
vy = point
r point -> point -> Vector 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
.-. point
p
{-# INLINE isCoLinear #-}

-- -- 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' = ccw -- p q r = ccw (p^.core) (q^.core) (r^.core)

-- | 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.
--
-- \( O(n log n) \)
sortAround   :: (Point_ center 2 r, Point_ point 2 r, Num r, Ord r)
             => center -> [point] -> [point]
sortAround :: forall center r point.
(Point_ center 2 r, Point_ point 2 r, Num r, Ord r) =>
center -> [point] -> [point]
sortAround center
c = (point -> point -> Ordering) -> [point] -> [point]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (center -> point -> point -> Ordering
forall center r point.
(Point_ center 2 r, Point_ point 2 r, Ord r, Num r) =>
center -> point -> point -> Ordering
ccwCmpAround center
c (point -> point -> Ordering)
-> (point -> point -> Ordering) -> point -> point -> Ordering
forall a. Semigroup a => a -> a -> a
<> center -> point -> point -> Ordering
forall r point (d :: Nat) center.
(Ord r, Num r, Point_ point d r, Point_ center d r,
 Metric_ (Vector d r) d r) =>
center -> point -> point -> Ordering
cmpByDistanceTo center
c)
{-# INLINE sortAround #-}

-- | 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                              :: ( Point_ center 2 r
                                                 , Point_ point 2 r
                                                 , Ord r, Num r
                                                 )
                                              => Vector 2 r
                                              -> center
                                              -> point -> point
                                              -> Ordering
ccwCmpAroundWith :: forall center r point.
(Point_ center 2 r, Point_ point 2 r, Ord r, Num r) =>
Vector 2 r -> center -> point -> point -> Ordering
ccwCmpAroundWith z :: Vector 2 r
z@(Vector2 r
zx r
zy) center
c point
q point
r =
    case (center -> center -> point -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw center
c center
a point
q, center -> center -> point -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw center
c center
a point
r) of
      (CCW
CCW,CCW
CCW)      -> Ordering
cmp
      (CCW
CCW,CCW
CW)       -> Ordering
LT
      (CCW
CCW,CCW
CoLinear) | point -> Bool
onZero point
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 -> Bool
onZero point
q  -> Ordering
LT
                      | Bool
otherwise -> Ordering
GT

      (CCW
CoLinear, CCW
CW)      -> Ordering
LT
      (CCW
CoLinear,CCW
CoLinear) -> case (point -> Bool
onZero point
q, point -> Bool
onZero point
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 :: center
a = center
c center -> Vector 2 r -> center
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ Vector 2 r
z
    b :: center
b = center
c center -> Vector 2 r -> center
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ 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 -> Bool
onZero point
d = case center -> center -> point -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw center
c center
b point
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 center -> point -> point -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw center
c point
q point
r of
            CCW
CCW      -> Ordering
LT
            CCW
CW       -> Ordering
GT
            CCW
CoLinear -> Ordering
EQ
{-# INLINABLE ccwCmpAroundWith #-}

-- | 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     :: ( Point_ center 2 r, Point_ point 2 r
                       , Ord r, Num r
                       )
                    => Vector 2 r
                    -> center
                    -> point -> point
                    -> Ordering
cwCmpAroundWith :: forall center r point.
(Point_ center 2 r, Point_ point 2 r, Ord r, Num r) =>
Vector 2 r -> center -> point -> point -> Ordering
cwCmpAroundWith z :: Vector 2 r
z@(Vector2 r
zx r
zy) center
c point
q point
r =
    case (center -> center -> point -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw center
c center
a point
q, center -> center -> point -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw center
c center
a point
r) of
      (CCW
CCW,CCW
CCW)      -> Ordering
cmp
      (CCW
CCW,CCW
CW)       -> Ordering
GT
      (CCW
CCW,CCW
CoLinear) -> Ordering
GT

      (CCW
CW, CCW
CCW)      -> Ordering
LT   ---
      (CCW
CW, CCW
CW)       -> Ordering
cmp
      (CCW
CW, CCW
CoLinear) | point -> Bool
onZero point
r  -> Ordering
GT
                     | Bool
otherwise -> Ordering
LT

      (CCW
CoLinear, CCW
CW) | point -> Bool
onZero point
q  -> Ordering
LT --
                     | Bool
otherwise -> Ordering
GT --

      (CCW
CoLinear, CCW
CCW)     -> Ordering
LT
      (CCW
CoLinear,CCW
CoLinear) -> case (point -> Bool
onZero point
q, point -> Bool
onZero point
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 :: center
a = center
c center -> Vector 2 r -> center
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ Vector 2 r
z
    b :: center
b = center
c center -> Vector 2 r -> center
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ 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 -> Bool
onZero point
d = case center -> center -> point -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw center
c center
b point
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 center -> point -> point -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw center
c point
q point
r of
            CCW
CCW      -> Ordering
GT --
            CCW
CW       -> Ordering
LT --
            CCW
CoLinear -> Ordering
EQ
{-# INLINE cwCmpAroundWith #-}
--   flip (ccwCmpAroundWith z c)

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

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

-- | \( 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   :: (Point_ center 2 r, Point_ point 2 r, Ord r, Num r)
                        => center -> point
                        -> C.CList point -> C.CList point
insertIntoCyclicOrder :: forall center r point.
(Point_ center 2 r, Point_ point 2 r, Ord r, Num r) =>
center -> point -> CList point -> CList point
insertIntoCyclicOrder center
c = (point -> point -> Ordering) -> point -> CList point -> CList point
forall a. (a -> a -> Ordering) -> a -> CList a -> CList a
CU.insertOrdBy (center -> point -> point -> Ordering
forall center r point.
(Point_ center 2 r, Point_ point 2 r, Ord r, Num r) =>
center -> point -> point -> Ordering
ccwCmpAround center
c (point -> point -> Ordering)
-> (point -> point -> Ordering) -> point -> point -> Ordering
forall a. Semigroup a => a -> a -> a
<> center -> point -> point -> Ordering
forall r point (d :: Nat) center.
(Ord r, Num r, Point_ point d r, Point_ center d r,
 Metric_ (Vector d r) d r) =>
center -> point -> point -> Ordering
cmpByDistanceTo center
c)
{-# INLINE insertIntoCyclicOrder #-}