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

import           Control.Lens
import           HGeometry.Point.Class
import qualified Data.List as L

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

-- | 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
$cshowsPrec :: Int -> Quadrant -> ShowS
showsPrec :: Int -> Quadrant -> ShowS
$cshow :: Quadrant -> String
show :: Quadrant -> String
$cshowList :: [Quadrant] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS Quadrant
readsPrec :: Int -> ReadS Quadrant
$creadList :: ReadS [Quadrant]
readList :: ReadS [Quadrant]
$creadPrec :: ReadPrec Quadrant
readPrec :: ReadPrec Quadrant
$creadListPrec :: ReadPrec [Quadrant]
readListPrec :: ReadPrec [Quadrant]
Read,Quadrant -> Quadrant -> Bool
(Quadrant -> Quadrant -> Bool)
-> (Quadrant -> Quadrant -> Bool) -> Eq Quadrant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Quadrant -> Quadrant -> Bool
== :: Quadrant -> Quadrant -> Bool
$c/= :: Quadrant -> Quadrant -> Bool
/= :: 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
$ccompare :: Quadrant -> Quadrant -> Ordering
compare :: Quadrant -> Quadrant -> Ordering
$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
>= :: Quadrant -> Quadrant -> Bool
$cmax :: Quadrant -> Quadrant -> Quadrant
max :: Quadrant -> Quadrant -> Quadrant
$cmin :: Quadrant -> Quadrant -> Quadrant
min :: Quadrant -> Quadrant -> 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
$csucc :: Quadrant -> Quadrant
succ :: Quadrant -> Quadrant
$cpred :: Quadrant -> Quadrant
pred :: Quadrant -> Quadrant
$ctoEnum :: Int -> Quadrant
toEnum :: Int -> Quadrant
$cfromEnum :: Quadrant -> Int
fromEnum :: Quadrant -> Int
$cenumFrom :: Quadrant -> [Quadrant]
enumFrom :: Quadrant -> [Quadrant]
$cenumFromThen :: Quadrant -> Quadrant -> [Quadrant]
enumFromThen :: Quadrant -> Quadrant -> [Quadrant]
$cenumFromTo :: Quadrant -> Quadrant -> [Quadrant]
enumFromTo :: Quadrant -> Quadrant -> [Quadrant]
$cenumFromThenTo :: Quadrant -> Quadrant -> Quadrant -> [Quadrant]
enumFromThenTo :: Quadrant -> Quadrant -> Quadrant -> [Quadrant]
Enum,Quadrant
Quadrant -> Quadrant -> Bounded Quadrant
forall a. a -> a -> Bounded a
$cminBound :: Quadrant
minBound :: Quadrant
$cmaxBound :: Quadrant
maxBound :: 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, Point_ point 2 r)
                 => point -> point -> Quadrant
quadrantWith :: forall r point.
(Ord r, Point_ point 2 r) =>
point -> point -> Quadrant
quadrantWith point
c point
p = case ( (point
cpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Natural) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Natural) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord)
                        , (point
cpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Natural) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord) r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Natural) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point 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, ConstructablePoint_ point 2 r) => point -> Quadrant
quadrant :: forall r point.
(Ord r, Num r, ConstructablePoint_ point 2 r) =>
point -> Quadrant
quadrant = point -> point -> Quadrant
forall r point.
(Ord r, Point_ point 2 r) =>
point -> point -> Quadrant
quadrantWith point
forall point (d :: Natural) r.
(Num r, ConstructablePoint_ point d r) =>
point
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, Point_ point 2 r)
                             => point
                             -> [point]
                             -> ( [point], [point]
                                , [point], [point]
                                )
partitionIntoQuadrants :: forall r point.
(Ord r, Point_ point 2 r) =>
point -> [point] -> ([point], [point], [point], [point])
partitionIntoQuadrants point
c [point]
pts = ([point]
topL, [point]
topR, [point]
bottomL, [point]
bottomR)
  where
    ([point]
below',[point]
above')   = (point -> Bool) -> [point] -> ([point], [point])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (Getting r point r -> point -> Bool
on Getting r point r
forall (d :: Natural) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord) [point]
pts
    ([point]
bottomL,[point]
bottomR) = (point -> Bool) -> [point] -> ([point], [point])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (Getting r point r -> point -> Bool
on Getting r point r
forall (d :: Natural) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) [point]
below'
    ([point]
topL,[point]
topR)       = (point -> Bool) -> [point] -> ([point], [point])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (Getting r point r -> point -> Bool
on Getting r point r
forall (d :: Natural) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) [point]
above'

    on :: Getting r point r -> point -> Bool
on Getting r point r
l point
q       = point
qpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
l r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< point
cpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
l