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

import           Control.Lens
import           Data.BinaryTree
import           Data.Ext
import           Data.Geometry.Properties
import           Data.Geometry.RangeTree.Measure
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Range
import           Data.Measured.Class
import           Data.Measured.Size
import           Data.Semigroup
import           Data.Semigroup.Foldable
import           Data.Util

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

data NodeData v r = NodeData { NodeData v r -> Min r
_minVal     :: !(Min r)
                             , NodeData v r -> Max r
_maxVal     :: !(Max r)
                             , NodeData v r -> v
_assoc      :: !v
                             } deriving (Int -> NodeData v r -> ShowS
[NodeData v r] -> ShowS
NodeData v r -> String
(Int -> NodeData v r -> ShowS)
-> (NodeData v r -> String)
-> ([NodeData v r] -> ShowS)
-> Show (NodeData v r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v r. (Show r, Show v) => Int -> NodeData v r -> ShowS
forall v r. (Show r, Show v) => [NodeData v r] -> ShowS
forall v r. (Show r, Show v) => NodeData v r -> String
showList :: [NodeData v r] -> ShowS
$cshowList :: forall v r. (Show r, Show v) => [NodeData v r] -> ShowS
show :: NodeData v r -> String
$cshow :: forall v r. (Show r, Show v) => NodeData v r -> String
showsPrec :: Int -> NodeData v r -> ShowS
$cshowsPrec :: forall v r. (Show r, Show v) => Int -> NodeData v r -> ShowS
Show,NodeData v r -> NodeData v r -> Bool
(NodeData v r -> NodeData v r -> Bool)
-> (NodeData v r -> NodeData v r -> Bool) -> Eq (NodeData v r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v r. (Eq r, Eq v) => NodeData v r -> NodeData v r -> Bool
/= :: NodeData v r -> NodeData v r -> Bool
$c/= :: forall v r. (Eq r, Eq v) => NodeData v r -> NodeData v r -> Bool
== :: NodeData v r -> NodeData v r -> Bool
$c== :: forall v r. (Eq r, Eq v) => NodeData v r -> NodeData v r -> Bool
Eq,a -> NodeData v b -> NodeData v a
(a -> b) -> NodeData v a -> NodeData v b
(forall a b. (a -> b) -> NodeData v a -> NodeData v b)
-> (forall a b. a -> NodeData v b -> NodeData v a)
-> Functor (NodeData v)
forall a b. a -> NodeData v b -> NodeData v a
forall a b. (a -> b) -> NodeData v a -> NodeData v b
forall v a b. a -> NodeData v b -> NodeData v a
forall v a b. (a -> b) -> NodeData v a -> NodeData v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> NodeData v b -> NodeData v a
$c<$ :: forall v a b. a -> NodeData v b -> NodeData v a
fmap :: (a -> b) -> NodeData v a -> NodeData v b
$cfmap :: forall v a b. (a -> b) -> NodeData v a -> NodeData v b
Functor)

instance (Semigroup v, Ord r) => Semigroup (NodeData v r) where
  NodeData Min r
mi Max r
ma v
v <> :: NodeData v r -> NodeData v r -> NodeData v r
<> NodeData Min r
mi' Max r
ma' v
v' = Min r -> Max r -> v -> NodeData v r
forall v r. Min r -> Max r -> v -> NodeData v r
NodeData (Min r
mi Min r -> Min r -> Min r
forall a. Semigroup a => a -> a -> a
<> Min r
mi') (Max r
ma Max r -> Max r -> Max r
forall a. Semigroup a => a -> a -> a
<> Max r
ma') (v
v v -> v -> v
forall a. Semigroup a => a -> a -> a
<> v
v')


-- | A generic (1D) range tree. The 'r' parameter indicates the type
-- of the coordinates of the points. The 'q' represents any associated
-- data values with those points (stored in the leaves), and the 'v'
-- types represents the data stored at internal nodes.
newtype RangeTree v q r =
  RangeTree { RangeTree v q r -> BinLeafTree (NodeData v r) (NodeData (v, q) r)
_unRangeTree :: BinLeafTree (NodeData v r) (NodeData (v,q) r) }
    deriving (Int -> RangeTree v q r -> ShowS
[RangeTree v q r] -> ShowS
RangeTree v q r -> String
(Int -> RangeTree v q r -> ShowS)
-> (RangeTree v q r -> String)
-> ([RangeTree v q r] -> ShowS)
-> Show (RangeTree v q r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v q r.
(Show r, Show v, Show q) =>
Int -> RangeTree v q r -> ShowS
forall v q r.
(Show r, Show v, Show q) =>
[RangeTree v q r] -> ShowS
forall v q r. (Show r, Show v, Show q) => RangeTree v q r -> String
showList :: [RangeTree v q r] -> ShowS
$cshowList :: forall v q r.
(Show r, Show v, Show q) =>
[RangeTree v q r] -> ShowS
show :: RangeTree v q r -> String
$cshow :: forall v q r. (Show r, Show v, Show q) => RangeTree v q r -> String
showsPrec :: Int -> RangeTree v q r -> ShowS
$cshowsPrec :: forall v q r.
(Show r, Show v, Show q) =>
Int -> RangeTree v q r -> ShowS
Show,RangeTree v q r -> RangeTree v q r -> Bool
(RangeTree v q r -> RangeTree v q r -> Bool)
-> (RangeTree v q r -> RangeTree v q r -> Bool)
-> Eq (RangeTree v q r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v q r.
(Eq r, Eq v, Eq q) =>
RangeTree v q r -> RangeTree v q r -> Bool
/= :: RangeTree v q r -> RangeTree v q r -> Bool
$c/= :: forall v q r.
(Eq r, Eq v, Eq q) =>
RangeTree v q r -> RangeTree v q r -> Bool
== :: RangeTree v q r -> RangeTree v q r -> Bool
$c== :: forall v q r.
(Eq r, Eq v, Eq q) =>
RangeTree v q r -> RangeTree v q r -> Bool
Eq)



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

-- | Creates a range tree
createTree   :: ( Ord r
                , Measured v p
                , Semigroup p
                )
             => NonEmpty (r :+ p)
             -> RangeTree v p r
createTree :: NonEmpty (r :+ p) -> RangeTree v p r
createTree = NonEmpty (r :+ p) -> RangeTree v p r
forall r v p.
(Ord r, Measured v p) =>
NonEmpty (r :+ p) -> RangeTree v p r
createTree'
           (NonEmpty (r :+ p) -> RangeTree v p r)
-> (NonEmpty (r :+ p) -> NonEmpty (r :+ p))
-> NonEmpty (r :+ p)
-> RangeTree v p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (r :+ p) -> r :+ p)
-> NonEmpty (NonEmpty (r :+ p)) -> NonEmpty (r :+ p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\NonEmpty (r :+ p)
pts -> let x :: r
x =  NonEmpty (r :+ p)
ptsNonEmpty (r :+ p) -> Getting r (NonEmpty (r :+ p)) r -> r
forall s a. s -> Getting a s a -> a
^.(NonEmpty (r :+ p) -> r :+ p)
-> Optic' (->) (Const r) (NonEmpty (r :+ p)) (r :+ p)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to NonEmpty (r :+ p) -> r :+ p
forall a. NonEmpty a -> a
NonEmpty.headOptic' (->) (Const r) (NonEmpty (r :+ p)) (r :+ p)
-> ((r -> Const r r) -> (r :+ p) -> Const r (r :+ p))
-> Getting r (NonEmpty (r :+ p)) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> (r :+ p) -> Const r (r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core
                           in r
x r -> p -> r :+ p
forall core extra. core -> extra -> core :+ extra
:+ (NonEmpty p -> p
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty p -> p)
-> (NonEmpty (r :+ p) -> NonEmpty p) -> NonEmpty (r :+ p) -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((r :+ p) -> p) -> NonEmpty (r :+ p) -> NonEmpty p
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((r :+ p) -> Getting p (r :+ p) p -> p
forall s a. s -> Getting a s a -> a
^.Getting p (r :+ p) p
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra) (NonEmpty (r :+ p) -> p) -> NonEmpty (r :+ p) -> p
forall a b. (a -> b) -> a -> b
$ NonEmpty (r :+ p)
pts))
           (NonEmpty (NonEmpty (r :+ p)) -> NonEmpty (r :+ p))
-> (NonEmpty (r :+ p) -> NonEmpty (NonEmpty (r :+ p)))
-> NonEmpty (r :+ p)
-> NonEmpty (r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((r :+ p) -> r)
-> NonEmpty (r :+ p) -> NonEmpty (NonEmpty (r :+ p))
forall b a.
Ord b =>
(a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a)
NonEmpty.groupAllWith1 ((r :+ p) -> ((r -> Const r r) -> (r :+ p) -> Const r (r :+ p)) -> r
forall s a. s -> Getting a s a -> a
^.(r -> Const r r) -> (r :+ p) -> Const r (r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) -- sort and group on r value

-- | pre: input is sorted and grouped by x-coord
createTree'     :: (Ord r, Measured v p)
                => NonEmpty (r :+ p)
                -> RangeTree v p r
createTree' :: NonEmpty (r :+ p) -> RangeTree v p r
createTree' NonEmpty (r :+ p)
pts = BinLeafTree (NodeData v r) (NodeData (v, p) r) -> RangeTree v p r
forall v q r.
BinLeafTree (NodeData v r) (NodeData (v, q) r) -> RangeTree v q r
RangeTree BinLeafTree (NodeData v r) (NodeData (v, p) r)
t
  where
    t :: BinLeafTree (NodeData v r) (NodeData (v, p) r)
t = Getting
  (BinLeafTree (NodeData v r) (NodeData (v, p) r))
  (SP
     (BinLeafTree (NodeData v r) (NodeData (v, p) r)) (NodeData v r))
  (BinLeafTree (NodeData v r) (NodeData (v, p) r))
-> SP
     (BinLeafTree (NodeData v r) (NodeData (v, p) r)) (NodeData v r)
-> BinLeafTree (NodeData v r) (NodeData (v, p) r)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (BinLeafTree (NodeData v r) (NodeData (v, p) r))
  (SP
     (BinLeafTree (NodeData v r) (NodeData (v, p) r)) (NodeData v r))
  (BinLeafTree (NodeData v r) (NodeData (v, p) r))
forall s t a b. Field1 s t a b => Lens s t a b
_1
      (SP (BinLeafTree (NodeData v r) (NodeData (v, p) r)) (NodeData v r)
 -> BinLeafTree (NodeData v r) (NodeData (v, p) r))
-> (NonEmpty (r :+ p)
    -> SP
         (BinLeafTree (NodeData v r) (NodeData (v, p) r)) (NodeData v r))
-> NonEmpty (r :+ p)
-> BinLeafTree (NodeData v r) (NodeData (v, p) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SP (BinLeafTree (NodeData v r) (NodeData (v, p) r)) (NodeData v r)
 -> Size
 -> SP
      (BinLeafTree (NodeData v r) (NodeData (v, p) r)) (NodeData v r)
 -> SP
      (BinLeafTree (NodeData v r) (NodeData (v, p) r)) (NodeData v r))
-> (Elem (r :+ p)
    -> SP
         (BinLeafTree (NodeData v r) (NodeData (v, p) r)) (NodeData v r))
-> BinLeafTree Size (Elem (r :+ p))
-> SP
     (BinLeafTree (NodeData v r) (NodeData (v, p) r)) (NodeData v r)
forall b v a.
(b -> v -> b -> b) -> (a -> b) -> BinLeafTree v a -> b
foldUp (\(SP BinLeafTree (NodeData v r) (NodeData (v, p) r)
l NodeData v r
dl) Size
_ (SP BinLeafTree (NodeData v r) (NodeData (v, p) r)
r NodeData v r
dr) -> let d :: NodeData v r
d = NodeData v r
dl NodeData v r -> NodeData v r -> NodeData v r
forall a. Semigroup a => a -> a -> a
<> NodeData v r
dr in BinLeafTree (NodeData v r) (NodeData (v, p) r)
-> NodeData v r
-> SP
     (BinLeafTree (NodeData v r) (NodeData (v, p) r)) (NodeData v r)
forall a b. a -> b -> SP a b
SP (BinLeafTree (NodeData v r) (NodeData (v, p) r)
-> NodeData v r
-> BinLeafTree (NodeData v r) (NodeData (v, p) r)
-> BinLeafTree (NodeData v r) (NodeData (v, p) r)
forall v a.
BinLeafTree v a -> v -> BinLeafTree v a -> BinLeafTree v a
Node BinLeafTree (NodeData v r) (NodeData (v, p) r)
l NodeData v r
d BinLeafTree (NodeData v r) (NodeData (v, p) r)
r) NodeData v r
d
               )
               (\(Elem (r
x :+ p
ld)) -> let v :: v
v = p -> v
forall v a. Measured v a => a -> v
measure p
ld
                                     in BinLeafTree (NodeData v r) (NodeData (v, p) r)
-> NodeData v r
-> SP
     (BinLeafTree (NodeData v r) (NodeData (v, p) r)) (NodeData v r)
forall a b. a -> b -> SP a b
SP (NodeData (v, p) r -> BinLeafTree (NodeData v r) (NodeData (v, p) r)
forall v a. a -> BinLeafTree v a
Leaf (NodeData (v, p) r
 -> BinLeafTree (NodeData v r) (NodeData (v, p) r))
-> NodeData (v, p) r
-> BinLeafTree (NodeData v r) (NodeData (v, p) r)
forall a b. (a -> b) -> a -> b
$ Min r -> Max r -> (v, p) -> NodeData (v, p) r
forall v r. Min r -> Max r -> v -> NodeData v r
NodeData (r -> Min r
forall a. a -> Min a
Min r
x) (r -> Max r
forall a. a -> Max a
Max r
x) (v
v,p
ld))
                                           (Min r -> Max r -> v -> NodeData v r
forall v r. Min r -> Max r -> v -> NodeData v r
NodeData (r -> Min r
forall a. a -> Min a
Min r
x) (r -> Max r
forall a. a -> Max a
Max r
x) v
v)
               )
      (BinLeafTree Size (Elem (r :+ p))
 -> SP
      (BinLeafTree (NodeData v r) (NodeData (v, p) r)) (NodeData v r))
-> (NonEmpty (r :+ p) -> BinLeafTree Size (Elem (r :+ p)))
-> NonEmpty (r :+ p)
-> SP
     (BinLeafTree (NodeData v r) (NodeData (v, p) r)) (NodeData v r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (r :+ p) -> BinLeafTree Size (Elem (r :+ p))
forall a. NonEmpty a -> BinLeafTree Size (Elem a)
asBalancedBinLeafTree (NonEmpty (r :+ p)
 -> BinLeafTree (NodeData v r) (NodeData (v, p) r))
-> NonEmpty (r :+ p)
-> BinLeafTree (NodeData v r) (NodeData (v, p) r)
forall a b. (a -> b) -> a -> b
$ NonEmpty (r :+ p)
pts

--------------------------------------------------------------------------------
-- * Converting to a List

-- | Lists all points in increasing order
--
-- running time: \(O(n)\)
toAscList :: RangeTree v p r -> NonEmpty (r :+ p)
toAscList :: RangeTree v p r -> NonEmpty (r :+ p)
toAscList = (NodeData (v, p) r -> r :+ p)
-> NonEmpty (NodeData (v, p) r) -> NonEmpty (r :+ p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(NodeData (Min r
x) Max r
_ (v
_,p
d)) -> r
x r -> p -> r :+ p
forall core extra. core -> extra -> core :+ extra
:+ p
d) (NonEmpty (NodeData (v, p) r) -> NonEmpty (r :+ p))
-> (RangeTree v p r -> NonEmpty (NodeData (v, p) r))
-> RangeTree v p r
-> NonEmpty (r :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinLeafTree (NodeData v r) (NodeData (v, p) r)
-> NonEmpty (NodeData (v, p) r)
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty (BinLeafTree (NodeData v r) (NodeData (v, p) r)
 -> NonEmpty (NodeData (v, p) r))
-> (RangeTree v p r
    -> BinLeafTree (NodeData v r) (NodeData (v, p) r))
-> RangeTree v p r
-> NonEmpty (NodeData (v, p) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RangeTree v p r -> BinLeafTree (NodeData v r) (NodeData (v, p) r)
forall v q r.
RangeTree v q r -> BinLeafTree (NodeData v r) (NodeData (v, q) r)
_unRangeTree

--------------------------------------------------------------------------------
-- * Querying x

-- | Range search
--
-- running time: \(O(\log n)\)
search    :: (Ord r, Monoid v) => Range r -> RangeTree v p r -> v
search :: Range r -> RangeTree v p r -> v
search Range r
qr = [v] -> v
forall a. Monoid a => [a] -> a
mconcat ([v] -> v) -> (RangeTree v p r -> [v]) -> RangeTree v p r -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range r -> RangeTree v p r -> [v]
forall r v p. Ord r => Range r -> RangeTree v p r -> [v]
search' Range r
qr

-- | Range search, report the (associated data structures of the)
-- \(O(\log n)\) nodes that form the disjoint union of the range we
-- are querying with.
--
-- running time: \(O(\log n)\)
search'    :: Ord r
           => Range r -> RangeTree v p r -> [v]
search' :: Range r -> RangeTree v p r -> [v]
search' Range r
qr = Range r -> BinLeafTree (NodeData v r) (NodeData (v, p) r) -> [v]
forall r v q.
Ord r =>
Range r -> BinLeafTree (NodeData v r) (NodeData (v, q) r) -> [v]
search'' Range r
qr (BinLeafTree (NodeData v r) (NodeData (v, p) r) -> [v])
-> (RangeTree v p r
    -> BinLeafTree (NodeData v r) (NodeData (v, p) r))
-> RangeTree v p r
-> [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RangeTree v p r -> BinLeafTree (NodeData v r) (NodeData (v, p) r)
forall v q r.
RangeTree v q r -> BinLeafTree (NodeData v r) (NodeData (v, q) r)
_unRangeTree

-- | The actual search
search''    :: Ord r
            => Range r
            -> BinLeafTree (NodeData v r) (NodeData (v,q) r)
            -> [v]
search'' :: Range r -> BinLeafTree (NodeData v r) (NodeData (v, q) r) -> [v]
search'' Range r
qr BinLeafTree (NodeData v r) (NodeData (v, q) r)
t = case BinLeafTree (NodeData v r) (NodeData (v, q) r)
t of
    Leaf (NodeData Min r
_ Max r
_ (v
v,q
_)) | Range r
qr Range r -> Range r -> Bool
forall a. Ord a => Range a -> Range a -> Bool
`covers` BinLeafTree (NodeData v r) (NodeData (v, q) r) -> Range r
forall v r v'.
BinLeafTree (NodeData v r) (NodeData v' r) -> Range r
rangeOf BinLeafTree (NodeData v r) (NodeData (v, q) r)
t -> [v
v]
                              | Bool
otherwise             -> []
    Node BinLeafTree (NodeData v r) (NodeData (v, q) r)
l (NodeData Min r
_ Max r
_ v
v) BinLeafTree (NodeData v r) (NodeData (v, q) r)
r | Range r
qr Range r -> Range r -> Bool
forall a. Ord a => Range a -> Range a -> Bool
`covers` BinLeafTree (NodeData v r) (NodeData (v, q) r) -> Range r
forall v r v'.
BinLeafTree (NodeData v r) (NodeData v' r) -> Range r
rangeOf BinLeafTree (NodeData v r) (NodeData (v, q) r)
t -> [v
v]
                              | Bool
otherwise             -> BinLeafTree (NodeData v r) (NodeData (v, q) r) -> [v]
msearch BinLeafTree (NodeData v r) (NodeData (v, q) r)
l [v] -> [v] -> [v]
forall a. Semigroup a => a -> a -> a
<> BinLeafTree (NodeData v r) (NodeData (v, q) r) -> [v]
msearch BinLeafTree (NodeData v r) (NodeData (v, q) r)
r
  where
    msearch :: BinLeafTree (NodeData v r) (NodeData (v, q) r) -> [v]
msearch BinLeafTree (NodeData v r) (NodeData (v, q) r)
t' | Range r
qr Range r -> Range r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` BinLeafTree (NodeData v r) (NodeData (v, q) r) -> Range r
forall v r v'.
BinLeafTree (NodeData v r) (NodeData v' r) -> Range r
rangeOf BinLeafTree (NodeData v r) (NodeData (v, q) r)
t' = Range r -> BinLeafTree (NodeData v r) (NodeData (v, q) r) -> [v]
forall r v q.
Ord r =>
Range r -> BinLeafTree (NodeData v r) (NodeData (v, q) r) -> [v]
search'' Range r
qr BinLeafTree (NodeData v r) (NodeData (v, q) r)
t'
               | Bool
otherwise                  = []


-- | Helper function to get the range of  a binary leaf tree
rangeOf              :: BinLeafTree (NodeData v r) (NodeData v' r) -> Range r
rangeOf :: BinLeafTree (NodeData v r) (NodeData v' r) -> Range r
rangeOf (Leaf NodeData v' r
d)     = NodeData v' r -> Range r
forall v r. NodeData v r -> Range r
rangeOf' NodeData v' r
d
rangeOf (Node BinLeafTree (NodeData v r) (NodeData v' r)
_ NodeData v r
d BinLeafTree (NodeData v r) (NodeData v' r)
_) = NodeData v r -> Range r
forall v r. NodeData v r -> Range r
rangeOf' NodeData v r
d

-- | Get the range of a node
rangeOf'                                :: NodeData v r -> Range r
rangeOf' :: NodeData v r -> Range r
rangeOf' (NodeData (Min r
mi) (Max r
ma) v
_) = r -> r -> Range r
forall a. a -> a -> Range a
ClosedRange r
mi r
ma


--------------------------------------------------------------------------------
-- * Updates

-- support inserting and deleting points, assuming that the x-coord already exists.


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


createReportingTree :: Ord r => NonEmpty (r :+ [p]) -> RangeTree (Report p) (Report p) r
createReportingTree :: NonEmpty (r :+ [p]) -> RangeTree (Report p) (Report p) r
createReportingTree = NonEmpty (r :+ Report p) -> RangeTree (Report p) (Report p) r
forall r v p.
(Ord r, Measured v p, Semigroup p) =>
NonEmpty (r :+ p) -> RangeTree v p r
createTree (NonEmpty (r :+ Report p) -> RangeTree (Report p) (Report p) r)
-> (NonEmpty (r :+ [p]) -> NonEmpty (r :+ Report p))
-> NonEmpty (r :+ [p])
-> RangeTree (Report p) (Report p) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((r :+ [p]) -> r :+ Report p)
-> NonEmpty (r :+ [p]) -> NonEmpty (r :+ Report p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((r :+ [p]) -> ((r :+ [p]) -> r :+ Report p) -> r :+ Report p
forall a b. a -> (a -> b) -> b
&([p] -> Identity (Report p))
-> (r :+ [p]) -> Identity (r :+ Report p)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra (([p] -> Identity (Report p))
 -> (r :+ [p]) -> Identity (r :+ Report p))
-> ([p] -> Report p) -> (r :+ [p]) -> r :+ Report p
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [p] -> Report p
forall p. [p] -> Report p
Report)

report    :: (Ord r) => Range r -> RangeTree (Report p) q r -> [p]
report :: Range r -> RangeTree (Report p) q r -> [p]
report Range r
qr = Report p -> [p]
forall p. Report p -> [p]
reportList (Report p -> [p])
-> (RangeTree (Report p) q r -> Report p)
-> RangeTree (Report p) q r
-> [p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range r -> RangeTree (Report p) q r -> Report p
forall r v p. (Ord r, Monoid v) => Range r -> RangeTree v p r -> v
search Range r
qr


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

newtype CountOf p = CountOf [p]
  deriving (Int -> CountOf p -> ShowS
[CountOf p] -> ShowS
CountOf p -> String
(Int -> CountOf p -> ShowS)
-> (CountOf p -> String)
-> ([CountOf p] -> ShowS)
-> Show (CountOf p)
forall p. Show p => Int -> CountOf p -> ShowS
forall p. Show p => [CountOf p] -> ShowS
forall p. Show p => CountOf p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CountOf p] -> ShowS
$cshowList :: forall p. Show p => [CountOf p] -> ShowS
show :: CountOf p -> String
$cshow :: forall p. Show p => CountOf p -> String
showsPrec :: Int -> CountOf p -> ShowS
$cshowsPrec :: forall p. Show p => Int -> CountOf p -> ShowS
Show,CountOf p -> CountOf p -> Bool
(CountOf p -> CountOf p -> Bool)
-> (CountOf p -> CountOf p -> Bool) -> Eq (CountOf p)
forall p. Eq p => CountOf p -> CountOf p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CountOf p -> CountOf p -> Bool
$c/= :: forall p. Eq p => CountOf p -> CountOf p -> Bool
== :: CountOf p -> CountOf p -> Bool
$c== :: forall p. Eq p => CountOf p -> CountOf p -> Bool
Eq,Eq (CountOf p)
Eq (CountOf p)
-> (CountOf p -> CountOf p -> Ordering)
-> (CountOf p -> CountOf p -> Bool)
-> (CountOf p -> CountOf p -> Bool)
-> (CountOf p -> CountOf p -> Bool)
-> (CountOf p -> CountOf p -> Bool)
-> (CountOf p -> CountOf p -> CountOf p)
-> (CountOf p -> CountOf p -> CountOf p)
-> Ord (CountOf p)
CountOf p -> CountOf p -> Bool
CountOf p -> CountOf p -> Ordering
CountOf p -> CountOf p -> CountOf p
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
forall p. Ord p => Eq (CountOf p)
forall p. Ord p => CountOf p -> CountOf p -> Bool
forall p. Ord p => CountOf p -> CountOf p -> Ordering
forall p. Ord p => CountOf p -> CountOf p -> CountOf p
min :: CountOf p -> CountOf p -> CountOf p
$cmin :: forall p. Ord p => CountOf p -> CountOf p -> CountOf p
max :: CountOf p -> CountOf p -> CountOf p
$cmax :: forall p. Ord p => CountOf p -> CountOf p -> CountOf p
>= :: CountOf p -> CountOf p -> Bool
$c>= :: forall p. Ord p => CountOf p -> CountOf p -> Bool
> :: CountOf p -> CountOf p -> Bool
$c> :: forall p. Ord p => CountOf p -> CountOf p -> Bool
<= :: CountOf p -> CountOf p -> Bool
$c<= :: forall p. Ord p => CountOf p -> CountOf p -> Bool
< :: CountOf p -> CountOf p -> Bool
$c< :: forall p. Ord p => CountOf p -> CountOf p -> Bool
compare :: CountOf p -> CountOf p -> Ordering
$ccompare :: forall p. Ord p => CountOf p -> CountOf p -> Ordering
$cp1Ord :: forall p. Ord p => Eq (CountOf p)
Ord,a -> CountOf b -> CountOf a
(a -> b) -> CountOf a -> CountOf b
(forall a b. (a -> b) -> CountOf a -> CountOf b)
-> (forall a b. a -> CountOf b -> CountOf a) -> Functor CountOf
forall a b. a -> CountOf b -> CountOf a
forall a b. (a -> b) -> CountOf a -> CountOf b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CountOf b -> CountOf a
$c<$ :: forall a b. a -> CountOf b -> CountOf a
fmap :: (a -> b) -> CountOf a -> CountOf b
$cfmap :: forall a b. (a -> b) -> CountOf a -> CountOf b
Functor,a -> CountOf a -> Bool
CountOf m -> m
CountOf a -> [a]
CountOf a -> Bool
CountOf a -> Int
CountOf a -> a
CountOf a -> a
CountOf a -> a
CountOf a -> a
(a -> m) -> CountOf a -> m
(a -> m) -> CountOf a -> m
(a -> b -> b) -> b -> CountOf a -> b
(a -> b -> b) -> b -> CountOf a -> b
(b -> a -> b) -> b -> CountOf a -> b
(b -> a -> b) -> b -> CountOf a -> b
(a -> a -> a) -> CountOf a -> a
(a -> a -> a) -> CountOf a -> a
(forall m. Monoid m => CountOf m -> m)
-> (forall m a. Monoid m => (a -> m) -> CountOf a -> m)
-> (forall m a. Monoid m => (a -> m) -> CountOf a -> m)
-> (forall a b. (a -> b -> b) -> b -> CountOf a -> b)
-> (forall a b. (a -> b -> b) -> b -> CountOf a -> b)
-> (forall b a. (b -> a -> b) -> b -> CountOf a -> b)
-> (forall b a. (b -> a -> b) -> b -> CountOf a -> b)
-> (forall a. (a -> a -> a) -> CountOf a -> a)
-> (forall a. (a -> a -> a) -> CountOf a -> a)
-> (forall a. CountOf a -> [a])
-> (forall a. CountOf a -> Bool)
-> (forall a. CountOf a -> Int)
-> (forall a. Eq a => a -> CountOf a -> Bool)
-> (forall a. Ord a => CountOf a -> a)
-> (forall a. Ord a => CountOf a -> a)
-> (forall a. Num a => CountOf a -> a)
-> (forall a. Num a => CountOf a -> a)
-> Foldable CountOf
forall a. Eq a => a -> CountOf a -> Bool
forall a. Num a => CountOf a -> a
forall a. Ord a => CountOf a -> a
forall m. Monoid m => CountOf m -> m
forall a. CountOf a -> Bool
forall a. CountOf a -> Int
forall a. CountOf a -> [a]
forall a. (a -> a -> a) -> CountOf a -> a
forall m a. Monoid m => (a -> m) -> CountOf a -> m
forall b a. (b -> a -> b) -> b -> CountOf a -> b
forall a b. (a -> b -> b) -> b -> CountOf 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 :: CountOf a -> a
$cproduct :: forall a. Num a => CountOf a -> a
sum :: CountOf a -> a
$csum :: forall a. Num a => CountOf a -> a
minimum :: CountOf a -> a
$cminimum :: forall a. Ord a => CountOf a -> a
maximum :: CountOf a -> a
$cmaximum :: forall a. Ord a => CountOf a -> a
elem :: a -> CountOf a -> Bool
$celem :: forall a. Eq a => a -> CountOf a -> Bool
length :: CountOf a -> Int
$clength :: forall a. CountOf a -> Int
null :: CountOf a -> Bool
$cnull :: forall a. CountOf a -> Bool
toList :: CountOf a -> [a]
$ctoList :: forall a. CountOf a -> [a]
foldl1 :: (a -> a -> a) -> CountOf a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> CountOf a -> a
foldr1 :: (a -> a -> a) -> CountOf a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> CountOf a -> a
foldl' :: (b -> a -> b) -> b -> CountOf a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> CountOf a -> b
foldl :: (b -> a -> b) -> b -> CountOf a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> CountOf a -> b
foldr' :: (a -> b -> b) -> b -> CountOf a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> CountOf a -> b
foldr :: (a -> b -> b) -> b -> CountOf a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> CountOf a -> b
foldMap' :: (a -> m) -> CountOf a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> CountOf a -> m
foldMap :: (a -> m) -> CountOf a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> CountOf a -> m
fold :: CountOf m -> m
$cfold :: forall m. Monoid m => CountOf m -> m
Foldable,b -> CountOf p -> CountOf p
NonEmpty (CountOf p) -> CountOf p
CountOf p -> CountOf p -> CountOf p
(CountOf p -> CountOf p -> CountOf p)
-> (NonEmpty (CountOf p) -> CountOf p)
-> (forall b. Integral b => b -> CountOf p -> CountOf p)
-> Semigroup (CountOf p)
forall b. Integral b => b -> CountOf p -> CountOf p
forall p. NonEmpty (CountOf p) -> CountOf p
forall p. CountOf p -> CountOf p -> CountOf p
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall p b. Integral b => b -> CountOf p -> CountOf p
stimes :: b -> CountOf p -> CountOf p
$cstimes :: forall p b. Integral b => b -> CountOf p -> CountOf p
sconcat :: NonEmpty (CountOf p) -> CountOf p
$csconcat :: forall p. NonEmpty (CountOf p) -> CountOf p
<> :: CountOf p -> CountOf p -> CountOf p
$c<> :: forall p. CountOf p -> CountOf p -> CountOf p
Semigroup,Semigroup (CountOf p)
CountOf p
Semigroup (CountOf p)
-> CountOf p
-> (CountOf p -> CountOf p -> CountOf p)
-> ([CountOf p] -> CountOf p)
-> Monoid (CountOf p)
[CountOf p] -> CountOf p
CountOf p -> CountOf p -> CountOf p
forall p. Semigroup (CountOf p)
forall p. CountOf p
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall p. [CountOf p] -> CountOf p
forall p. CountOf p -> CountOf p -> CountOf p
mconcat :: [CountOf p] -> CountOf p
$cmconcat :: forall p. [CountOf p] -> CountOf p
mappend :: CountOf p -> CountOf p -> CountOf p
$cmappend :: forall p. CountOf p -> CountOf p -> CountOf p
mempty :: CountOf p
$cmempty :: forall p. CountOf p
$cp1Monoid :: forall p. Semigroup (CountOf p)
Monoid)

instance Measured (Count p) (CountOf p) where
  measure :: CountOf p -> Count p
measure (CountOf [p]
xs) = Int -> Count p
forall k (a :: k). Int -> Count a
Count (Int -> Count p) -> Int -> Count p
forall a b. (a -> b) -> a -> b
$ [p] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [p]
xs

createCountingTree :: Ord r => NonEmpty (r :+ [p]) -> RangeTree (Count p) (CountOf p) r
createCountingTree :: NonEmpty (r :+ [p]) -> RangeTree (Count p) (CountOf p) r
createCountingTree = NonEmpty (r :+ CountOf p) -> RangeTree (Count p) (CountOf p) r
forall r v p.
(Ord r, Measured v p, Semigroup p) =>
NonEmpty (r :+ p) -> RangeTree v p r
createTree (NonEmpty (r :+ CountOf p) -> RangeTree (Count p) (CountOf p) r)
-> (NonEmpty (r :+ [p]) -> NonEmpty (r :+ CountOf p))
-> NonEmpty (r :+ [p])
-> RangeTree (Count p) (CountOf p) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((r :+ [p]) -> r :+ CountOf p)
-> NonEmpty (r :+ [p]) -> NonEmpty (r :+ CountOf p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((r :+ [p]) -> ((r :+ [p]) -> r :+ CountOf p) -> r :+ CountOf p
forall a b. a -> (a -> b) -> b
&([p] -> Identity (CountOf p))
-> (r :+ [p]) -> Identity (r :+ CountOf p)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra (([p] -> Identity (CountOf p))
 -> (r :+ [p]) -> Identity (r :+ CountOf p))
-> ([p] -> CountOf p) -> (r :+ [p]) -> r :+ CountOf p
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [p] -> CountOf p
forall p. [p] -> CountOf p
CountOf)

-- | Perform a counting query
--
count    :: Ord r => Range r -> RangeTree (Count p) q r -> Int
count :: Range r -> RangeTree (Count p) q r -> Int
count Range r
qr = Count p -> Int
forall k (a :: k). Count a -> Int
getCount (Count p -> Int)
-> (RangeTree (Count p) q r -> Count p)
-> RangeTree (Count p) q r
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range r -> RangeTree (Count p) q r -> Count p
forall r v p. (Ord r, Monoid v) => Range r -> RangeTree v p r -> v
search Range r
qr