{-# LANGUAGE TemplateHaskell #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.SegmentTree.Generic
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
-- Description :  Implementation of SegmentTrees
--
--------------------------------------------------------------------------------
module Data.Geometry.SegmentTree.Generic( NodeData(..), splitPoint, range, assoc
                                        , LeafData(..), atomicRange, leafAssoc

                                        , SegmentTree(..), unSegmentTree
                                        , Assoc(..)

                                        , createTree, fromIntervals
                                        , insert, delete

                                        , search, stab

                                        , I(..), fromIntervals'

                                        , Count(..)
                                        ) where


import           Control.DeepSeq
import           Control.Lens
import           Data.BinaryTree
import           Data.Geometry.Interval
import           Data.Geometry.IntervalTree (IntervalLike(..))
import           Data.Geometry.Properties
import qualified Data.List as List
import           Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Measured.Class
import           Data.Measured.Size
import           GHC.Generics (Generic)

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

-- | Internal nodes store a split point, the range, and an associated data structure
data NodeData v r = NodeData { NodeData v r -> EndPoint r
_splitPoint :: !(EndPoint r)
                             , NodeData v r -> Range r
_range      :: !(Range 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,(forall x. NodeData v r -> Rep (NodeData v r) x)
-> (forall x. Rep (NodeData v r) x -> NodeData v r)
-> Generic (NodeData v r)
forall x. Rep (NodeData v r) x -> NodeData v r
forall x. NodeData v r -> Rep (NodeData v r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v r x. Rep (NodeData v r) x -> NodeData v r
forall v r x. NodeData v r -> Rep (NodeData v r) x
$cto :: forall v r x. Rep (NodeData v r) x -> NodeData v r
$cfrom :: forall v r x. NodeData v r -> Rep (NodeData v r) x
Generic)
makeLenses ''NodeData
instance (NFData v, NFData r) => NFData (NodeData v r)

-- | We store atomic ranges a bit more efficiently.
data AtomicRange r = Singleton !r | AtomicRange deriving (Int -> AtomicRange r -> ShowS
[AtomicRange r] -> ShowS
AtomicRange r -> String
(Int -> AtomicRange r -> ShowS)
-> (AtomicRange r -> String)
-> ([AtomicRange r] -> ShowS)
-> Show (AtomicRange r)
forall r. Show r => Int -> AtomicRange r -> ShowS
forall r. Show r => [AtomicRange r] -> ShowS
forall r. Show r => AtomicRange r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AtomicRange r] -> ShowS
$cshowList :: forall r. Show r => [AtomicRange r] -> ShowS
show :: AtomicRange r -> String
$cshow :: forall r. Show r => AtomicRange r -> String
showsPrec :: Int -> AtomicRange r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> AtomicRange r -> ShowS
Show,AtomicRange r -> AtomicRange r -> Bool
(AtomicRange r -> AtomicRange r -> Bool)
-> (AtomicRange r -> AtomicRange r -> Bool) -> Eq (AtomicRange r)
forall r. Eq r => AtomicRange r -> AtomicRange r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AtomicRange r -> AtomicRange r -> Bool
$c/= :: forall r. Eq r => AtomicRange r -> AtomicRange r -> Bool
== :: AtomicRange r -> AtomicRange r -> Bool
$c== :: forall r. Eq r => AtomicRange r -> AtomicRange r -> Bool
Eq,a -> AtomicRange b -> AtomicRange a
(a -> b) -> AtomicRange a -> AtomicRange b
(forall a b. (a -> b) -> AtomicRange a -> AtomicRange b)
-> (forall a b. a -> AtomicRange b -> AtomicRange a)
-> Functor AtomicRange
forall a b. a -> AtomicRange b -> AtomicRange a
forall a b. (a -> b) -> AtomicRange a -> AtomicRange b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AtomicRange b -> AtomicRange a
$c<$ :: forall a b. a -> AtomicRange b -> AtomicRange a
fmap :: (a -> b) -> AtomicRange a -> AtomicRange b
$cfmap :: forall a b. (a -> b) -> AtomicRange a -> AtomicRange b
Functor,(forall x. AtomicRange r -> Rep (AtomicRange r) x)
-> (forall x. Rep (AtomicRange r) x -> AtomicRange r)
-> Generic (AtomicRange r)
forall x. Rep (AtomicRange r) x -> AtomicRange r
forall x. AtomicRange r -> Rep (AtomicRange r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall r x. Rep (AtomicRange r) x -> AtomicRange r
forall r x. AtomicRange r -> Rep (AtomicRange r) x
$cto :: forall r x. Rep (AtomicRange r) x -> AtomicRange r
$cfrom :: forall r x. AtomicRange r -> Rep (AtomicRange r) x
Generic)
instance NFData r => NFData (AtomicRange r)

-- | Leaf nodes store an atomic range, and an associated data structure.
data LeafData v r = LeafData  { LeafData v r -> AtomicRange r
_atomicRange :: !(AtomicRange r)
                              , LeafData v r -> v
_leafAssoc   :: !v
                              } deriving (Int -> LeafData v r -> ShowS
[LeafData v r] -> ShowS
LeafData v r -> String
(Int -> LeafData v r -> ShowS)
-> (LeafData v r -> String)
-> ([LeafData v r] -> ShowS)
-> Show (LeafData v r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v r. (Show r, Show v) => Int -> LeafData v r -> ShowS
forall v r. (Show r, Show v) => [LeafData v r] -> ShowS
forall v r. (Show r, Show v) => LeafData v r -> String
showList :: [LeafData v r] -> ShowS
$cshowList :: forall v r. (Show r, Show v) => [LeafData v r] -> ShowS
show :: LeafData v r -> String
$cshow :: forall v r. (Show r, Show v) => LeafData v r -> String
showsPrec :: Int -> LeafData v r -> ShowS
$cshowsPrec :: forall v r. (Show r, Show v) => Int -> LeafData v r -> ShowS
Show,LeafData v r -> LeafData v r -> Bool
(LeafData v r -> LeafData v r -> Bool)
-> (LeafData v r -> LeafData v r -> Bool) -> Eq (LeafData v r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v r. (Eq r, Eq v) => LeafData v r -> LeafData v r -> Bool
/= :: LeafData v r -> LeafData v r -> Bool
$c/= :: forall v r. (Eq r, Eq v) => LeafData v r -> LeafData v r -> Bool
== :: LeafData v r -> LeafData v r -> Bool
$c== :: forall v r. (Eq r, Eq v) => LeafData v r -> LeafData v r -> Bool
Eq,a -> LeafData v b -> LeafData v a
(a -> b) -> LeafData v a -> LeafData v b
(forall a b. (a -> b) -> LeafData v a -> LeafData v b)
-> (forall a b. a -> LeafData v b -> LeafData v a)
-> Functor (LeafData v)
forall a b. a -> LeafData v b -> LeafData v a
forall a b. (a -> b) -> LeafData v a -> LeafData v b
forall v a b. a -> LeafData v b -> LeafData v a
forall v a b. (a -> b) -> LeafData v a -> LeafData v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LeafData v b -> LeafData v a
$c<$ :: forall v a b. a -> LeafData v b -> LeafData v a
fmap :: (a -> b) -> LeafData v a -> LeafData v b
$cfmap :: forall v a b. (a -> b) -> LeafData v a -> LeafData v b
Functor,(forall x. LeafData v r -> Rep (LeafData v r) x)
-> (forall x. Rep (LeafData v r) x -> LeafData v r)
-> Generic (LeafData v r)
forall x. Rep (LeafData v r) x -> LeafData v r
forall x. LeafData v r -> Rep (LeafData v r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v r x. Rep (LeafData v r) x -> LeafData v r
forall v r x. LeafData v r -> Rep (LeafData v r) x
$cto :: forall v r x. Rep (LeafData v r) x -> LeafData v r
$cfrom :: forall v r x. LeafData v r -> Rep (LeafData v r) x
Generic)
makeLenses ''LeafData
instance (NFData v, NFData r) => NFData (LeafData v r)

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

-- | Segment tree on a Fixed set of endpoints
newtype SegmentTree v r =
  SegmentTree { SegmentTree v r -> BinLeafTree (NodeData v r) (LeafData v r)
_unSegmentTree :: BinLeafTree (NodeData v r) (LeafData v r) }
    deriving (Int -> SegmentTree v r -> ShowS
[SegmentTree v r] -> ShowS
SegmentTree v r -> String
(Int -> SegmentTree v r -> ShowS)
-> (SegmentTree v r -> String)
-> ([SegmentTree v r] -> ShowS)
-> Show (SegmentTree v r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v r. (Show r, Show v) => Int -> SegmentTree v r -> ShowS
forall v r. (Show r, Show v) => [SegmentTree v r] -> ShowS
forall v r. (Show r, Show v) => SegmentTree v r -> String
showList :: [SegmentTree v r] -> ShowS
$cshowList :: forall v r. (Show r, Show v) => [SegmentTree v r] -> ShowS
show :: SegmentTree v r -> String
$cshow :: forall v r. (Show r, Show v) => SegmentTree v r -> String
showsPrec :: Int -> SegmentTree v r -> ShowS
$cshowsPrec :: forall v r. (Show r, Show v) => Int -> SegmentTree v r -> ShowS
Show,SegmentTree v r -> SegmentTree v r -> Bool
(SegmentTree v r -> SegmentTree v r -> Bool)
-> (SegmentTree v r -> SegmentTree v r -> Bool)
-> Eq (SegmentTree v r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v r.
(Eq r, Eq v) =>
SegmentTree v r -> SegmentTree v r -> Bool
/= :: SegmentTree v r -> SegmentTree v r -> Bool
$c/= :: forall v r.
(Eq r, Eq v) =>
SegmentTree v r -> SegmentTree v r -> Bool
== :: SegmentTree v r -> SegmentTree v r -> Bool
$c== :: forall v r.
(Eq r, Eq v) =>
SegmentTree v r -> SegmentTree v r -> Bool
Eq,(forall x. SegmentTree v r -> Rep (SegmentTree v r) x)
-> (forall x. Rep (SegmentTree v r) x -> SegmentTree v r)
-> Generic (SegmentTree v r)
forall x. Rep (SegmentTree v r) x -> SegmentTree v r
forall x. SegmentTree v r -> Rep (SegmentTree v r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v r x. Rep (SegmentTree v r) x -> SegmentTree v r
forall v r x. SegmentTree v r -> Rep (SegmentTree v r) x
$cto :: forall v r x. Rep (SegmentTree v r) x -> SegmentTree v r
$cfrom :: forall v r x. SegmentTree v r -> Rep (SegmentTree v r) x
Generic,SegmentTree v r -> ()
(SegmentTree v r -> ()) -> NFData (SegmentTree v r)
forall a. (a -> ()) -> NFData a
forall v r. (NFData v, NFData r) => SegmentTree v r -> ()
rnf :: SegmentTree v r -> ()
$crnf :: forall v r. (NFData v, NFData r) => SegmentTree v r -> ()
NFData)
makeLenses ''SegmentTree


-- rangeOf :: BinLeafTree (NodeData v r) (LeafData v r) -> Range (UnBounded r)
-- rangeOf (Node _ x _) = Val <$> x^.range
-- rangeOf (Leaf x)     = case x^.atomicRange of
--                         Singleton r -> ClsoedRange (Val r)     (Val r)
--                         AtomicRange -> OpenRange   MinInfinity MaxInfinity


data BuildLeaf a = LeafSingleton !a | LeafRange !a !a deriving (Int -> BuildLeaf a -> ShowS
[BuildLeaf a] -> ShowS
BuildLeaf a -> String
(Int -> BuildLeaf a -> ShowS)
-> (BuildLeaf a -> String)
-> ([BuildLeaf a] -> ShowS)
-> Show (BuildLeaf a)
forall a. Show a => Int -> BuildLeaf a -> ShowS
forall a. Show a => [BuildLeaf a] -> ShowS
forall a. Show a => BuildLeaf a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuildLeaf a] -> ShowS
$cshowList :: forall a. Show a => [BuildLeaf a] -> ShowS
show :: BuildLeaf a -> String
$cshow :: forall a. Show a => BuildLeaf a -> String
showsPrec :: Int -> BuildLeaf a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> BuildLeaf a -> ShowS
Show,BuildLeaf a -> BuildLeaf a -> Bool
(BuildLeaf a -> BuildLeaf a -> Bool)
-> (BuildLeaf a -> BuildLeaf a -> Bool) -> Eq (BuildLeaf a)
forall a. Eq a => BuildLeaf a -> BuildLeaf a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuildLeaf a -> BuildLeaf a -> Bool
$c/= :: forall a. Eq a => BuildLeaf a -> BuildLeaf a -> Bool
== :: BuildLeaf a -> BuildLeaf a -> Bool
$c== :: forall a. Eq a => BuildLeaf a -> BuildLeaf a -> Bool
Eq)

-- | Given a sorted list of endpoints, without duplicates, construct a segment tree
--
--
-- \(O(n)\) time
createTree                      :: NonEmpty r -> v -> SegmentTree v r
-- createTree (r NonEmpty.:| []) v = SegmentTree . Leaf $ LeafData (Singleton r) v
createTree :: NonEmpty r -> v -> SegmentTree v r
createTree NonEmpty r
pts                v
v = BinLeafTree (NodeData v r) (LeafData v r) -> SegmentTree v r
forall v r.
BinLeafTree (NodeData v r) (LeafData v r) -> SegmentTree v r
SegmentTree (BinLeafTree (NodeData v r) (LeafData v r) -> SegmentTree v r)
-> (NonEmpty (BuildLeaf r)
    -> BinLeafTree (NodeData v r) (LeafData v r))
-> NonEmpty (BuildLeaf r)
-> SegmentTree v r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuildLeaf r -> LeafData v r)
-> BinLeafTree (NodeData v r) (BuildLeaf r)
-> BinLeafTree (NodeData v r) (LeafData v r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BuildLeaf r -> LeafData v r
h (BinLeafTree (NodeData v r) (BuildLeaf r)
 -> BinLeafTree (NodeData v r) (LeafData v r))
-> (NonEmpty (BuildLeaf r)
    -> BinLeafTree (NodeData v r) (BuildLeaf r))
-> NonEmpty (BuildLeaf r)
-> BinLeafTree (NodeData v r) (LeafData v r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeData v r -> Size -> NodeData v r -> NodeData v r)
-> (BuildLeaf r -> NodeData v r)
-> BinLeafTree Size (BuildLeaf r)
-> BinLeafTree (NodeData v r) (BuildLeaf r)
forall w v a.
(w -> v -> w -> w)
-> (a -> w) -> BinLeafTree v a -> BinLeafTree w a
foldUpData NodeData v r -> Size -> NodeData v r -> NodeData v r
f BuildLeaf r -> NodeData v r
g (BinLeafTree Size (BuildLeaf r)
 -> BinLeafTree (NodeData v r) (BuildLeaf r))
-> (NonEmpty (BuildLeaf r) -> BinLeafTree Size (BuildLeaf r))
-> NonEmpty (BuildLeaf r)
-> BinLeafTree (NodeData v r) (BuildLeaf r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Elem (BuildLeaf r) -> BuildLeaf r)
-> BinLeafTree Size (Elem (BuildLeaf r))
-> BinLeafTree Size (BuildLeaf r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Elem (BuildLeaf r) -> BuildLeaf r
forall a. Elem a -> a
_unElem
                                (BinLeafTree Size (Elem (BuildLeaf r))
 -> BinLeafTree Size (BuildLeaf r))
-> (NonEmpty (BuildLeaf r)
    -> BinLeafTree Size (Elem (BuildLeaf r)))
-> NonEmpty (BuildLeaf r)
-> BinLeafTree Size (BuildLeaf r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (BuildLeaf r) -> BinLeafTree Size (Elem (BuildLeaf r))
forall a. NonEmpty a -> BinLeafTree Size (Elem a)
asBalancedBinLeafTree (NonEmpty (BuildLeaf r) -> SegmentTree v r)
-> NonEmpty (BuildLeaf r) -> SegmentTree v r
forall a b. (a -> b) -> a -> b
$ NonEmpty (BuildLeaf r)
ranges
  where
    h :: BuildLeaf r -> LeafData v r
h (LeafSingleton r
r) = AtomicRange r -> v -> LeafData v r
forall v r. AtomicRange r -> v -> LeafData v r
LeafData (r -> AtomicRange r
forall r. r -> AtomicRange r
Singleton r
r) v
v
    h (LeafRange   r
_ r
_) = AtomicRange r -> v -> LeafData v r
forall v r. AtomicRange r -> v -> LeafData v r
LeafData AtomicRange r
forall r. AtomicRange r
AtomicRange   v
v

    f :: NodeData v r -> Size -> NodeData v r -> NodeData v r
f NodeData v r
l Size
_ NodeData v r
r = let m :: EndPoint r
m  = NodeData v r
lNodeData v r
-> Getting (EndPoint r) (NodeData v r) (EndPoint r) -> EndPoint r
forall s a. s -> Getting a s a -> a
^.(Range r -> Const (EndPoint r) (Range r))
-> NodeData v r -> Const (EndPoint r) (NodeData v r)
forall v r. Lens' (NodeData v r) (Range r)
range((Range r -> Const (EndPoint r) (Range r))
 -> NodeData v r -> Const (EndPoint r) (NodeData v r))
-> ((EndPoint r -> Const (EndPoint r) (EndPoint r))
    -> Range r -> Const (EndPoint r) (Range r))
-> Getting (EndPoint r) (NodeData v r) (EndPoint r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EndPoint r -> Const (EndPoint r) (EndPoint r))
-> Range r -> Const (EndPoint r) (Range r)
forall a. Lens' (Range a) (EndPoint a)
upper
                  ll :: EndPoint r
ll = NodeData v r
lNodeData v r
-> Getting (EndPoint r) (NodeData v r) (EndPoint r) -> EndPoint r
forall s a. s -> Getting a s a -> a
^.(Range r -> Const (EndPoint r) (Range r))
-> NodeData v r -> Const (EndPoint r) (NodeData v r)
forall v r. Lens' (NodeData v r) (Range r)
range((Range r -> Const (EndPoint r) (Range r))
 -> NodeData v r -> Const (EndPoint r) (NodeData v r))
-> ((EndPoint r -> Const (EndPoint r) (EndPoint r))
    -> Range r -> Const (EndPoint r) (Range r))
-> Getting (EndPoint r) (NodeData v r) (EndPoint r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EndPoint r -> Const (EndPoint r) (EndPoint r))
-> Range r -> Const (EndPoint r) (Range r)
forall a. Lens' (Range a) (EndPoint a)
lower
                  rr :: EndPoint r
rr = NodeData v r
rNodeData v r
-> Getting (EndPoint r) (NodeData v r) (EndPoint r) -> EndPoint r
forall s a. s -> Getting a s a -> a
^.(Range r -> Const (EndPoint r) (Range r))
-> NodeData v r -> Const (EndPoint r) (NodeData v r)
forall v r. Lens' (NodeData v r) (Range r)
range((Range r -> Const (EndPoint r) (Range r))
 -> NodeData v r -> Const (EndPoint r) (NodeData v r))
-> ((EndPoint r -> Const (EndPoint r) (EndPoint r))
    -> Range r -> Const (EndPoint r) (Range r))
-> Getting (EndPoint r) (NodeData v r) (EndPoint r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EndPoint r -> Const (EndPoint r) (EndPoint r))
-> Range r -> Const (EndPoint r) (Range r)
forall a. Lens' (Range a) (EndPoint a)
upper
              in EndPoint r -> Range r -> v -> NodeData v r
forall v r. EndPoint r -> Range r -> v -> NodeData v r
NodeData EndPoint r
m (EndPoint r -> EndPoint r -> Range r
forall a. EndPoint a -> EndPoint a -> Range a
Range EndPoint r
ll EndPoint r
rr) v
v
    -- | Singletons map to closed singleton ranges, Ranges map to open ranges
    g :: BuildLeaf r -> NodeData v r
g (LeafSingleton r
r) = EndPoint r -> Range r -> v -> NodeData v r
forall v r. EndPoint r -> Range r -> v -> NodeData v r
NodeData (r -> EndPoint r
forall a. a -> EndPoint a
Closed r
r) (r -> r -> Range r
forall a. a -> a -> Range a
ClosedRange r
r r
r) v
v
    g (LeafRange   r
s r
r) = EndPoint r -> Range r -> v -> NodeData v r
forall v r. EndPoint r -> Range r -> v -> NodeData v r
NodeData (r -> EndPoint r
forall a. a -> EndPoint a
Open r
r)   (r -> r -> Range r
forall a. a -> a -> Range a
OpenRange   r
s r
r) v
v


    ranges :: NonEmpty (BuildLeaf r)
ranges  = NonEmpty (BuildLeaf r) -> [BuildLeaf r] -> NonEmpty (BuildLeaf r)
forall a. NonEmpty a -> [a] -> NonEmpty a
interleave ((r -> BuildLeaf r) -> NonEmpty r -> NonEmpty (BuildLeaf r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> BuildLeaf r
forall a. a -> BuildLeaf a
LeafSingleton NonEmpty r
pts) [BuildLeaf r]
ranges'
    ranges' :: [BuildLeaf r]
ranges' = (r -> r -> BuildLeaf r) -> [r] -> [r] -> [BuildLeaf r]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith r -> r -> BuildLeaf r
forall a. a -> a -> BuildLeaf a
LeafRange (NonEmpty r -> [r]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty r
pts) (NonEmpty r -> [r]
forall a. NonEmpty a -> [a]
NonEmpty.tail NonEmpty r
pts)




-- | Interleaves the two lists
--
-- >>> interleave (NonEmpty.fromList ["0","1","2"]) ["01","12"]
-- "0" :| ["01","1","12","2"]
interleave                       :: NonEmpty a -> [a] -> NonEmpty a
interleave :: NonEmpty a -> [a] -> NonEmpty a
interleave (a
x NonEmpty.:| [a]
xs) [a]
ys = a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((a -> a -> [a]) -> [a] -> [a] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
a a
b -> [a
a,a
b]) [a]
ys [a]
xs)


-- | Build a SegmentTree
--
-- \(O(n \log n)\)
fromIntervals      :: (Ord r, Eq p, Assoc v i, IntervalLike i, Monoid v, NumType i ~ r)
                   => (Interval p r -> i)
                   -> NonEmpty (Interval p r) -> SegmentTree v r
fromIntervals :: (Interval p r -> i) -> NonEmpty (Interval p r) -> SegmentTree v r
fromIntervals Interval p r -> i
f NonEmpty (Interval p r)
is = (Interval p r -> SegmentTree v r -> SegmentTree v r)
-> SegmentTree v r -> NonEmpty (Interval p r) -> SegmentTree v r
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (i -> SegmentTree v r -> SegmentTree v r
forall v i r.
(Assoc v i, NumType i ~ r, Ord r, IntervalLike i) =>
i -> SegmentTree v r -> SegmentTree v r
insert (i -> SegmentTree v r -> SegmentTree v r)
-> (Interval p r -> i)
-> Interval p r
-> SegmentTree v r
-> SegmentTree v r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interval p r -> i
f) (NonEmpty r -> v -> SegmentTree v r
forall r v. NonEmpty r -> v -> SegmentTree v r
createTree NonEmpty r
pts v
forall a. Monoid a => a
mempty) NonEmpty (Interval p r)
is
  where
    endPoints :: i -> [NumType i]
endPoints (i -> Range (NumType i)
forall i. IntervalLike i => i -> Range (NumType i)
asRange -> Range' a b) = [NumType i
a,NumType i
b]
    pts :: NonEmpty r
pts = NonEmpty r -> NonEmpty r
nub' (NonEmpty r -> NonEmpty r)
-> (NonEmpty (Interval p r) -> NonEmpty r)
-> NonEmpty (Interval p r)
-> NonEmpty r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty r -> NonEmpty r
forall a. Ord a => NonEmpty a -> NonEmpty a
NonEmpty.sort (NonEmpty r -> NonEmpty r)
-> (NonEmpty (Interval p r) -> NonEmpty r)
-> NonEmpty (Interval p r)
-> NonEmpty r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [r] -> NonEmpty r
forall a. [a] -> NonEmpty a
NonEmpty.fromList ([r] -> NonEmpty r)
-> (NonEmpty (Interval p r) -> [r])
-> NonEmpty (Interval p r)
-> NonEmpty r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Interval p r -> [r]) -> NonEmpty (Interval p r) -> [r]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Interval p r -> [r]
forall i. IntervalLike i => i -> [NumType i]
endPoints (NonEmpty (Interval p r) -> NonEmpty r)
-> NonEmpty (Interval p r) -> NonEmpty r
forall a b. (a -> b) -> a -> b
$ NonEmpty (Interval p r)
is
    nub' :: NonEmpty r -> NonEmpty r
nub' = (NonEmpty r -> r) -> NonEmpty (NonEmpty r) -> NonEmpty r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty r -> r
forall a. NonEmpty a -> a
NonEmpty.head (NonEmpty (NonEmpty r) -> NonEmpty r)
-> (NonEmpty r -> NonEmpty (NonEmpty r))
-> NonEmpty r
-> NonEmpty r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty r -> NonEmpty (NonEmpty r)
forall a. Eq a => NonEmpty a -> NonEmpty (NonEmpty a)
NonEmpty.group1

-- -- | lists all intervals
-- toList :: SegmentTree v r -> [i]
-- toList = undefined

--------------------------------------------------------------------------------
-- * Searching

-- | Search for all intervals intersecting x
--
-- \(O(\log n + k)\) where \(k\) is the output size
search   :: (Ord r, Monoid v) => r -> SegmentTree v r -> v
search :: r -> SegmentTree v r -> v
search r
x = [v] -> v
forall a. Monoid a => [a] -> a
mconcat ([v] -> v) -> (SegmentTree v r -> [v]) -> SegmentTree v r -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> SegmentTree v r -> [v]
forall r v. Ord r => r -> SegmentTree v r -> [v]
stab r
x



inAtomicRange                   :: Eq r => r -> AtomicRange r -> Bool
r
x inAtomicRange :: r -> AtomicRange r -> Bool
`inAtomicRange` (Singleton r
r) = r
x r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
r
r
_ `inAtomicRange` AtomicRange r
AtomicRange   = Bool
True


-- | Returns the associated values of the nodes on the search path to x
--
-- \(O(\log n)\)
stab                   :: Ord r => r -> SegmentTree v r -> [v]
stab :: r -> SegmentTree v r -> [v]
stab r
x (SegmentTree BinLeafTree (NodeData v r) (LeafData v r)
t) = BinLeafTree (NodeData v r) (LeafData v r) -> [v]
stabRoot BinLeafTree (NodeData v r) (LeafData v r)
t
  where
    stabRoot :: BinLeafTree (NodeData v r) (LeafData v r) -> [v]
stabRoot (Leaf (LeafData AtomicRange r
rr v
v))
      | r
x r -> AtomicRange r -> Bool
forall r. Eq r => r -> AtomicRange r -> Bool
`inAtomicRange` AtomicRange r
rr = [v
v]
      | Bool
otherwise            = []
    stabRoot (Node BinLeafTree (NodeData v r) (LeafData v r)
l (NodeData EndPoint r
m Range r
rr v
v) BinLeafTree (NodeData v r) (LeafData v r)
r) = case (r
x r -> Range r -> Bool
forall a. Ord a => a -> Range a -> Bool
`inRange` Range r
rr, r -> EndPoint r
forall a. a -> EndPoint a
Closed r
x EndPoint r -> EndPoint r -> Bool
forall a. Ord a => a -> a -> Bool
<= EndPoint r
m) of
      (Bool
False,Bool
_)   -> []
      (Bool
True,Bool
True) -> v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: BinLeafTree (NodeData v r) (LeafData v r) -> [v]
stab' BinLeafTree (NodeData v r) (LeafData v r)
l
      (Bool, Bool)
_           -> v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: BinLeafTree (NodeData v r) (LeafData v r) -> [v]
stab' BinLeafTree (NodeData v r) (LeafData v r)
r

    stab' :: BinLeafTree (NodeData v r) (LeafData v r) -> [v]
stab' (Leaf (LeafData AtomicRange r
rr v
v))      | r
x r -> AtomicRange r -> Bool
forall r. Eq r => r -> AtomicRange r -> Bool
`inAtomicRange` AtomicRange r
rr = [v
v]
                                      | Bool
otherwise            = []
    stab' (Node BinLeafTree (NodeData v r) (LeafData v r)
l (NodeData EndPoint r
m Range r
_ v
v) BinLeafTree (NodeData v r) (LeafData v r)
r) | r -> EndPoint r
forall a. a -> EndPoint a
Closed r
x EndPoint r -> EndPoint r -> Bool
forall a. Ord a => a -> a -> Bool
<= EndPoint r
m        = v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: BinLeafTree (NodeData v r) (LeafData v r) -> [v]
stab' BinLeafTree (NodeData v r) (LeafData v r)
l
                                      | Bool
otherwise            = v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: BinLeafTree (NodeData v r) (LeafData v r) -> [v]
stab' BinLeafTree (NodeData v r) (LeafData v r)
r


--------------------------------------------------------------------------------
-- * Inserting intervals

-- | Class for associcated data structures
class Measured v i => Assoc v i where
  insertAssoc :: i -> v -> v
  deleteAssoc :: i -> v -> v

-- | Gets the range associated with this node
getRange  :: BinLeafTree (NodeData v r) (LeafData t r) -> Maybe (Range r)
getRange :: BinLeafTree (NodeData v r) (LeafData t r) -> Maybe (Range r)
getRange (Leaf (LeafData (Singleton r
r) t
_)) = Range r -> Maybe (Range r)
forall a. a -> Maybe a
Just (Range r -> Maybe (Range r)) -> Range r -> Maybe (Range r)
forall a b. (a -> b) -> a -> b
$ EndPoint r -> EndPoint r -> Range r
forall a. EndPoint a -> EndPoint a -> Range a
Range (r -> EndPoint r
forall a. a -> EndPoint a
Closed r
r) (r -> EndPoint r
forall a. a -> EndPoint a
Closed r
r)
getRange (Leaf LeafData t r
_)                          = Maybe (Range r)
forall a. Maybe a
Nothing
getRange (Node BinLeafTree (NodeData v r) (LeafData t r)
_ NodeData v r
nd BinLeafTree (NodeData v r) (LeafData t r)
_)                     = Range r -> Maybe (Range r)
forall a. a -> Maybe a
Just (Range r -> Maybe (Range r)) -> Range r -> Maybe (Range r)
forall a b. (a -> b) -> a -> b
$ NodeData v r
ndNodeData v r
-> Getting (Range r) (NodeData v r) (Range r) -> Range r
forall s a. s -> Getting a s a -> a
^.Getting (Range r) (NodeData v r) (Range r)
forall v r. Lens' (NodeData v r) (Range r)
range

coversAtomic                      :: Ord r
                                  => Range r -> Range r -> AtomicRange r -> Bool
coversAtomic :: Range r -> Range r -> AtomicRange r -> Bool
coversAtomic Range r
ri Range r
_   (Singleton r
r) = r
r r -> Range r -> Bool
forall a. Ord a => a -> Range a -> Bool
`inRange` Range r
ri
coversAtomic Range r
ri Range r
inR AtomicRange r
AtomicRange   = Range r
ri Range r -> Range r -> Bool
forall a. Ord a => Range a -> Range a -> Bool
`covers` Range r
inR

-- | Pre: the interval should have one of the endpoints on which the tree is built.
insert                   :: (Assoc v i, NumType i ~ r, Ord r, IntervalLike i)
                         => i -> SegmentTree v r -> SegmentTree v r
insert :: i -> SegmentTree v r -> SegmentTree v r
insert i
i (SegmentTree BinLeafTree (NodeData v r) (LeafData v r)
t) = BinLeafTree (NodeData v r) (LeafData v r) -> SegmentTree v r
forall v r.
BinLeafTree (NodeData v r) (LeafData v r) -> SegmentTree v r
SegmentTree (BinLeafTree (NodeData v r) (LeafData v r) -> SegmentTree v r)
-> BinLeafTree (NodeData v r) (LeafData v r) -> SegmentTree v r
forall a b. (a -> b) -> a -> b
$ BinLeafTree (NodeData v r) (LeafData v r)
-> BinLeafTree (NodeData v r) (LeafData v r)
insertRoot BinLeafTree (NodeData v r) (LeafData v r)
t
  where
    ri :: Range r
ri@(Range EndPoint r
a EndPoint r
b) = i -> Range (NumType i)
forall i. IntervalLike i => i -> Range (NumType i)
asRange i
i
    insertRoot :: BinLeafTree (NodeData v r) (LeafData v r)
-> BinLeafTree (NodeData v r) (LeafData v r)
insertRoot BinLeafTree (NodeData v r) (LeafData v r)
t' = BinLeafTree (NodeData v r) (LeafData v r)
-> (Range r -> BinLeafTree (NodeData v r) (LeafData v r))
-> Maybe (Range r)
-> BinLeafTree (NodeData v r) (LeafData v r)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BinLeafTree (NodeData v r) (LeafData v r)
t' (Range r
-> BinLeafTree (NodeData v r) (LeafData v r)
-> BinLeafTree (NodeData v r) (LeafData v r)
`insert'` BinLeafTree (NodeData v r) (LeafData v r)
t') (Maybe (Range r) -> BinLeafTree (NodeData v r) (LeafData v r))
-> Maybe (Range r) -> BinLeafTree (NodeData v r) (LeafData v r)
forall a b. (a -> b) -> a -> b
$ BinLeafTree (NodeData v r) (LeafData v r) -> Maybe (Range r)
forall v r t.
BinLeafTree (NodeData v r) (LeafData t r) -> Maybe (Range r)
getRange BinLeafTree (NodeData v r) (LeafData v r)
t'

    insert' :: Range r
-> BinLeafTree (NodeData v r) (LeafData v r)
-> BinLeafTree (NodeData v r) (LeafData v r)
insert' Range r
inR         lf :: BinLeafTree (NodeData v r) (LeafData v r)
lf@(Leaf nd :: LeafData v r
nd@(LeafData AtomicRange r
rr v
_))
      | Range r -> Range r -> AtomicRange r -> Bool
forall r. Ord r => Range r -> Range r -> AtomicRange r -> Bool
coversAtomic Range r
ri Range r
inR AtomicRange r
rr = LeafData v r -> BinLeafTree (NodeData v r) (LeafData v r)
forall v a. a -> BinLeafTree v a
Leaf (LeafData v r -> BinLeafTree (NodeData v r) (LeafData v r))
-> LeafData v r -> BinLeafTree (NodeData v r) (LeafData v r)
forall a b. (a -> b) -> a -> b
$ LeafData v r
ndLeafData v r -> (LeafData v r -> LeafData v r) -> LeafData v r
forall a b. a -> (a -> b) -> b
&(v -> Identity v) -> LeafData v r -> Identity (LeafData v r)
forall v r v. Lens (LeafData v r) (LeafData v r) v v
leafAssoc ((v -> Identity v) -> LeafData v r -> Identity (LeafData v r))
-> (v -> v) -> LeafData v r -> LeafData v r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ i -> v -> v
forall v i. Assoc v i => i -> v -> v
insertAssoc i
i
      | Bool
otherwise              = BinLeafTree (NodeData v r) (LeafData v r)
lf
    insert' (Range EndPoint r
c EndPoint r
d) (Node BinLeafTree (NodeData v r) (LeafData v r)
l nd :: NodeData v r
nd@(NodeData EndPoint r
m Range r
rr v
_) BinLeafTree (NodeData v r) (LeafData v r)
r)
      | Range r
ri Range r -> Range r -> Bool
forall a. Ord a => Range a -> Range a -> Bool
`covers` Range r
rr       = BinLeafTree (NodeData v r) (LeafData v r)
-> NodeData v r
-> BinLeafTree (NodeData v r) (LeafData v r)
-> BinLeafTree (NodeData v r) (LeafData v r)
forall v a.
BinLeafTree v a -> v -> BinLeafTree v a -> BinLeafTree v a
Node BinLeafTree (NodeData v r) (LeafData v r)
l (NodeData v r
ndNodeData v r -> (NodeData v r -> NodeData v r) -> NodeData v r
forall a b. a -> (a -> b) -> b
&(v -> Identity v) -> NodeData v r -> Identity (NodeData v r)
forall v r v. Lens (NodeData v r) (NodeData v r) v v
assoc ((v -> Identity v) -> NodeData v r -> Identity (NodeData v r))
-> (v -> v) -> NodeData v r -> NodeData v r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ i -> v -> v
forall v i. Assoc v i => i -> v -> v
insertAssoc i
i) BinLeafTree (NodeData v r) (LeafData v r)
r
      | Bool
otherwise            = BinLeafTree (NodeData v r) (LeafData v r)
-> NodeData v r
-> BinLeafTree (NodeData v r) (LeafData v r)
-> BinLeafTree (NodeData v r) (LeafData v r)
forall v a.
BinLeafTree v a -> v -> BinLeafTree v a -> BinLeafTree v a
Node BinLeafTree (NodeData v r) (LeafData v r)
l' NodeData v r
nd BinLeafTree (NodeData v r) (LeafData v r)
r'
      where
           -- check if the range intersects the range of the left subtree
        l' :: BinLeafTree (NodeData v r) (LeafData v r)
l'  = if EndPoint r
a EndPoint r -> EndPoint r -> Bool
forall a. Ord a => a -> a -> Bool
<= EndPoint r
m then Range r
-> BinLeafTree (NodeData v r) (LeafData v r)
-> BinLeafTree (NodeData v r) (LeafData v r)
insert' (EndPoint r -> EndPoint r -> Range r
forall a. EndPoint a -> EndPoint a -> Range a
Range EndPoint r
c          EndPoint r
m) BinLeafTree (NodeData v r) (LeafData v r)
l else BinLeafTree (NodeData v r) (LeafData v r)
l
        r' :: BinLeafTree (NodeData v r) (LeafData v r)
r'  = if EndPoint r
m EndPoint r -> EndPoint r -> Bool
forall a. Ord a => a -> a -> Bool
< EndPoint r
b  then Range r
-> BinLeafTree (NodeData v r) (LeafData v r)
-> BinLeafTree (NodeData v r) (LeafData v r)
insert' (EndPoint r -> EndPoint r -> Range r
forall a. EndPoint a -> EndPoint a -> Range a
Range (EndPoint r -> EndPoint r
forall a. EndPoint a -> EndPoint a
toOpen EndPoint r
m) EndPoint r
d) BinLeafTree (NodeData v r) (LeafData v r)
r else BinLeafTree (NodeData v r) (LeafData v r)
r

    toOpen :: EndPoint a -> EndPoint a
toOpen = a -> EndPoint a
forall a. a -> EndPoint a
Open (a -> EndPoint a) -> (EndPoint a -> a) -> EndPoint a -> EndPoint a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting a (EndPoint a) a -> EndPoint a -> a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting a (EndPoint a) a
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint

-- | Delete an interval from the tree
--
-- pre: The segment is in the tree!
delete :: (Assoc v i, NumType i ~ r, Ord r, IntervalLike i)
          => i -> SegmentTree v r -> SegmentTree v r
delete :: i -> SegmentTree v r -> SegmentTree v r
delete i
i (SegmentTree BinLeafTree (NodeData v r) (LeafData v r)
t) = BinLeafTree (NodeData v r) (LeafData v r) -> SegmentTree v r
forall v r.
BinLeafTree (NodeData v r) (LeafData v r) -> SegmentTree v r
SegmentTree (BinLeafTree (NodeData v r) (LeafData v r) -> SegmentTree v r)
-> BinLeafTree (NodeData v r) (LeafData v r) -> SegmentTree v r
forall a b. (a -> b) -> a -> b
$ BinLeafTree (NodeData v r) (LeafData v r)
-> BinLeafTree (NodeData v r) (LeafData v r)
delete' BinLeafTree (NodeData v r) (LeafData v r)
t
  where
    (Range EndPoint r
_ EndPoint r
b) = i -> Range (NumType i)
forall i. IntervalLike i => i -> Range (NumType i)
asRange i
i

    delete' :: BinLeafTree (NodeData v r) (LeafData v r)
-> BinLeafTree (NodeData v r) (LeafData v r)
delete' (Leaf LeafData v r
ld) = LeafData v r -> BinLeafTree (NodeData v r) (LeafData v r)
forall v a. a -> BinLeafTree v a
Leaf (LeafData v r -> BinLeafTree (NodeData v r) (LeafData v r))
-> LeafData v r -> BinLeafTree (NodeData v r) (LeafData v r)
forall a b. (a -> b) -> a -> b
$ LeafData v r
ldLeafData v r -> (LeafData v r -> LeafData v r) -> LeafData v r
forall a b. a -> (a -> b) -> b
&(v -> Identity v) -> LeafData v r -> Identity (LeafData v r)
forall v r v. Lens (LeafData v r) (LeafData v r) v v
leafAssoc ((v -> Identity v) -> LeafData v r -> Identity (LeafData v r))
-> (v -> v) -> LeafData v r -> LeafData v r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ i -> v -> v
forall v i. Assoc v i => i -> v -> v
deleteAssoc i
i
    delete' (Node BinLeafTree (NodeData v r) (LeafData v r)
l nd :: NodeData v r
nd@(NodeData v r -> EndPoint r
forall v r. NodeData v r -> EndPoint r
_splitPoint -> EndPoint r
m) BinLeafTree (NodeData v r) (LeafData v r)
r)
      | EndPoint r
b EndPoint r -> EndPoint r -> Bool
forall a. Ord a => a -> a -> Bool
<= EndPoint r
m    = BinLeafTree (NodeData v r) (LeafData v r)
-> NodeData v r
-> BinLeafTree (NodeData v r) (LeafData v r)
-> BinLeafTree (NodeData v r) (LeafData v r)
forall v a.
BinLeafTree v a -> v -> BinLeafTree v a -> BinLeafTree v a
Node (BinLeafTree (NodeData v r) (LeafData v r)
-> BinLeafTree (NodeData v r) (LeafData v r)
delete' BinLeafTree (NodeData v r) (LeafData v r)
l) (NodeData v r
ndNodeData v r -> (NodeData v r -> NodeData v r) -> NodeData v r
forall a b. a -> (a -> b) -> b
&(v -> Identity v) -> NodeData v r -> Identity (NodeData v r)
forall v r v. Lens (NodeData v r) (NodeData v r) v v
assoc ((v -> Identity v) -> NodeData v r -> Identity (NodeData v r))
-> (v -> v) -> NodeData v r -> NodeData v r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ i -> v -> v
forall v i. Assoc v i => i -> v -> v
deleteAssoc i
i) BinLeafTree (NodeData v r) (LeafData v r)
r
      | Bool
otherwise = BinLeafTree (NodeData v r) (LeafData v r)
-> NodeData v r
-> BinLeafTree (NodeData v r) (LeafData v r)
-> BinLeafTree (NodeData v r) (LeafData v r)
forall v a.
BinLeafTree v a -> v -> BinLeafTree v a -> BinLeafTree v a
Node BinLeafTree (NodeData v r) (LeafData v r)
l           (NodeData v r
ndNodeData v r -> (NodeData v r -> NodeData v r) -> NodeData v r
forall a b. a -> (a -> b) -> b
&(v -> Identity v) -> NodeData v r -> Identity (NodeData v r)
forall v r v. Lens (NodeData v r) (NodeData v r) v v
assoc ((v -> Identity v) -> NodeData v r -> Identity (NodeData v r))
-> (v -> v) -> NodeData v r -> NodeData v r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ i -> v -> v
forall v i. Assoc v i => i -> v -> v
deleteAssoc i
i) (BinLeafTree (NodeData v r) (LeafData v r)
-> BinLeafTree (NodeData v r) (LeafData v r)
delete' BinLeafTree (NodeData v r) (LeafData v r)
r)

    -- delete'' (Leaf ld)     = Leaf $ ld&leafAssoc %~ deleteAssoc i
    -- delete'' (Node l nd r) = Node l (nd&assoc %~ deleteAssoc i) r

    -- deleteL (Leaf ld)     = Leaf $ ld&leafAssoc %~ deleteAssoc i
    -- deleteL (Node l nd@(_splitPoint -> m) r)
    --   | a <= m    = Node (deleteL l) (nd&assoc %~ deleteAssoc i) (delete'' r)
    --   | otherwise = Node l nd (deleteL r)

    -- deleteR (Leaf ld)     = Leaf $ ld&leafAssoc %~ deleteAssoc i
    -- deleteR (Node l nd@(_splitPoint -> m) r)
    --   | m <= b    = Node (delete'' l) (nd&assoc %~ deleteAssoc i) (deleteR r)
    --   | otherwise = Node (deleteR l) nd r


--------------------------------------------------------------------------------
-- * Listing the intervals stabbed

-- | Interval
newtype I a = I { I a -> a
_unI :: a} deriving (Int -> I a -> ShowS
[I a] -> ShowS
I a -> String
(Int -> I a -> ShowS)
-> (I a -> String) -> ([I a] -> ShowS) -> Show (I a)
forall a. Show a => Int -> I a -> ShowS
forall a. Show a => [I a] -> ShowS
forall a. Show a => I a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [I a] -> ShowS
$cshowList :: forall a. Show a => [I a] -> ShowS
show :: I a -> String
$cshow :: forall a. Show a => I a -> String
showsPrec :: Int -> I a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> I a -> ShowS
Show,ReadPrec [I a]
ReadPrec (I a)
Int -> ReadS (I a)
ReadS [I a]
(Int -> ReadS (I a))
-> ReadS [I a] -> ReadPrec (I a) -> ReadPrec [I a] -> Read (I a)
forall a. Read a => ReadPrec [I a]
forall a. Read a => ReadPrec (I a)
forall a. Read a => Int -> ReadS (I a)
forall a. Read a => ReadS [I a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [I a]
$creadListPrec :: forall a. Read a => ReadPrec [I a]
readPrec :: ReadPrec (I a)
$creadPrec :: forall a. Read a => ReadPrec (I a)
readList :: ReadS [I a]
$creadList :: forall a. Read a => ReadS [I a]
readsPrec :: Int -> ReadS (I a)
$creadsPrec :: forall a. Read a => Int -> ReadS (I a)
Read,I a -> I a -> Bool
(I a -> I a -> Bool) -> (I a -> I a -> Bool) -> Eq (I a)
forall a. Eq a => I a -> I a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: I a -> I a -> Bool
$c/= :: forall a. Eq a => I a -> I a -> Bool
== :: I a -> I a -> Bool
$c== :: forall a. Eq a => I a -> I a -> Bool
Eq,Eq (I a)
Eq (I a)
-> (I a -> I a -> Ordering)
-> (I a -> I a -> Bool)
-> (I a -> I a -> Bool)
-> (I a -> I a -> Bool)
-> (I a -> I a -> Bool)
-> (I a -> I a -> I a)
-> (I a -> I a -> I a)
-> Ord (I a)
I a -> I a -> Bool
I a -> I a -> Ordering
I a -> I a -> I a
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 a. Ord a => Eq (I a)
forall a. Ord a => I a -> I a -> Bool
forall a. Ord a => I a -> I a -> Ordering
forall a. Ord a => I a -> I a -> I a
min :: I a -> I a -> I a
$cmin :: forall a. Ord a => I a -> I a -> I a
max :: I a -> I a -> I a
$cmax :: forall a. Ord a => I a -> I a -> I a
>= :: I a -> I a -> Bool
$c>= :: forall a. Ord a => I a -> I a -> Bool
> :: I a -> I a -> Bool
$c> :: forall a. Ord a => I a -> I a -> Bool
<= :: I a -> I a -> Bool
$c<= :: forall a. Ord a => I a -> I a -> Bool
< :: I a -> I a -> Bool
$c< :: forall a. Ord a => I a -> I a -> Bool
compare :: I a -> I a -> Ordering
$ccompare :: forall a. Ord a => I a -> I a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (I a)
Ord,(forall x. I a -> Rep (I a) x)
-> (forall x. Rep (I a) x -> I a) -> Generic (I a)
forall x. Rep (I a) x -> I a
forall x. I a -> Rep (I a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (I a) x -> I a
forall a x. I a -> Rep (I a) x
$cto :: forall a x. Rep (I a) x -> I a
$cfrom :: forall a x. I a -> Rep (I a) x
Generic,I a -> ()
(I a -> ()) -> NFData (I a)
forall a. NFData a => I a -> ()
forall a. (a -> ()) -> NFData a
rnf :: I a -> ()
$crnf :: forall a. NFData a => I a -> ()
NFData)

type instance NumType (I a) = NumType a

instance Measured [I a] (I a) where
  measure :: I a -> [I a]
measure = (I a -> [I a] -> [I a]
forall a. a -> [a] -> [a]
:[])

instance Eq a => Assoc [I a] (I a) where
  insertAssoc :: I a -> [I a] -> [I a]
insertAssoc = (:)
  deleteAssoc :: I a -> [I a] -> [I a]
deleteAssoc = I a -> [I a] -> [I a]
forall a. Eq a => a -> [a] -> [a]
List.delete

-- instance Measured [Interval p r] (Interval p r) where
--   measure = (:[])

-- instance (Eq p, Eq r) => Assoc [Interval p r] (Interval p r) where
--   insertAssoc = (:)
--   deleteAssoc = List.delete


instance IntervalLike a => IntervalLike (I a) where
  asRange :: I a -> Range (NumType (I a))
asRange = a -> Range (NumType a)
forall i. IntervalLike i => i -> Range (NumType i)
asRange (a -> Range (NumType a)) -> (I a -> a) -> I a -> Range (NumType a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I a -> a
forall a. I a -> a
_unI


fromIntervals' :: (Eq p, Ord r)
               => NonEmpty (Interval p r) -> SegmentTree [I (Interval p r)] r
fromIntervals' :: NonEmpty (Interval p r) -> SegmentTree [I (Interval p r)] r
fromIntervals' = (Interval p r -> I (Interval p r))
-> NonEmpty (Interval p r) -> SegmentTree [I (Interval p r)] r
forall r p v i.
(Ord r, Eq p, Assoc v i, IntervalLike i, Monoid v,
 NumType i ~ r) =>
(Interval p r -> i) -> NonEmpty (Interval p r) -> SegmentTree v r
fromIntervals Interval p r -> I (Interval p r)
forall a. a -> I a
I


--------------------------------------------------------------------------------
-- * Counting the number of segments intersected

newtype Count = Count { Count -> Word
getCount :: Word }
              deriving (Int -> Count -> ShowS
[Count] -> ShowS
Count -> String
(Int -> Count -> ShowS)
-> (Count -> String) -> ([Count] -> ShowS) -> Show Count
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Count] -> ShowS
$cshowList :: [Count] -> ShowS
show :: Count -> String
$cshow :: Count -> String
showsPrec :: Int -> Count -> ShowS
$cshowsPrec :: Int -> Count -> ShowS
Show,Count -> Count -> Bool
(Count -> Count -> Bool) -> (Count -> Count -> Bool) -> Eq Count
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Count -> Count -> Bool
$c/= :: Count -> Count -> Bool
== :: Count -> Count -> Bool
$c== :: Count -> Count -> Bool
Eq,Eq Count
Eq Count
-> (Count -> Count -> Ordering)
-> (Count -> Count -> Bool)
-> (Count -> Count -> Bool)
-> (Count -> Count -> Bool)
-> (Count -> Count -> Bool)
-> (Count -> Count -> Count)
-> (Count -> Count -> Count)
-> Ord Count
Count -> Count -> Bool
Count -> Count -> Ordering
Count -> Count -> Count
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 :: Count -> Count -> Count
$cmin :: Count -> Count -> Count
max :: Count -> Count -> Count
$cmax :: Count -> Count -> Count
>= :: Count -> Count -> Bool
$c>= :: Count -> Count -> Bool
> :: Count -> Count -> Bool
$c> :: Count -> Count -> Bool
<= :: Count -> Count -> Bool
$c<= :: Count -> Count -> Bool
< :: Count -> Count -> Bool
$c< :: Count -> Count -> Bool
compare :: Count -> Count -> Ordering
$ccompare :: Count -> Count -> Ordering
$cp1Ord :: Eq Count
Ord,Integer -> Count
Count -> Count
Count -> Count -> Count
(Count -> Count -> Count)
-> (Count -> Count -> Count)
-> (Count -> Count -> Count)
-> (Count -> Count)
-> (Count -> Count)
-> (Count -> Count)
-> (Integer -> Count)
-> Num Count
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Count
$cfromInteger :: Integer -> Count
signum :: Count -> Count
$csignum :: Count -> Count
abs :: Count -> Count
$cabs :: Count -> Count
negate :: Count -> Count
$cnegate :: Count -> Count
* :: Count -> Count -> Count
$c* :: Count -> Count -> Count
- :: Count -> Count -> Count
$c- :: Count -> Count -> Count
+ :: Count -> Count -> Count
$c+ :: Count -> Count -> Count
Num,Enum Count
Real Count
Real Count
-> Enum Count
-> (Count -> Count -> Count)
-> (Count -> Count -> Count)
-> (Count -> Count -> Count)
-> (Count -> Count -> Count)
-> (Count -> Count -> (Count, Count))
-> (Count -> Count -> (Count, Count))
-> (Count -> Integer)
-> Integral Count
Count -> Integer
Count -> Count -> (Count, Count)
Count -> Count -> Count
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Count -> Integer
$ctoInteger :: Count -> Integer
divMod :: Count -> Count -> (Count, Count)
$cdivMod :: Count -> Count -> (Count, Count)
quotRem :: Count -> Count -> (Count, Count)
$cquotRem :: Count -> Count -> (Count, Count)
mod :: Count -> Count -> Count
$cmod :: Count -> Count -> Count
div :: Count -> Count -> Count
$cdiv :: Count -> Count -> Count
rem :: Count -> Count -> Count
$crem :: Count -> Count -> Count
quot :: Count -> Count -> Count
$cquot :: Count -> Count -> Count
$cp2Integral :: Enum Count
$cp1Integral :: Real Count
Integral,Int -> Count
Count -> Int
Count -> [Count]
Count -> Count
Count -> Count -> [Count]
Count -> Count -> Count -> [Count]
(Count -> Count)
-> (Count -> Count)
-> (Int -> Count)
-> (Count -> Int)
-> (Count -> [Count])
-> (Count -> Count -> [Count])
-> (Count -> Count -> [Count])
-> (Count -> Count -> Count -> [Count])
-> Enum Count
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 :: Count -> Count -> Count -> [Count]
$cenumFromThenTo :: Count -> Count -> Count -> [Count]
enumFromTo :: Count -> Count -> [Count]
$cenumFromTo :: Count -> Count -> [Count]
enumFromThen :: Count -> Count -> [Count]
$cenumFromThen :: Count -> Count -> [Count]
enumFrom :: Count -> [Count]
$cenumFrom :: Count -> [Count]
fromEnum :: Count -> Int
$cfromEnum :: Count -> Int
toEnum :: Int -> Count
$ctoEnum :: Int -> Count
pred :: Count -> Count
$cpred :: Count -> Count
succ :: Count -> Count
$csucc :: Count -> Count
Enum,Num Count
Ord Count
Num Count -> Ord Count -> (Count -> Rational) -> Real Count
Count -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Count -> Rational
$ctoRational :: Count -> Rational
$cp2Real :: Ord Count
$cp1Real :: Num Count
Real,(forall x. Count -> Rep Count x)
-> (forall x. Rep Count x -> Count) -> Generic Count
forall x. Rep Count x -> Count
forall x. Count -> Rep Count x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Count x -> Count
$cfrom :: forall x. Count -> Rep Count x
Generic,Count -> ()
(Count -> ()) -> NFData Count
forall a. (a -> ()) -> NFData a
rnf :: Count -> ()
$crnf :: Count -> ()
NFData)

newtype C a = C { C a -> a
_unC :: a} deriving (Int -> C a -> ShowS
[C a] -> ShowS
C a -> String
(Int -> C a -> ShowS)
-> (C a -> String) -> ([C a] -> ShowS) -> Show (C a)
forall a. Show a => Int -> C a -> ShowS
forall a. Show a => [C a] -> ShowS
forall a. Show a => C a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [C a] -> ShowS
$cshowList :: forall a. Show a => [C a] -> ShowS
show :: C a -> String
$cshow :: forall a. Show a => C a -> String
showsPrec :: Int -> C a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> C a -> ShowS
Show,ReadPrec [C a]
ReadPrec (C a)
Int -> ReadS (C a)
ReadS [C a]
(Int -> ReadS (C a))
-> ReadS [C a] -> ReadPrec (C a) -> ReadPrec [C a] -> Read (C a)
forall a. Read a => ReadPrec [C a]
forall a. Read a => ReadPrec (C a)
forall a. Read a => Int -> ReadS (C a)
forall a. Read a => ReadS [C a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [C a]
$creadListPrec :: forall a. Read a => ReadPrec [C a]
readPrec :: ReadPrec (C a)
$creadPrec :: forall a. Read a => ReadPrec (C a)
readList :: ReadS [C a]
$creadList :: forall a. Read a => ReadS [C a]
readsPrec :: Int -> ReadS (C a)
$creadsPrec :: forall a. Read a => Int -> ReadS (C a)
Read,C a -> C a -> Bool
(C a -> C a -> Bool) -> (C a -> C a -> Bool) -> Eq (C a)
forall a. Eq a => C a -> C a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: C a -> C a -> Bool
$c/= :: forall a. Eq a => C a -> C a -> Bool
== :: C a -> C a -> Bool
$c== :: forall a. Eq a => C a -> C a -> Bool
Eq,Eq (C a)
Eq (C a)
-> (C a -> C a -> Ordering)
-> (C a -> C a -> Bool)
-> (C a -> C a -> Bool)
-> (C a -> C a -> Bool)
-> (C a -> C a -> Bool)
-> (C a -> C a -> C a)
-> (C a -> C a -> C a)
-> Ord (C a)
C a -> C a -> Bool
C a -> C a -> Ordering
C a -> C a -> C a
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 a. Ord a => Eq (C a)
forall a. Ord a => C a -> C a -> Bool
forall a. Ord a => C a -> C a -> Ordering
forall a. Ord a => C a -> C a -> C a
min :: C a -> C a -> C a
$cmin :: forall a. Ord a => C a -> C a -> C a
max :: C a -> C a -> C a
$cmax :: forall a. Ord a => C a -> C a -> C a
>= :: C a -> C a -> Bool
$c>= :: forall a. Ord a => C a -> C a -> Bool
> :: C a -> C a -> Bool
$c> :: forall a. Ord a => C a -> C a -> Bool
<= :: C a -> C a -> Bool
$c<= :: forall a. Ord a => C a -> C a -> Bool
< :: C a -> C a -> Bool
$c< :: forall a. Ord a => C a -> C a -> Bool
compare :: C a -> C a -> Ordering
$ccompare :: forall a. Ord a => C a -> C a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (C a)
Ord,(forall x. C a -> Rep (C a) x)
-> (forall x. Rep (C a) x -> C a) -> Generic (C a)
forall x. Rep (C a) x -> C a
forall x. C a -> Rep (C a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (C a) x -> C a
forall a x. C a -> Rep (C a) x
$cto :: forall a x. Rep (C a) x -> C a
$cfrom :: forall a x. C a -> Rep (C a) x
Generic,C a -> ()
(C a -> ()) -> NFData (C a)
forall a. NFData a => C a -> ()
forall a. (a -> ()) -> NFData a
rnf :: C a -> ()
$crnf :: forall a. NFData a => C a -> ()
NFData)

instance Semigroup Count where
  Count
a <> :: Count -> Count -> Count
<> Count
b = Word -> Count
Count (Word -> Count) -> Word -> Count
forall a b. (a -> b) -> a -> b
$ Count -> Word
getCount Count
a Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Count -> Word
getCount Count
b
instance Monoid Count where
  mempty :: Count
mempty = Count
0
  mappend :: Count -> Count -> Count
mappend = Count -> Count -> Count
forall a. Semigroup a => a -> a -> a
(<>)

instance Measured Count (C i) where
  measure :: C i -> Count
measure C i
_ = Count
1

instance Assoc Count (C i) where
  insertAssoc :: C i -> Count -> Count
insertAssoc C i
_ Count
v = Count
v Count -> Count -> Count
forall a. Num a => a -> a -> a
+ Count
1
  deleteAssoc :: C i -> Count -> Count
deleteAssoc C i
_ Count
v = Count
v Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
1


--------------------------------------------------------------------------------
-- * Testing stuff

-- test'' = fromIntervals' . NonEmpty.fromList $ test
-- test = [Interval (Closed (238 :+ ())) (Open (309 :+ ())), Interval (Closed (175 :+ ())) (Closed (269 :+ ())),Interval (Closed (255 :+ ())) (Open (867 :+ ())),Interval (Open (236 :+ ())) (Closed (863 :+ ())),Interval (Open (150 :+ ())) (Closed (161 :+ ())),Interval (Closed (35 :+ ())) (Closed (77 :+ ()))]


-- -- q =        [78]

-- -- test = fromIntervals' . NonEmpty.fromList $ [ closedInterval 0 10
-- --                                             , closedInterval 5 15
-- --                                             , closedInterval 1 4
-- --                                             , closedInterval 3 9
-- --                                             ]
-- tst = fromIntervals' . NonEmpty.fromList $ [ closedInterval 1 6
--                                            , closedInterval 2 6
--                                            -- , Interval (Closed $ ext 0) (Open $ ext 1)
--                                            ]



-- closedInterval a b = ClosedInterval (ext a) (ext b)

-- showT :: (Show r, Show v) => SegmentTree v r -> String
-- showT = drawTree . _unSegmentTree


-- test' :: (Show r, Num r, Ord r, Enum r) => SegmentTree [I (Interval () r)] r
-- test' = insert (I $ closedInterval 6 14) $ createTree (NonEmpty.fromList [2,4..20]) []