{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.QuadTree
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Data.Geometry.QuadTree-- ( module Data.Geometry.QuadTree.Cell
                             -- , module Data.Geometry.QuadTree.Quadrants
                             -- , module Data.Geometry.QuadTree.Split
                             -- , QuadTree(..)
                             -- , leaves
                             -- , withCells
                             -- )
                             where


import           Control.Lens (makeLenses, (^.), (.~), (&), (^?!), ix, view)
import           Data.Ext
import qualified Data.Foldable as F
import           Data.Geometry.Box
import           Data.Geometry.Point
import           Data.Geometry.QuadTree.Cell
import           Data.Geometry.QuadTree.Quadrants
import           Data.Geometry.QuadTree.Split
import           Data.Geometry.QuadTree.Tree (Tree(..))
import qualified Data.Geometry.QuadTree.Tree as Tree
import           Data.Geometry.Vector
import           Data.Intersection
import           Data.List.NonEmpty (NonEmpty(..))
import           Data.Tree.Util (TreeNode(..), levels)
import           GHC.Generics (Generic)
--------------------------------------------------------------------------------

-- | QuadTree on the starting cell
data QuadTree v p r = QuadTree { QuadTree v p r -> Cell r
_startingCell  :: !(Cell r)
                               , QuadTree v p r -> Tree v p
_tree          :: !(Tree v p)
                               }
                    deriving (Int -> QuadTree v p r -> ShowS
[QuadTree v p r] -> ShowS
QuadTree v p r -> String
(Int -> QuadTree v p r -> ShowS)
-> (QuadTree v p r -> String)
-> ([QuadTree v p r] -> ShowS)
-> Show (QuadTree v p r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v p r.
(Show r, Show p, Show v) =>
Int -> QuadTree v p r -> ShowS
forall v p r. (Show r, Show p, Show v) => [QuadTree v p r] -> ShowS
forall v p r. (Show r, Show p, Show v) => QuadTree v p r -> String
showList :: [QuadTree v p r] -> ShowS
$cshowList :: forall v p r. (Show r, Show p, Show v) => [QuadTree v p r] -> ShowS
show :: QuadTree v p r -> String
$cshow :: forall v p r. (Show r, Show p, Show v) => QuadTree v p r -> String
showsPrec :: Int -> QuadTree v p r -> ShowS
$cshowsPrec :: forall v p r.
(Show r, Show p, Show v) =>
Int -> QuadTree v p r -> ShowS
Show,QuadTree v p r -> QuadTree v p r -> Bool
(QuadTree v p r -> QuadTree v p r -> Bool)
-> (QuadTree v p r -> QuadTree v p r -> Bool)
-> Eq (QuadTree v p r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v p r.
(Eq r, Eq p, Eq v) =>
QuadTree v p r -> QuadTree v p r -> Bool
/= :: QuadTree v p r -> QuadTree v p r -> Bool
$c/= :: forall v p r.
(Eq r, Eq p, Eq v) =>
QuadTree v p r -> QuadTree v p r -> Bool
== :: QuadTree v p r -> QuadTree v p r -> Bool
$c== :: forall v p r.
(Eq r, Eq p, Eq v) =>
QuadTree v p r -> QuadTree v p r -> Bool
Eq,(forall x. QuadTree v p r -> Rep (QuadTree v p r) x)
-> (forall x. Rep (QuadTree v p r) x -> QuadTree v p r)
-> Generic (QuadTree v p r)
forall x. Rep (QuadTree v p r) x -> QuadTree v p r
forall x. QuadTree v p r -> Rep (QuadTree v p r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v p r x. Rep (QuadTree v p r) x -> QuadTree v p r
forall v p r x. QuadTree v p r -> Rep (QuadTree v p r) x
$cto :: forall v p r x. Rep (QuadTree v p r) x -> QuadTree v p r
$cfrom :: forall v p r x. QuadTree v p r -> Rep (QuadTree v p r) x
Generic,a -> QuadTree v p b -> QuadTree v p a
(a -> b) -> QuadTree v p a -> QuadTree v p b
(forall a b. (a -> b) -> QuadTree v p a -> QuadTree v p b)
-> (forall a b. a -> QuadTree v p b -> QuadTree v p a)
-> Functor (QuadTree v p)
forall a b. a -> QuadTree v p b -> QuadTree v p a
forall a b. (a -> b) -> QuadTree v p a -> QuadTree v p b
forall v p a b. a -> QuadTree v p b -> QuadTree v p a
forall v p a b. (a -> b) -> QuadTree v p a -> QuadTree v p b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> QuadTree v p b -> QuadTree v p a
$c<$ :: forall v p a b. a -> QuadTree v p b -> QuadTree v p a
fmap :: (a -> b) -> QuadTree v p a -> QuadTree v p b
$cfmap :: forall v p a b. (a -> b) -> QuadTree v p a -> QuadTree v p b
Functor,QuadTree v p a -> Bool
(a -> m) -> QuadTree v p a -> m
(a -> b -> b) -> b -> QuadTree v p a -> b
(forall m. Monoid m => QuadTree v p m -> m)
-> (forall m a. Monoid m => (a -> m) -> QuadTree v p a -> m)
-> (forall m a. Monoid m => (a -> m) -> QuadTree v p a -> m)
-> (forall a b. (a -> b -> b) -> b -> QuadTree v p a -> b)
-> (forall a b. (a -> b -> b) -> b -> QuadTree v p a -> b)
-> (forall b a. (b -> a -> b) -> b -> QuadTree v p a -> b)
-> (forall b a. (b -> a -> b) -> b -> QuadTree v p a -> b)
-> (forall a. (a -> a -> a) -> QuadTree v p a -> a)
-> (forall a. (a -> a -> a) -> QuadTree v p a -> a)
-> (forall a. QuadTree v p a -> [a])
-> (forall a. QuadTree v p a -> Bool)
-> (forall a. QuadTree v p a -> Int)
-> (forall a. Eq a => a -> QuadTree v p a -> Bool)
-> (forall a. Ord a => QuadTree v p a -> a)
-> (forall a. Ord a => QuadTree v p a -> a)
-> (forall a. Num a => QuadTree v p a -> a)
-> (forall a. Num a => QuadTree v p a -> a)
-> Foldable (QuadTree v p)
forall a. Eq a => a -> QuadTree v p a -> Bool
forall a. Num a => QuadTree v p a -> a
forall a. Ord a => QuadTree v p a -> a
forall m. Monoid m => QuadTree v p m -> m
forall a. QuadTree v p a -> Bool
forall a. QuadTree v p a -> Int
forall a. QuadTree v p a -> [a]
forall a. (a -> a -> a) -> QuadTree v p a -> a
forall m a. Monoid m => (a -> m) -> QuadTree v p a -> m
forall b a. (b -> a -> b) -> b -> QuadTree v p a -> b
forall a b. (a -> b -> b) -> b -> QuadTree v p a -> b
forall v p a. Eq a => a -> QuadTree v p a -> Bool
forall v p a. Num a => QuadTree v p a -> a
forall v p a. Ord a => QuadTree v p a -> a
forall v p m. Monoid m => QuadTree v p m -> m
forall v p a. QuadTree v p a -> Bool
forall v p a. QuadTree v p a -> Int
forall v p a. QuadTree v p a -> [a]
forall v p a. (a -> a -> a) -> QuadTree v p a -> a
forall v p m a. Monoid m => (a -> m) -> QuadTree v p a -> m
forall v p b a. (b -> a -> b) -> b -> QuadTree v p a -> b
forall v p a b. (a -> b -> b) -> b -> QuadTree v p a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: QuadTree v p a -> a
$cproduct :: forall v p a. Num a => QuadTree v p a -> a
sum :: QuadTree v p a -> a
$csum :: forall v p a. Num a => QuadTree v p a -> a
minimum :: QuadTree v p a -> a
$cminimum :: forall v p a. Ord a => QuadTree v p a -> a
maximum :: QuadTree v p a -> a
$cmaximum :: forall v p a. Ord a => QuadTree v p a -> a
elem :: a -> QuadTree v p a -> Bool
$celem :: forall v p a. Eq a => a -> QuadTree v p a -> Bool
length :: QuadTree v p a -> Int
$clength :: forall v p a. QuadTree v p a -> Int
null :: QuadTree v p a -> Bool
$cnull :: forall v p a. QuadTree v p a -> Bool
toList :: QuadTree v p a -> [a]
$ctoList :: forall v p a. QuadTree v p a -> [a]
foldl1 :: (a -> a -> a) -> QuadTree v p a -> a
$cfoldl1 :: forall v p a. (a -> a -> a) -> QuadTree v p a -> a
foldr1 :: (a -> a -> a) -> QuadTree v p a -> a
$cfoldr1 :: forall v p a. (a -> a -> a) -> QuadTree v p a -> a
foldl' :: (b -> a -> b) -> b -> QuadTree v p a -> b
$cfoldl' :: forall v p b a. (b -> a -> b) -> b -> QuadTree v p a -> b
foldl :: (b -> a -> b) -> b -> QuadTree v p a -> b
$cfoldl :: forall v p b a. (b -> a -> b) -> b -> QuadTree v p a -> b
foldr' :: (a -> b -> b) -> b -> QuadTree v p a -> b
$cfoldr' :: forall v p a b. (a -> b -> b) -> b -> QuadTree v p a -> b
foldr :: (a -> b -> b) -> b -> QuadTree v p a -> b
$cfoldr :: forall v p a b. (a -> b -> b) -> b -> QuadTree v p a -> b
foldMap' :: (a -> m) -> QuadTree v p a -> m
$cfoldMap' :: forall v p m a. Monoid m => (a -> m) -> QuadTree v p a -> m
foldMap :: (a -> m) -> QuadTree v p a -> m
$cfoldMap :: forall v p m a. Monoid m => (a -> m) -> QuadTree v p a -> m
fold :: QuadTree v p m -> m
$cfold :: forall v p m. Monoid m => QuadTree v p m -> m
Foldable,Functor (QuadTree v p)
Foldable (QuadTree v p)
Functor (QuadTree v p)
-> Foldable (QuadTree v p)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> QuadTree v p a -> f (QuadTree v p b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    QuadTree v p (f a) -> f (QuadTree v p a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> QuadTree v p a -> m (QuadTree v p b))
-> (forall (m :: * -> *) a.
    Monad m =>
    QuadTree v p (m a) -> m (QuadTree v p a))
-> Traversable (QuadTree v p)
(a -> f b) -> QuadTree v p a -> f (QuadTree v p b)
forall v p. Functor (QuadTree v p)
forall v p. Foldable (QuadTree v p)
forall v p (m :: * -> *) a.
Monad m =>
QuadTree v p (m a) -> m (QuadTree v p a)
forall v p (f :: * -> *) a.
Applicative f =>
QuadTree v p (f a) -> f (QuadTree v p a)
forall v p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> QuadTree v p a -> m (QuadTree v p b)
forall v p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QuadTree v p a -> f (QuadTree v p b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
QuadTree v p (m a) -> m (QuadTree v p a)
forall (f :: * -> *) a.
Applicative f =>
QuadTree v p (f a) -> f (QuadTree v p a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> QuadTree v p a -> m (QuadTree v p b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QuadTree v p a -> f (QuadTree v p b)
sequence :: QuadTree v p (m a) -> m (QuadTree v p a)
$csequence :: forall v p (m :: * -> *) a.
Monad m =>
QuadTree v p (m a) -> m (QuadTree v p a)
mapM :: (a -> m b) -> QuadTree v p a -> m (QuadTree v p b)
$cmapM :: forall v p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> QuadTree v p a -> m (QuadTree v p b)
sequenceA :: QuadTree v p (f a) -> f (QuadTree v p a)
$csequenceA :: forall v p (f :: * -> *) a.
Applicative f =>
QuadTree v p (f a) -> f (QuadTree v p a)
traverse :: (a -> f b) -> QuadTree v p a -> f (QuadTree v p b)
$ctraverse :: forall v p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QuadTree v p a -> f (QuadTree v p b)
$cp2Traversable :: forall v p. Foldable (QuadTree v p)
$cp1Traversable :: forall v p. Functor (QuadTree v p)
Traversable)
makeLenses ''QuadTree

--------------------------------------------------------------------------------
-- * Functions operating on the QuadTree (in terms of the 'Tree' type)

withCells    :: (Fractional r, Ord r) => QuadTree v p r -> QuadTree (v :+ Cell r) (p :+ Cell r) r
withCells :: QuadTree v p r -> QuadTree (v :+ Cell r) (p :+ Cell r) r
withCells QuadTree v p r
qt = QuadTree v p r
qtQuadTree v p r
-> (QuadTree v p r -> QuadTree (v :+ Cell r) (p :+ Cell r) r)
-> QuadTree (v :+ Cell r) (p :+ Cell r) r
forall a b. a -> (a -> b) -> b
&(Tree v p -> Identity (Tree (v :+ Cell r) (p :+ Cell r)))
-> QuadTree v p r
-> Identity (QuadTree (v :+ Cell r) (p :+ Cell r) r)
forall v p r v p.
Lens (QuadTree v p r) (QuadTree v p r) (Tree v p) (Tree v p)
tree ((Tree v p -> Identity (Tree (v :+ Cell r) (p :+ Cell r)))
 -> QuadTree v p r
 -> Identity (QuadTree (v :+ Cell r) (p :+ Cell r) r))
-> Tree (v :+ Cell r) (p :+ Cell r)
-> QuadTree v p r
-> QuadTree (v :+ Cell r) (p :+ Cell r) r
forall s t a b. ASetter s t a b -> b -> s -> t
.~ QuadTree v p r -> Tree (v :+ Cell r) (p :+ Cell r)
forall r v p.
(Fractional r, Ord r) =>
QuadTree v p r -> Tree (v :+ Cell r) (p :+ Cell r)
withCellsTree QuadTree v p r
qt

withCellsTree                :: (Fractional r, Ord r)
                             => QuadTree v p r -> Tree (v :+ Cell r) (p :+ Cell r)
withCellsTree :: QuadTree v p r -> Tree (v :+ Cell r) (p :+ Cell r)
withCellsTree (QuadTree Cell r
c Tree v p
t) = Cell r -> Tree v p -> Tree (v :+ Cell r) (p :+ Cell r)
forall r v p.
Fractional r =>
Cell r -> Tree v p -> Tree (v :+ Cell r) (p :+ Cell r)
Tree.withCells Cell r
c Tree v p
t

leaves :: QuadTree v p r -> NonEmpty p
leaves :: QuadTree v p r -> NonEmpty p
leaves = Tree v p -> NonEmpty p
forall v p. Tree v p -> NonEmpty p
Tree.leaves (Tree v p -> NonEmpty p)
-> (QuadTree v p r -> Tree v p) -> QuadTree v p r -> NonEmpty p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Tree v p) (QuadTree v p r) (Tree v p)
-> QuadTree v p r -> Tree v p
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Tree v p) (QuadTree v p r) (Tree v p)
forall v p r v p.
Lens (QuadTree v p r) (QuadTree v p r) (Tree v p) (Tree v p)
tree

perLevel :: QuadTree v p r -> NonEmpty (NonEmpty (TreeNode v p))
perLevel :: QuadTree v p r -> NonEmpty (NonEmpty (TreeNode v p))
perLevel = Tree (TreeNode v p) -> NonEmpty (NonEmpty (TreeNode v p))
forall a. Tree a -> NonEmpty (NonEmpty a)
levels (Tree (TreeNode v p) -> NonEmpty (NonEmpty (TreeNode v p)))
-> (QuadTree v p r -> Tree (TreeNode v p))
-> QuadTree v p r
-> NonEmpty (NonEmpty (TreeNode v p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree v p -> Tree (TreeNode v p)
forall v p. Tree v p -> Tree (TreeNode v p)
Tree.toRoseTree (Tree v p -> Tree (TreeNode v p))
-> (QuadTree v p r -> Tree v p)
-> QuadTree v p r
-> Tree (TreeNode v p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Tree v p) (QuadTree v p r) (Tree v p)
-> QuadTree v p r -> Tree v p
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Tree v p) (QuadTree v p r) (Tree v p)
forall v p r v p.
Lens (QuadTree v p r) (QuadTree v p r) (Tree v p) (Tree v p)
tree


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

-- | Given a starting cell, a Tree builder, and some input required by
-- the builder, constructs a quadTree.
buildOn            :: Cell r -> (Cell r -> i -> Tree v p) -> i -> QuadTree v p r
buildOn :: Cell r -> (Cell r -> i -> Tree v p) -> i -> QuadTree v p r
buildOn Cell r
c0 Cell r -> i -> Tree v p
builder = Cell r -> Tree v p -> QuadTree v p r
forall v p r. Cell r -> Tree v p -> QuadTree v p r
QuadTree Cell r
c0 (Tree v p -> QuadTree v p r)
-> (i -> Tree v p) -> i -> QuadTree v p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cell r -> i -> Tree v p
builder Cell r
c0

-- | The Equivalent of Tree.build for constructing a QuadTree
build     :: (Fractional r, Ord r) => (Cell r -> i -> Split i v p) -> Cell r -> i -> QuadTree v p r
build :: (Cell r -> i -> Split i v p) -> Cell r -> i -> QuadTree v p r
build Cell r -> i -> Split i v p
f Cell r
c = Cell r -> (Cell r -> i -> Tree v p) -> i -> QuadTree v p r
forall r i v p.
Cell r -> (Cell r -> i -> Tree v p) -> i -> QuadTree v p r
buildOn Cell r
c ((Cell r -> i -> Split i v p) -> Cell r -> i -> Tree v p
forall r pts v p.
Fractional r =>
Splitter r pts v p -> Cell r -> pts -> Tree v p
Tree.build Cell r -> i -> Split i v p
f)

-- | Build a QuadtTree from a set of points.
--
-- pre: the points lie inside the initial given cell.
--
-- running time: \(O(nh)\), where \(n\) is the number of points and
-- \(h\) is the height of the resulting quadTree.
fromPointsBox   :: (Fractional r, Ord r)
                 => Cell r -> [Point 2 r :+ p] -> QuadTree () (Maybe (Point 2 r :+ p)) r
fromPointsBox :: Cell r
-> [Point 2 r :+ p] -> QuadTree () (Maybe (Point 2 r :+ p)) r
fromPointsBox Cell r
c = Cell r
-> (Cell r -> [Point 2 r :+ p] -> Tree () (Maybe (Point 2 r :+ p)))
-> [Point 2 r :+ p]
-> QuadTree () (Maybe (Point 2 r :+ p)) r
forall r i v p.
Cell r -> (Cell r -> i -> Tree v p) -> i -> QuadTree v p r
buildOn Cell r
c Cell r -> [Point 2 r :+ p] -> Tree () (Maybe (Point 2 r :+ p))
forall r p.
(Fractional r, Ord r) =>
Cell r -> [Point 2 r :+ p] -> Tree () (Maybe (Point 2 r :+ p))
Tree.fromPoints

fromPoints     :: (RealFrac r, Ord r)
               => NonEmpty (Point 2 r :+ p) -> QuadTree () (Maybe (Point 2 r :+ p)) r
fromPoints :: NonEmpty (Point 2 r :+ p) -> QuadTree () (Maybe (Point 2 r :+ p)) r
fromPoints NonEmpty (Point 2 r :+ p)
pts = Cell r
-> (Cell r -> [Point 2 r :+ p] -> Tree () (Maybe (Point 2 r :+ p)))
-> [Point 2 r :+ p]
-> QuadTree () (Maybe (Point 2 r :+ p)) r
forall r i v p.
Cell r -> (Cell r -> i -> Tree v p) -> i -> QuadTree v p r
buildOn Cell r
c Cell r -> [Point 2 r :+ p] -> Tree () (Maybe (Point 2 r :+ p))
forall r p.
(Fractional r, Ord r) =>
Cell r -> [Point 2 r :+ p] -> Tree () (Maybe (Point 2 r :+ p))
Tree.fromPoints (NonEmpty (Point 2 r :+ p) -> [Point 2 r :+ p]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList NonEmpty (Point 2 r :+ p)
pts)
  where
    c :: Cell r
c = Rectangle () r -> Cell r
forall r p. (RealFrac r, Ord r) => Rectangle p r -> Cell r
fitsRectangle (Rectangle () r -> Cell r) -> Rectangle () r -> Cell r
forall a b. (a -> b) -> a -> b
$ NonEmpty (Point 2 r)
-> Box (Dimension (Point 2 r)) () (NumType (Point 2 r))
forall g (c :: * -> *).
(IsBoxable g, Foldable1 c, Ord (NumType g), Arity (Dimension g)) =>
c g -> Box (Dimension g) () (NumType g)
boundingBoxList (Getting (Point 2 r) (Point 2 r :+ p) (Point 2 r)
-> (Point 2 r :+ p) -> Point 2 r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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) -> Point 2 r)
-> NonEmpty (Point 2 r :+ p) -> NonEmpty (Point 2 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Point 2 r :+ p)
pts)

{- HLINT ignore findLeaf -}
-- | Locates the cell containing the given point, if it exists.
--
-- running time: \(O(h)\), where \(h\) is the height of the quadTree
findLeaf                                       :: (Fractional r, Ord r)
                                               => Point 2 r -> QuadTree v p r -> Maybe (p :+ Cell r)
findLeaf :: Point 2 r -> QuadTree v p r -> Maybe (p :+ Cell r)
findLeaf Point 2 r
q (QuadTree Cell r
c0 Tree v p
t) | Point 2 r
q Point 2 r -> Cell r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` Cell r
c0  = (p :+ Cell r) -> Maybe (p :+ Cell r)
forall a. a -> Maybe a
Just ((p :+ Cell r) -> Maybe (p :+ Cell r))
-> (p :+ Cell r) -> Maybe (p :+ Cell r)
forall a b. (a -> b) -> a -> b
$ Cell r -> Tree v p -> p :+ Cell r
findLeaf' Cell r
c0 Tree v p
t
                           | Bool
otherwise          = Maybe (p :+ Cell r)
forall a. Maybe a
Nothing
  where
    -- |
    -- pre: p intersects c
    findLeaf' :: Cell r -> Tree v p -> p :+ Cell r
findLeaf' Cell r
c = \case
      Leaf p
p    -> p
p p -> Cell r -> p :+ Cell r
forall core extra. core -> extra -> core :+ extra
:+ Cell r
c
      Node v
_ Quadrants (Tree v p)
qs -> let quad :: InterCardinalDirection
quad = Point 2 r -> Cell r -> InterCardinalDirection
forall r.
(Fractional r, Ord r) =>
Point 2 r -> Cell r -> InterCardinalDirection
quadrantOf Point 2 r
q Cell r
c
                   in Cell r -> Tree v p -> p :+ Cell r
findLeaf' ((Cell r -> Quadrants (Cell r)
forall r. (Num r, Fractional r) => Cell r -> Quadrants (Cell r)
splitCell Cell r
c)Quadrants (Cell r)
-> Getting (Endo (Cell r)) (Quadrants (Cell r)) (Cell r) -> Cell r
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!Index (Quadrants (Cell r))
-> Traversal' (Quadrants (Cell r)) (IxValue (Quadrants (Cell r)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Quadrants (Cell r))
InterCardinalDirection
quad) (Quadrants (Tree v p)
qsQuadrants (Tree v p)
-> Getting (Endo (Tree v p)) (Quadrants (Tree v p)) (Tree v p)
-> Tree v p
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!Index (Quadrants (Tree v p))
-> Traversal'
     (Quadrants (Tree v p)) (IxValue (Quadrants (Tree v p)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Quadrants (Tree v p))
InterCardinalDirection
quad)

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


fromZeros :: (Fractional r, Ord r, Num a, Eq a, v ~ Quadrants Sign)
          => Cell r -> (Point 2 r -> a) -> QuadTree v (Either v Sign) r
fromZeros :: Cell r -> (Point 2 r -> a) -> QuadTree v (Either v Sign) r
fromZeros = Limiter r (Corners Sign) (Corners Sign) Sign
-> Cell r
-> (Point 2 r -> a)
-> QuadTree (Corners Sign) (Signs Sign) r
forall r a.
(Fractional r, Ord r, Eq a, Num a) =>
Limiter r (Corners Sign) (Corners Sign) Sign
-> Cell r
-> (Point 2 r -> a)
-> QuadTree (Corners Sign) (Signs Sign) r
fromZerosWith (Int -> Limiter r (Corners Sign) (Corners Sign) Sign
forall r i v p. Int -> Limiter r i v p
limitWidthTo (-Int
1))


fromZerosWith            ::  (Fractional r, Ord r, Eq a, Num a)
                         => Limiter r (Corners Sign) (Corners Sign) Sign
                         -> Cell r
                         -> (Point 2 r -> a)
                         -> QuadTree (Quadrants Sign) (Signs Sign) r
fromZerosWith :: Limiter r (Corners Sign) (Corners Sign) Sign
-> Cell r
-> (Point 2 r -> a)
-> QuadTree (Corners Sign) (Signs Sign) r
fromZerosWith Limiter r (Corners Sign) (Corners Sign) Sign
limit Cell r
c0 Point 2 r -> a
f = Limiter r (Corners Sign) (Corners Sign) Sign
-> Cell r
-> (Point 2 r -> Sign)
-> QuadTree (Corners Sign) (Signs Sign) r
forall sign r.
(Eq sign, Fractional r, Ord r) =>
Limiter r (Corners sign) (Corners sign) sign
-> Cell r
-> (Point 2 r -> sign)
-> QuadTree (Corners sign) (Signs sign) r
fromZerosWith' Limiter r (Corners Sign) (Corners Sign) Sign
limit Cell r
c0 ((Point 2 r -> a) -> Point 2 r -> Sign
forall a b. (Num a, Eq a) => (b -> a) -> b -> Sign
fromSignum Point 2 r -> a
f)


type Signs sign = Either (Corners sign) sign


fromZerosWith'           :: (Eq sign, Fractional r, Ord r)
                         => Limiter r (Corners sign) (Corners sign) sign
                         -> Cell r
                         -> (Point 2 r -> sign)
                         -> QuadTree (Quadrants sign) (Signs sign) r
fromZerosWith' :: Limiter r (Corners sign) (Corners sign) sign
-> Cell r
-> (Point 2 r -> sign)
-> QuadTree (Corners sign) (Signs sign) r
fromZerosWith' Limiter r (Corners sign) (Corners sign) sign
limit Cell r
c0 Point 2 r -> sign
f = (Cell r
 -> Corners sign
 -> Split (Corners sign) (Corners sign) (Signs sign))
-> Cell r -> Corners sign -> QuadTree (Corners sign) (Signs sign) r
forall r i v p.
(Fractional r, Ord r) =>
(Cell r -> i -> Split i v p) -> Cell r -> i -> QuadTree v p r
build (Limiter r (Corners sign) (Corners sign) sign
limit Limiter r (Corners sign) (Corners sign) sign
-> Limiter r (Corners sign) (Corners sign) sign
forall a b. (a -> b) -> a -> b
$ (Point 2 r -> sign)
-> Splitter r (Corners sign) (Corners sign) sign
forall r sign.
(Fractional r, Eq sign) =>
(Point 2 r -> sign)
-> Splitter r (Quadrants sign) (Quadrants sign) sign
shouldSplitZeros Point 2 r -> sign
f) Cell r
c0 (Point 2 r -> sign
f (Point 2 r -> sign) -> Corners (Point 2 r) -> Corners sign
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cell r -> Corners (Point 2 r)
forall r. Fractional r => Cell r -> Quadrants (Point 2 r)
cellCorners Cell r
c0)



-- type Sign = Ordering

-- pattern Negative :: Sign
-- pattern Negative = LT
-- pattern Zero :: Sign
-- pattern Zero     = EQ
-- pattern Positive :: Sign
-- pattern Positive = GT
-- {-# COMPLETE Negative, Zero, Positive #-}

-- fromOrdering :: Ordering -> Sign
-- fromOrdering = id


data Sign = Negative | Zero | Positive deriving (Int -> Sign -> ShowS
[Sign] -> ShowS
Sign -> String
(Int -> Sign -> ShowS)
-> (Sign -> String) -> ([Sign] -> ShowS) -> Show Sign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sign] -> ShowS
$cshowList :: [Sign] -> ShowS
show :: Sign -> String
$cshow :: Sign -> String
showsPrec :: Int -> Sign -> ShowS
$cshowsPrec :: Int -> Sign -> ShowS
Show,Sign -> Sign -> Bool
(Sign -> Sign -> Bool) -> (Sign -> Sign -> Bool) -> Eq Sign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sign -> Sign -> Bool
$c/= :: Sign -> Sign -> Bool
== :: Sign -> Sign -> Bool
$c== :: Sign -> Sign -> Bool
Eq,Eq Sign
Eq Sign
-> (Sign -> Sign -> Ordering)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Sign)
-> (Sign -> Sign -> Sign)
-> Ord Sign
Sign -> Sign -> Bool
Sign -> Sign -> Ordering
Sign -> Sign -> Sign
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 :: Sign -> Sign -> Sign
$cmin :: Sign -> Sign -> Sign
max :: Sign -> Sign -> Sign
$cmax :: Sign -> Sign -> Sign
>= :: Sign -> Sign -> Bool
$c>= :: Sign -> Sign -> Bool
> :: Sign -> Sign -> Bool
$c> :: Sign -> Sign -> Bool
<= :: Sign -> Sign -> Bool
$c<= :: Sign -> Sign -> Bool
< :: Sign -> Sign -> Bool
$c< :: Sign -> Sign -> Bool
compare :: Sign -> Sign -> Ordering
$ccompare :: Sign -> Sign -> Ordering
$cp1Ord :: Eq Sign
Ord)



-- | Interpret an ordering result as a Sign
fromOrdering :: Ordering -> Sign
fromOrdering :: Ordering -> Sign
fromOrdering = \case
    Ordering
LT -> Sign
Negative
    Ordering
EQ -> Sign
Zero
    Ordering
GT -> Sign
Positive

fromSignum   :: (Num a, Eq a) => (b -> a) -> b -> Sign
fromSignum :: (b -> a) -> b -> Sign
fromSignum b -> a
f b
x = case a -> a
forall a. Num a => a -> a
signum (b -> a
f b
x) of
                       -1 -> Sign
Negative
                       a
0  -> Sign
Zero
                       a
1  -> Sign
Positive
                       a
_  -> String -> Sign
forall a. HasCallStack => String -> a
error String
"absurd: fromSignum"

-- | Splitter that determines if we should split a cell based on the
-- sign of the corners.
shouldSplitZeros :: forall r sign. (Fractional r, Eq sign)
                 => (Point 2 r -> sign) -- ^ The function we are evaluating
                 -> Splitter r
                             (Quadrants sign) -- the input are the signs of the corners
                             (Quadrants sign) -- at internal nodes we store signs of corners
                             sign
shouldSplitZeros :: (Point 2 r -> sign)
-> Splitter r (Quadrants sign) (Quadrants sign) sign
shouldSplitZeros Point 2 r -> sign
f (Cell Int
w' Point 2 r
p) qs :: Quadrants sign
qs@(Quadrants sign
nw sign
ne sign
se sign
sw) | (sign -> Bool) -> Quadrants sign -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all sign -> Bool
sameSign Quadrants sign
qs = sign -> Split (Quadrants sign) (Quadrants sign) sign
forall i v p. p -> Split i v p
No sign
ne
                                                          | Bool
otherwise       = Quadrants sign
-> Quadrants (Quadrants sign)
-> Split (Quadrants sign) (Quadrants sign) sign
forall i v p. v -> Quadrants i -> Split i v p
Yes Quadrants sign
qs Quadrants (Quadrants sign)
qs'
  where
    m :: sign
m = r -> r -> sign
fAt r
rr r
rr
    n :: sign
n = r -> r -> sign
fAt r
rr r
ww
    e :: sign
e = r -> r -> sign
fAt r
ww r
rr
    s :: sign
s = r -> r -> sign
fAt r
rr r
0
    w :: sign
w = r -> r -> sign
fAt r
0  r
rr

    sameSign :: sign -> Bool
sameSign = (sign -> sign -> Bool
forall a. Eq a => a -> a -> Bool
== sign
ne)

    -- signs at the new corners
    qs' :: Quadrants (Quadrants sign)
qs' = Quadrants sign
-> Quadrants sign
-> Quadrants sign
-> Quadrants sign
-> Quadrants (Quadrants sign)
forall a. a -> a -> a -> a -> Corners a
Quadrants (sign -> sign -> sign -> sign -> Quadrants sign
forall a. a -> a -> a -> a -> Corners a
Quadrants sign
nw sign
n sign
m sign
w)
                    (sign -> sign -> sign -> sign -> Quadrants sign
forall a. a -> a -> a -> a -> Corners a
Quadrants sign
n sign
ne sign
e sign
m)
                    (sign -> sign -> sign -> sign -> Quadrants sign
forall a. a -> a -> a -> a -> Corners a
Quadrants sign
m sign
e sign
se sign
s)
                    (sign -> sign -> sign -> sign -> Quadrants sign
forall a. a -> a -> a -> a -> Corners a
Quadrants sign
w sign
m sign
s sign
sw)

    r :: Int
r     = Int
w' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    rr :: r
rr    = Int -> r
forall r. Fractional r => Int -> r
pow Int
r
    ww :: r
ww    = Int -> r
forall r. Fractional r => Int -> r
pow Int
w'

    fAt :: r -> r -> sign
fAt r
x r
y = Point 2 r -> sign
f (Point 2 r -> sign) -> Point 2 r -> sign
forall a b. (a -> b) -> a -> b
$ Point 2 r
p 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
x r
y


isZeroCell   :: (Eq sign) => sign -- ^ the zero value
             -> Either v sign -> Bool
isZeroCell :: sign -> Either v sign -> Bool
isZeroCell sign
z = \case
    Left v
_  -> Bool
True -- if we kept splitting then we must have a sign transition
    Right sign
s -> sign
s sign -> sign -> Bool
forall a. Eq a => a -> a -> Bool
== sign
z

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



-- | Constructs an empty/complete tree from the starting width
completeTree    :: (Fractional r, Ord r) => Cell r -> QuadTree () () r
completeTree :: Cell r -> QuadTree () () r
completeTree Cell r
c0 =
    (Cell r -> Int -> Split Int () ())
-> Cell r -> Int -> QuadTree () () r
forall r i v p.
(Fractional r, Ord r) =>
(Cell r -> i -> Split i v p) -> Cell r -> i -> QuadTree v p r
build (\Cell r
_ Int
w -> if Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then () -> Split Int () ()
forall i v p. p -> Split i v p
No () else () -> Quadrants Int -> Split Int () ()
forall i v p. v -> Quadrants i -> Split i v p
Yes () (Int -> Quadrants Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Quadrants Int) -> Int -> Quadrants Int
forall a b. (a -> b) -> a -> b
$ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Cell r
c0 (Cell r
c0Cell r -> Getting Int (Cell r) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Cell r) Int
forall r. Lens' (Cell r) Int
cellWidthIndex)

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