--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.Point.Quadrants
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Data.Geometry.Point.Quadrants where

import           Control.Lens
import           Data.Ext
import           Data.Geometry.Point.Class
import           Data.Geometry.Point.Internal
import           Data.Geometry.Vector
import qualified Data.List as L
import           GHC.TypeLits

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

-- | Quadrants of two dimensional points. in CCW order
data Quadrant = TopRight | TopLeft | BottomLeft | BottomRight
              deriving (Int -> Quadrant -> ShowS
[Quadrant] -> ShowS
Quadrant -> String
(Int -> Quadrant -> ShowS)
-> (Quadrant -> String) -> ([Quadrant] -> ShowS) -> Show Quadrant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Quadrant] -> ShowS
$cshowList :: [Quadrant] -> ShowS
show :: Quadrant -> String
$cshow :: Quadrant -> String
showsPrec :: Int -> Quadrant -> ShowS
$cshowsPrec :: Int -> Quadrant -> ShowS
Show,ReadPrec [Quadrant]
ReadPrec Quadrant
Int -> ReadS Quadrant
ReadS [Quadrant]
(Int -> ReadS Quadrant)
-> ReadS [Quadrant]
-> ReadPrec Quadrant
-> ReadPrec [Quadrant]
-> Read Quadrant
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Quadrant]
$creadListPrec :: ReadPrec [Quadrant]
readPrec :: ReadPrec Quadrant
$creadPrec :: ReadPrec Quadrant
readList :: ReadS [Quadrant]
$creadList :: ReadS [Quadrant]
readsPrec :: Int -> ReadS Quadrant
$creadsPrec :: Int -> ReadS Quadrant
Read,Quadrant -> Quadrant -> Bool
(Quadrant -> Quadrant -> Bool)
-> (Quadrant -> Quadrant -> Bool) -> Eq Quadrant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Quadrant -> Quadrant -> Bool
$c/= :: Quadrant -> Quadrant -> Bool
== :: Quadrant -> Quadrant -> Bool
$c== :: Quadrant -> Quadrant -> Bool
Eq,Eq Quadrant
Eq Quadrant
-> (Quadrant -> Quadrant -> Ordering)
-> (Quadrant -> Quadrant -> Bool)
-> (Quadrant -> Quadrant -> Bool)
-> (Quadrant -> Quadrant -> Bool)
-> (Quadrant -> Quadrant -> Bool)
-> (Quadrant -> Quadrant -> Quadrant)
-> (Quadrant -> Quadrant -> Quadrant)
-> Ord Quadrant
Quadrant -> Quadrant -> Bool
Quadrant -> Quadrant -> Ordering
Quadrant -> Quadrant -> Quadrant
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Quadrant -> Quadrant -> Quadrant
$cmin :: Quadrant -> Quadrant -> Quadrant
max :: Quadrant -> Quadrant -> Quadrant
$cmax :: Quadrant -> Quadrant -> Quadrant
>= :: Quadrant -> Quadrant -> Bool
$c>= :: Quadrant -> Quadrant -> Bool
> :: Quadrant -> Quadrant -> Bool
$c> :: Quadrant -> Quadrant -> Bool
<= :: Quadrant -> Quadrant -> Bool
$c<= :: Quadrant -> Quadrant -> Bool
< :: Quadrant -> Quadrant -> Bool
$c< :: Quadrant -> Quadrant -> Bool
compare :: Quadrant -> Quadrant -> Ordering
$ccompare :: Quadrant -> Quadrant -> Ordering
$cp1Ord :: Eq Quadrant
Ord,Int -> Quadrant
Quadrant -> Int
Quadrant -> [Quadrant]
Quadrant -> Quadrant
Quadrant -> Quadrant -> [Quadrant]
Quadrant -> Quadrant -> Quadrant -> [Quadrant]
(Quadrant -> Quadrant)
-> (Quadrant -> Quadrant)
-> (Int -> Quadrant)
-> (Quadrant -> Int)
-> (Quadrant -> [Quadrant])
-> (Quadrant -> Quadrant -> [Quadrant])
-> (Quadrant -> Quadrant -> [Quadrant])
-> (Quadrant -> Quadrant -> Quadrant -> [Quadrant])
-> Enum Quadrant
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Quadrant -> Quadrant -> Quadrant -> [Quadrant]
$cenumFromThenTo :: Quadrant -> Quadrant -> Quadrant -> [Quadrant]
enumFromTo :: Quadrant -> Quadrant -> [Quadrant]
$cenumFromTo :: Quadrant -> Quadrant -> [Quadrant]
enumFromThen :: Quadrant -> Quadrant -> [Quadrant]
$cenumFromThen :: Quadrant -> Quadrant -> [Quadrant]
enumFrom :: Quadrant -> [Quadrant]
$cenumFrom :: Quadrant -> [Quadrant]
fromEnum :: Quadrant -> Int
$cfromEnum :: Quadrant -> Int
toEnum :: Int -> Quadrant
$ctoEnum :: Int -> Quadrant
pred :: Quadrant -> Quadrant
$cpred :: Quadrant -> Quadrant
succ :: Quadrant -> Quadrant
$csucc :: Quadrant -> Quadrant
Enum,Quadrant
Quadrant -> Quadrant -> Bounded Quadrant
forall a. a -> a -> Bounded a
maxBound :: Quadrant
$cmaxBound :: Quadrant
minBound :: Quadrant
$cminBound :: Quadrant
Bounded)

-- | Quadrants around point c; quadrants are closed on their "previous"
-- boundary (i..e the boundary with the previous quadrant in the CCW order),
-- open on next boundary. The origin itself is assigned the topRight quadrant
quadrantWith                   :: (Ord r, 1 <= d, 2 <= d, Arity d)
                               => Point d r :+ q -> Point d r :+ p -> Quadrant
quadrantWith :: (Point d r :+ q) -> (Point d r :+ p) -> Quadrant
quadrantWith (Point d r
c :+ q
_) (Point d r
p :+ p
_) = case ( (Point d r
cPoint d r -> Getting r (Point d r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Point d r) r
forall (d :: Nat) (point :: Nat -> * -> *) r.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord) r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Point d r
pPoint d r -> Getting r (Point d r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Point d r) r
forall (d :: Nat) (point :: Nat -> * -> *) r.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord)
                                      , (Point d r
cPoint d r -> Getting r (Point d r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Point d r) r
forall (d :: Nat) (point :: Nat -> * -> *) r.
(2 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
yCoord) r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Point d r
pPoint d r -> Getting r (Point d r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Point d r) r
forall (d :: Nat) (point :: Nat -> * -> *) r.
(2 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
yCoord) ) of
                                   (Ordering
EQ, Ordering
EQ) -> Quadrant
TopRight
                                   (Ordering
LT, Ordering
EQ) -> Quadrant
TopRight
                                   (Ordering
LT, Ordering
LT) -> Quadrant
TopRight
                                   (Ordering
EQ, Ordering
LT) -> Quadrant
TopLeft
                                   (Ordering
GT, Ordering
LT) -> Quadrant
TopLeft
                                   (Ordering
GT, Ordering
EQ) -> Quadrant
BottomLeft
                                   (Ordering
GT, Ordering
GT) -> Quadrant
BottomLeft
                                   (Ordering
EQ, Ordering
GT) -> Quadrant
BottomRight
                                   (Ordering
LT, Ordering
GT) -> Quadrant
BottomRight

-- | Quadrants with respect to the origin
quadrant :: (Ord r, Num r, 1 <= d, 2 <= d, Arity d) => Point d r :+ p -> Quadrant
quadrant :: (Point d r :+ p) -> Quadrant
quadrant = (Point d r :+ ()) -> (Point d r :+ p) -> Quadrant
forall r (d :: Nat) q p.
(Ord r, 1 <= d, 2 <= d, Arity d) =>
(Point d r :+ q) -> (Point d r :+ p) -> Quadrant
quadrantWith (Point d r -> Point d r :+ ()
forall a. a -> a :+ ()
ext Point d r
forall (d :: Nat) r. (Arity d, Num r) => Point d r
origin)

-- | Given a center point c, and a set of points, partition the points into
-- quadrants around c (based on their x and y coordinates). The quadrants are
-- reported in the order topLeft, topRight, bottomLeft, bottomRight. The points
-- are in the same order as they were in the original input lists.
-- Points with the same x-or y coordinate as p, are "rounded" to above.
partitionIntoQuadrants       :: (Ord r, 1 <= d, 2 <= d, Arity d)
                             => Point d r :+ q
                             -> [Point d r :+ p]
                             -> ( [Point d r :+ p], [Point d r :+ p]
                                , [Point d r :+ p], [Point d r :+ p]
                                )
partitionIntoQuadrants :: (Point d r :+ q)
-> [Point d r :+ p]
-> ([Point d r :+ p], [Point d r :+ p], [Point d r :+ p],
    [Point d r :+ p])
partitionIntoQuadrants Point d r :+ q
c [Point d r :+ p]
pts = ([Point d r :+ p]
topL, [Point d r :+ p]
topR, [Point d r :+ p]
bottomL, [Point d r :+ p]
bottomR)
  where
    ([Point d r :+ p]
below',[Point d r :+ p]
above')   = ((Point d r :+ p) -> Bool)
-> [Point d r :+ p] -> ([Point d r :+ p], [Point d r :+ p])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (((r -> Const r r) -> Point d r -> Const r (Point d r))
-> (Point d r :+ p) -> Bool
on (r -> Const r r) -> Point d r -> Const r (Point d r)
forall (d :: Nat) (point :: Nat -> * -> *) r.
(2 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
yCoord) [Point d r :+ p]
pts
    ([Point d r :+ p]
bottomL,[Point d r :+ p]
bottomR) = ((Point d r :+ p) -> Bool)
-> [Point d r :+ p] -> ([Point d r :+ p], [Point d r :+ p])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (((r -> Const r r) -> Point d r -> Const r (Point d r))
-> (Point d r :+ p) -> Bool
on (r -> Const r r) -> Point d r -> Const r (Point d r)
forall (d :: Nat) (point :: Nat -> * -> *) r.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord) [Point d r :+ p]
below'
    ([Point d r :+ p]
topL,[Point d r :+ p]
topR)       = ((Point d r :+ p) -> Bool)
-> [Point d r :+ p] -> ([Point d r :+ p], [Point d r :+ p])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (((r -> Const r r) -> Point d r -> Const r (Point d r))
-> (Point d r :+ p) -> Bool
on (r -> Const r r) -> Point d r -> Const r (Point d r)
forall (d :: Nat) (point :: Nat -> * -> *) r.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord) [Point d r :+ p]
above'

    on :: ((r -> Const r r) -> Point d r -> Const r (Point d r))
-> (Point d r :+ p) -> Bool
on (r -> Const r r) -> Point d r -> Const r (Point d r)
l Point d r :+ p
q       = Point d r :+ p
q(Point d r :+ p) -> Getting r (Point d r :+ p) r -> r
forall s a. s -> Getting a s a -> a
^.(Point d r -> Const r (Point d r))
-> (Point d r :+ p) -> Const r (Point d r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((Point d r -> Const r (Point d r))
 -> (Point d r :+ p) -> Const r (Point d r :+ p))
-> ((r -> Const r r) -> Point d r -> Const r (Point d r))
-> Getting r (Point d r :+ p) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> Point d r -> Const r (Point d r)
l r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< Point d r :+ q
c(Point d r :+ q) -> Getting r (Point d r :+ q) r -> r
forall s a. s -> Getting a s a -> a
^.(Point d r -> Const r (Point d r))
-> (Point d r :+ q) -> Const r (Point d r :+ q)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((Point d r -> Const r (Point d r))
 -> (Point d r :+ q) -> Const r (Point d r :+ q))
-> ((r -> Const r r) -> Point d r -> Const r (Point d r))
-> Getting r (Point d r :+ q) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> Point d r -> Const r (Point d r)
l