{-# LANGUAGE TemplateHaskell #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.IntervalTree
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Data.Geometry.IntervalTree( NodeData(..)
                                 , splitPoint, intervalsLeft, intervalsRight
                                 , IntervalTree(..), unIntervalTree
                                 , IntervalLike(..)
                                 , createTree, fromIntervals
                                 , insert, delete
                                 , stab, search
                                 , toList
                                 ) where


import           Control.DeepSeq
import           Control.Lens
import           Data.BinaryTree
import           Data.Ext
import           Data.Geometry.Interval
import           Data.Geometry.Interval.Util
import           Data.Geometry.Properties
import qualified Data.List as List
import qualified Data.Map as M
import           GHC.Generics (Generic)

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

-- | Information stored in a node of the Interval Tree
data NodeData i r = NodeData { NodeData i r -> r
_splitPoint     :: !r
                             , NodeData i r -> Map (L r) [i]
_intervalsLeft  :: !(M.Map (L r) [i])
                             , NodeData i r -> Map (R r) [i]
_intervalsRight :: !(M.Map (R r) [i])
                             } deriving (Int -> NodeData i r -> ShowS
[NodeData i r] -> ShowS
NodeData i r -> String
(Int -> NodeData i r -> ShowS)
-> (NodeData i r -> String)
-> ([NodeData i r] -> ShowS)
-> Show (NodeData i r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall i r. (Show r, Show i) => Int -> NodeData i r -> ShowS
forall i r. (Show r, Show i) => [NodeData i r] -> ShowS
forall i r. (Show r, Show i) => NodeData i r -> String
showList :: [NodeData i r] -> ShowS
$cshowList :: forall i r. (Show r, Show i) => [NodeData i r] -> ShowS
show :: NodeData i r -> String
$cshow :: forall i r. (Show r, Show i) => NodeData i r -> String
showsPrec :: Int -> NodeData i r -> ShowS
$cshowsPrec :: forall i r. (Show r, Show i) => Int -> NodeData i r -> ShowS
Show,NodeData i r -> NodeData i r -> Bool
(NodeData i r -> NodeData i r -> Bool)
-> (NodeData i r -> NodeData i r -> Bool) -> Eq (NodeData i r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall i r. (Eq r, Eq i) => NodeData i r -> NodeData i r -> Bool
/= :: NodeData i r -> NodeData i r -> Bool
$c/= :: forall i r. (Eq r, Eq i) => NodeData i r -> NodeData i r -> Bool
== :: NodeData i r -> NodeData i r -> Bool
$c== :: forall i r. (Eq r, Eq i) => NodeData i r -> NodeData i r -> Bool
Eq,Eq (NodeData i r)
Eq (NodeData i r)
-> (NodeData i r -> NodeData i r -> Ordering)
-> (NodeData i r -> NodeData i r -> Bool)
-> (NodeData i r -> NodeData i r -> Bool)
-> (NodeData i r -> NodeData i r -> Bool)
-> (NodeData i r -> NodeData i r -> Bool)
-> (NodeData i r -> NodeData i r -> NodeData i r)
-> (NodeData i r -> NodeData i r -> NodeData i r)
-> Ord (NodeData i r)
NodeData i r -> NodeData i r -> Bool
NodeData i r -> NodeData i r -> Ordering
NodeData i r -> NodeData i r -> NodeData i r
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 i r. (Ord r, Ord i) => Eq (NodeData i r)
forall i r. (Ord r, Ord i) => NodeData i r -> NodeData i r -> Bool
forall i r.
(Ord r, Ord i) =>
NodeData i r -> NodeData i r -> Ordering
forall i r.
(Ord r, Ord i) =>
NodeData i r -> NodeData i r -> NodeData i r
min :: NodeData i r -> NodeData i r -> NodeData i r
$cmin :: forall i r.
(Ord r, Ord i) =>
NodeData i r -> NodeData i r -> NodeData i r
max :: NodeData i r -> NodeData i r -> NodeData i r
$cmax :: forall i r.
(Ord r, Ord i) =>
NodeData i r -> NodeData i r -> NodeData i r
>= :: NodeData i r -> NodeData i r -> Bool
$c>= :: forall i r. (Ord r, Ord i) => NodeData i r -> NodeData i r -> Bool
> :: NodeData i r -> NodeData i r -> Bool
$c> :: forall i r. (Ord r, Ord i) => NodeData i r -> NodeData i r -> Bool
<= :: NodeData i r -> NodeData i r -> Bool
$c<= :: forall i r. (Ord r, Ord i) => NodeData i r -> NodeData i r -> Bool
< :: NodeData i r -> NodeData i r -> Bool
$c< :: forall i r. (Ord r, Ord i) => NodeData i r -> NodeData i r -> Bool
compare :: NodeData i r -> NodeData i r -> Ordering
$ccompare :: forall i r.
(Ord r, Ord i) =>
NodeData i r -> NodeData i r -> Ordering
$cp1Ord :: forall i r. (Ord r, Ord i) => Eq (NodeData i r)
Ord,(forall x. NodeData i r -> Rep (NodeData i r) x)
-> (forall x. Rep (NodeData i r) x -> NodeData i r)
-> Generic (NodeData i r)
forall x. Rep (NodeData i r) x -> NodeData i r
forall x. NodeData i r -> Rep (NodeData i r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i r x. Rep (NodeData i r) x -> NodeData i r
forall i r x. NodeData i r -> Rep (NodeData i r) x
$cto :: forall i r x. Rep (NodeData i r) x -> NodeData i r
$cfrom :: forall i r x. NodeData i r -> Rep (NodeData i r) x
Generic)
makeLenses ''NodeData

instance (NFData i, NFData r) => NFData (NodeData i r)

-- | IntervalTree type, storing intervals of type i
newtype IntervalTree i r =
  IntervalTree { IntervalTree i r -> BinaryTree (NodeData i r)
_unIntervalTree :: BinaryTree (NodeData i r) }
  deriving (Int -> IntervalTree i r -> ShowS
[IntervalTree i r] -> ShowS
IntervalTree i r -> String
(Int -> IntervalTree i r -> ShowS)
-> (IntervalTree i r -> String)
-> ([IntervalTree i r] -> ShowS)
-> Show (IntervalTree i r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall i r. (Show r, Show i) => Int -> IntervalTree i r -> ShowS
forall i r. (Show r, Show i) => [IntervalTree i r] -> ShowS
forall i r. (Show r, Show i) => IntervalTree i r -> String
showList :: [IntervalTree i r] -> ShowS
$cshowList :: forall i r. (Show r, Show i) => [IntervalTree i r] -> ShowS
show :: IntervalTree i r -> String
$cshow :: forall i r. (Show r, Show i) => IntervalTree i r -> String
showsPrec :: Int -> IntervalTree i r -> ShowS
$cshowsPrec :: forall i r. (Show r, Show i) => Int -> IntervalTree i r -> ShowS
Show,IntervalTree i r -> IntervalTree i r -> Bool
(IntervalTree i r -> IntervalTree i r -> Bool)
-> (IntervalTree i r -> IntervalTree i r -> Bool)
-> Eq (IntervalTree i r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall i r.
(Eq r, Eq i) =>
IntervalTree i r -> IntervalTree i r -> Bool
/= :: IntervalTree i r -> IntervalTree i r -> Bool
$c/= :: forall i r.
(Eq r, Eq i) =>
IntervalTree i r -> IntervalTree i r -> Bool
== :: IntervalTree i r -> IntervalTree i r -> Bool
$c== :: forall i r.
(Eq r, Eq i) =>
IntervalTree i r -> IntervalTree i r -> Bool
Eq,(forall x. IntervalTree i r -> Rep (IntervalTree i r) x)
-> (forall x. Rep (IntervalTree i r) x -> IntervalTree i r)
-> Generic (IntervalTree i r)
forall x. Rep (IntervalTree i r) x -> IntervalTree i r
forall x. IntervalTree i r -> Rep (IntervalTree i r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i r x. Rep (IntervalTree i r) x -> IntervalTree i r
forall i r x. IntervalTree i r -> Rep (IntervalTree i r) x
$cto :: forall i r x. Rep (IntervalTree i r) x -> IntervalTree i r
$cfrom :: forall i r x. IntervalTree i r -> Rep (IntervalTree i r) x
Generic)
makeLenses ''IntervalTree

instance (NFData i, NFData r) => NFData (IntervalTree i r)

-- | Given an ordered list of points, create an interval tree
--
-- \(O(n)\)
createTree     :: Ord r => [r] -> IntervalTree i r
createTree :: [r] -> IntervalTree i r
createTree = BinaryTree (NodeData i r) -> IntervalTree i r
forall i r. BinaryTree (NodeData i r) -> IntervalTree i r
IntervalTree (BinaryTree (NodeData i r) -> IntervalTree i r)
-> ([r] -> BinaryTree (NodeData i r)) -> [r] -> IntervalTree i r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NodeData i r] -> BinaryTree (NodeData i r)
forall a. [a] -> BinaryTree a
asBalancedBinTree
             ([NodeData i r] -> BinaryTree (NodeData i r))
-> ([r] -> [NodeData i r]) -> [r] -> BinaryTree (NodeData i r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> NodeData i r) -> [r] -> [NodeData i r]
forall a b. (a -> b) -> [a] -> [b]
map (\r
m -> r -> Map (L r) [i] -> Map (R r) [i] -> NodeData i r
forall i r. r -> Map (L r) [i] -> Map (R r) [i] -> NodeData i r
NodeData r
m Map (L r) [i]
forall a. Monoid a => a
mempty Map (R r) [i]
forall a. Monoid a => a
mempty)


-- | Build an interval tree
--
-- \(O(n \log n)\)
fromIntervals    :: (Ord r, IntervalLike i, NumType i ~ r)
                 => [i] -> IntervalTree i r
fromIntervals :: [i] -> IntervalTree i r
fromIntervals [i]
is = (i -> IntervalTree i r -> IntervalTree i r)
-> IntervalTree i r -> [i] -> IntervalTree i r
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr i -> IntervalTree i r -> IntervalTree i r
forall r i.
(Ord r, IntervalLike i, NumType i ~ r) =>
i -> IntervalTree i r -> IntervalTree i r
insert ([r] -> IntervalTree i r
forall r i. Ord r => [r] -> IntervalTree i r
createTree [r]
pts) [i]
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 :: [r]
pts = [r] -> [r]
forall a. Ord a => [a] -> [a]
List.sort ([r] -> [r]) -> ([i] -> [r]) -> [i] -> [r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> [r]) -> [i] -> [r]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap i -> [r]
forall i. IntervalLike i => i -> [NumType i]
endPoints ([i] -> [r]) -> [i] -> [r]
forall a b. (a -> b) -> a -> b
$ [i]
is

-- | Lists the intervals. We don't guarantee anything about the order
--
-- running time: \(O(n)\).
toList :: IntervalTree i r -> [i]
toList :: IntervalTree i r -> [i]
toList = BinaryTree (NodeData i r) -> [i]
forall a r. BinaryTree (NodeData a r) -> [a]
toList' (BinaryTree (NodeData i r) -> [i])
-> (IntervalTree i r -> BinaryTree (NodeData i r))
-> IntervalTree i r
-> [i]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntervalTree i r -> BinaryTree (NodeData i r)
forall i r. IntervalTree i r -> BinaryTree (NodeData i r)
_unIntervalTree
  where
    toList' :: BinaryTree (NodeData a r) -> [a]
toList' BinaryTree (NodeData a r)
Nil              = []
    toList' (Internal BinaryTree (NodeData a r)
l NodeData a r
v BinaryTree (NodeData a r)
r) =
      [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ NodeData a r
vNodeData a r -> Getting (Endo [[a]]) (NodeData a r) [a] -> [[a]]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..(Map (L r) [a] -> Const (Endo [[a]]) (Map (L r) [a]))
-> NodeData a r -> Const (Endo [[a]]) (NodeData a r)
forall i r. Lens' (NodeData i r) (Map (L r) [i])
intervalsLeft((Map (L r) [a] -> Const (Endo [[a]]) (Map (L r) [a]))
 -> NodeData a r -> Const (Endo [[a]]) (NodeData a r))
-> (([a] -> Const (Endo [[a]]) [a])
    -> Map (L r) [a] -> Const (Endo [[a]]) (Map (L r) [a]))
-> Getting (Endo [[a]]) (NodeData a r) [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([a] -> Const (Endo [[a]]) [a])
-> Map (L r) [a] -> Const (Endo [[a]]) (Map (L r) [a])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse, BinaryTree (NodeData a r) -> [a]
toList' BinaryTree (NodeData a r)
l, BinaryTree (NodeData a r) -> [a]
toList' BinaryTree (NodeData a r)
r]

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

-- | Find all intervals that stab x
--
-- \(O(\log n + k)\), where k is the output size
search :: Ord r => r -> IntervalTree i r -> [i]
search :: r -> IntervalTree i r -> [i]
search = r -> IntervalTree i r -> [i]
forall r i. Ord r => r -> IntervalTree i r -> [i]
stab

-- | Find all intervals that stab x
--
-- \(O(\log n + k)\), where k is the output size
stab                    :: Ord r => r -> IntervalTree i r -> [i]
stab :: r -> IntervalTree i r -> [i]
stab r
x (IntervalTree BinaryTree (NodeData i r)
t) = BinaryTree (NodeData i r) -> [i]
stab' BinaryTree (NodeData i r)
t
  where
    stab' :: BinaryTree (NodeData i r) -> [i]
stab' BinaryTree (NodeData i r)
Nil = []
    stab' (Internal BinaryTree (NodeData i r)
l (NodeData r
m Map (L r) [i]
ll Map (R r) [i]
rr) BinaryTree (NodeData i r)
r)
      | r
x r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= r
m    = let is :: [i]
is = (L r -> Bool) -> [(L r, [i])] -> [i]
forall a b. (a -> Bool) -> [(a, [b])] -> [b]
f (L r -> L r -> Bool
forall a. Ord a => a -> a -> Bool
<= EndPoint r -> L r
forall r. EndPoint r -> L r
L (r -> EndPoint r
forall a. a -> EndPoint a
Closed r
x)) ([(L r, [i])] -> [i])
-> (Map (L r) [i] -> [(L r, [i])]) -> Map (L r) [i] -> [i]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (L r) [i] -> [(L r, [i])]
forall k a. Map k a -> [(k, a)]
M.toAscList (Map (L r) [i] -> [i]) -> Map (L r) [i] -> [i]
forall a b. (a -> b) -> a -> b
$ Map (L r) [i]
ll
                    in [i]
is [i] -> [i] -> [i]
forall a. [a] -> [a] -> [a]
++ BinaryTree (NodeData i r) -> [i]
stab' BinaryTree (NodeData i r)
l
      | Bool
otherwise = let is :: [i]
is = (R r -> Bool) -> [(R r, [i])] -> [i]
forall a b. (a -> Bool) -> [(a, [b])] -> [b]
f (R r -> R r -> Bool
forall a. Ord a => a -> a -> Bool
>= EndPoint r -> R r
forall r. EndPoint r -> R r
R (r -> EndPoint r
forall a. a -> EndPoint a
Closed r
x)) ([(R r, [i])] -> [i])
-> (Map (R r) [i] -> [(R r, [i])]) -> Map (R r) [i] -> [i]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (R r) [i] -> [(R r, [i])]
forall k a. Map k a -> [(k, a)]
M.toDescList (Map (R r) [i] -> [i]) -> Map (R r) [i] -> [i]
forall a b. (a -> b) -> a -> b
$ Map (R r) [i]
rr
                    in [i]
is [i] -> [i] -> [i]
forall a. [a] -> [a] -> [a]
++ BinaryTree (NodeData i r) -> [i]
stab' BinaryTree (NodeData i r)
r
    f :: (a -> Bool) -> [(a, [b])] -> [b]
f a -> Bool
p = ((a, [b]) -> [b]) -> [(a, [b])] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (a, [b]) -> [b]
forall a b. (a, b) -> b
snd ([(a, [b])] -> [b])
-> ([(a, [b])] -> [(a, [b])]) -> [(a, [b])] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, [b]) -> Bool) -> [(a, [b])] -> [(a, [b])]
forall a. (a -> Bool) -> [a] -> [a]
List.takeWhile (a -> Bool
p (a -> Bool) -> ((a, [b]) -> a) -> (a, [b]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [b]) -> a
forall a b. (a, b) -> a
fst)

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

-- | Insert :
-- pre: the interval intersects some midpoint in the tree
--
-- \(O(\log n)\)
insert                    :: (Ord r, IntervalLike i, NumType i ~ r)
                          => i -> IntervalTree i r -> IntervalTree i r
insert :: i -> IntervalTree i r -> IntervalTree i r
insert i
i (IntervalTree BinaryTree (NodeData i r)
t) = BinaryTree (NodeData i r) -> IntervalTree i r
forall i r. BinaryTree (NodeData i r) -> IntervalTree i r
IntervalTree (BinaryTree (NodeData i r) -> IntervalTree i r)
-> BinaryTree (NodeData i r) -> IntervalTree i r
forall a b. (a -> b) -> a -> b
$ BinaryTree (NodeData i r) -> BinaryTree (NodeData i r)
insert' BinaryTree (NodeData i 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

    insert' :: BinaryTree (NodeData i r) -> BinaryTree (NodeData i r)
insert' BinaryTree (NodeData i r)
Nil = BinaryTree (NodeData i r)
forall a. BinaryTree a
Nil
    insert' (Internal BinaryTree (NodeData i r)
l nd :: NodeData i r
nd@(NodeData i r -> r
forall i r. NodeData i r -> r
_splitPoint -> r
m) BinaryTree (NodeData i r)
r)
      | r
m r -> Range r -> Bool
forall a. Ord a => a -> Range a -> Bool
`inRange` Range r
ri = BinaryTree (NodeData i r)
-> NodeData i r
-> BinaryTree (NodeData i r)
-> BinaryTree (NodeData i r)
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Internal BinaryTree (NodeData i r)
l (NodeData i r -> NodeData i r
insert'' NodeData i r
nd) BinaryTree (NodeData i r)
r
      | EndPoint r
b EndPoint r -> EndPoint r -> Bool
forall a. Ord a => a -> a -> Bool
<= r -> EndPoint r
forall a. a -> EndPoint a
Closed r
m  = BinaryTree (NodeData i r)
-> NodeData i r
-> BinaryTree (NodeData i r)
-> BinaryTree (NodeData i r)
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Internal (BinaryTree (NodeData i r) -> BinaryTree (NodeData i r)
insert' BinaryTree (NodeData i r)
l) NodeData i r
nd BinaryTree (NodeData i r)
r
      | Bool
otherwise      = BinaryTree (NodeData i r)
-> NodeData i r
-> BinaryTree (NodeData i r)
-> BinaryTree (NodeData i r)
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Internal BinaryTree (NodeData i r)
l NodeData i r
nd (BinaryTree (NodeData i r) -> BinaryTree (NodeData i r)
insert' BinaryTree (NodeData i r)
r)

    insert'' :: NodeData i r -> NodeData i r
insert'' (NodeData r
m Map (L r) [i]
l Map (R r) [i]
r) = r -> Map (L r) [i] -> Map (R r) [i] -> NodeData i r
forall i r. r -> Map (L r) [i] -> Map (R r) [i] -> NodeData i r
NodeData r
m (([i] -> [i] -> [i]) -> L r -> [i] -> Map (L r) [i] -> Map (L r) [i]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [i] -> [i] -> [i]
forall a. [a] -> [a] -> [a]
(++) (EndPoint r -> L r
forall r. EndPoint r -> L r
L EndPoint r
a) [i
i] Map (L r) [i]
l)
                                           (([i] -> [i] -> [i]) -> R r -> [i] -> Map (R r) [i] -> Map (R r) [i]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [i] -> [i] -> [i]
forall a. [a] -> [a] -> [a]
(++) (EndPoint r -> R r
forall r. EndPoint r -> R r
R EndPoint r
b) [i
i] Map (R r) [i]
r)


-- | Delete an interval from the Tree
--
-- \(O(\log n)\) (under some general position assumption)
delete :: (Ord r, IntervalLike i, NumType i ~ r, Eq i)
          => i -> IntervalTree i r -> IntervalTree i r
delete :: i -> IntervalTree i r -> IntervalTree i r
delete i
i (IntervalTree BinaryTree (NodeData i r)
t) = BinaryTree (NodeData i r) -> IntervalTree i r
forall i r. BinaryTree (NodeData i r) -> IntervalTree i r
IntervalTree (BinaryTree (NodeData i r) -> IntervalTree i r)
-> BinaryTree (NodeData i r) -> IntervalTree i r
forall a b. (a -> b) -> a -> b
$ BinaryTree (NodeData i r) -> BinaryTree (NodeData i r)
delete' BinaryTree (NodeData i 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

    delete' :: BinaryTree (NodeData i r) -> BinaryTree (NodeData i r)
delete' BinaryTree (NodeData i r)
Nil = BinaryTree (NodeData i r)
forall a. BinaryTree a
Nil
    delete' (Internal BinaryTree (NodeData i r)
l nd :: NodeData i r
nd@(NodeData i r -> r
forall i r. NodeData i r -> r
_splitPoint -> r
m) BinaryTree (NodeData i r)
r)
      | r
m r -> Range r -> Bool
forall a. Ord a => a -> Range a -> Bool
`inRange` Range r
ri = BinaryTree (NodeData i r)
-> NodeData i r
-> BinaryTree (NodeData i r)
-> BinaryTree (NodeData i r)
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Internal BinaryTree (NodeData i r)
l (NodeData i r -> NodeData i r
delete'' NodeData i r
nd) BinaryTree (NodeData i r)
r
      | EndPoint r
b EndPoint r -> EndPoint r -> Bool
forall a. Ord a => a -> a -> Bool
<= r -> EndPoint r
forall a. a -> EndPoint a
Closed r
m  = BinaryTree (NodeData i r)
-> NodeData i r
-> BinaryTree (NodeData i r)
-> BinaryTree (NodeData i r)
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Internal (BinaryTree (NodeData i r) -> BinaryTree (NodeData i r)
delete' BinaryTree (NodeData i r)
l) NodeData i r
nd BinaryTree (NodeData i r)
r
      | Bool
otherwise      = BinaryTree (NodeData i r)
-> NodeData i r
-> BinaryTree (NodeData i r)
-> BinaryTree (NodeData i r)
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Internal BinaryTree (NodeData i r)
l NodeData i r
nd (BinaryTree (NodeData i r) -> BinaryTree (NodeData i r)
delete' BinaryTree (NodeData i r)
r)

    delete'' :: NodeData i r -> NodeData i r
delete'' (NodeData r
m Map (L r) [i]
l Map (R r) [i]
r) = r -> Map (L r) [i] -> Map (R r) [i] -> NodeData i r
forall i r. r -> Map (L r) [i] -> Map (R r) [i] -> NodeData i r
NodeData r
m (([i] -> Maybe [i]) -> L r -> Map (L r) [i] -> Map (L r) [i]
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update [i] -> Maybe [i]
f (EndPoint r -> L r
forall r. EndPoint r -> L r
L EndPoint r
a) Map (L r) [i]
l) (([i] -> Maybe [i]) -> R r -> Map (R r) [i] -> Map (R r) [i]
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update [i] -> Maybe [i]
f (EndPoint r -> R r
forall r. EndPoint r -> R r
R EndPoint r
b) Map (R r) [i]
r)
    f :: [i] -> Maybe [i]
f [i]
is = let is' :: [i]
is' = i -> [i] -> [i]
forall a. Eq a => a -> [a] -> [a]
List.delete i
i [i]
is in if [i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [i]
is' then Maybe [i]
forall a. Maybe a
Nothing else [i] -> Maybe [i]
forall a. a -> Maybe a
Just [i]
is'



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


-- | Anything that looks like an interval
class IntervalLike i where
  asRange :: i -> Range (NumType i)

instance IntervalLike (Range r) where
  asRange :: Range r -> Range (NumType (Range r))
asRange = Range r -> Range (NumType (Range r))
forall a. a -> a
id

instance IntervalLike (Interval p r) where
  asRange :: Interval p r -> Range (NumType (Interval p r))
asRange = ((r :+ p) -> r) -> Range (r :+ p) -> Range r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((r :+ p) -> Getting r (r :+ p) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (r :+ p) r
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Range (r :+ p) -> Range r)
-> (Interval p r -> Range (r :+ p)) -> Interval p r -> Range r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interval p r -> Range (r :+ p)
forall a r. Interval a r -> Range (r :+ a)
toRange

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

-- test'' = fromIntervals test
-- test  = [Interval (Open (97 :+ ())) (Closed (228 :+ ())) ,Interval (Open (18 :+ ())) (Open (79 :+ ())),Interval (Closed (126 :+ ())) (Open (167 :+ ())),Interval (Closed (105 :+ ())) (Closed (158 :+ ())),Interval (Closed (126 :+ ())) (Closed (211 :+ ())),Interval (Closed (111 :+ ())) (Open (194 :+ ())),Interval (Closed (120 :+ ())) (Open (302 :+ ())),Interval (Closed (92 :+ ())) (Closed (140 :+ ()))]

-- test = fromIntervals [ closedInterval 0 10
--                      , closedInterval 5 15
--                      , closedInterval 1 4
--                      , closedInterval 3 9
--                      ]

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