module Data.Geometry.RangeTree.Generic where
import Control.Lens
import Data.BinaryTree
import Data.Ext
import Data.Geometry.Point
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 qualified Data.Set as Set
import Data.Util
data NodeData v r = NodeData { _minVal :: !(Min r)
, _maxVal :: !(Max r)
, _assoc :: !v
} deriving (Show,Eq,Functor)
instance (Semigroup v, Ord r) => Semigroup (NodeData v r) where
NodeData mi ma v <> NodeData mi' ma' v' = NodeData (mi <> mi') (ma <> ma') (v <> v')
newtype RangeTree v q r =
RangeTree { _unRangeTree :: BinLeafTree (NodeData v r) (NodeData (v,q) r) }
deriving (Show,Eq)
createTree :: ( Ord r
, Measured v p
, Semigroup p
)
=> NonEmpty (r :+ p)
-> RangeTree v p r
createTree = createTree'
. fmap (\pts -> let x = pts^.to NonEmpty.head.core
in x :+ (sconcat . fmap (^.extra) $ pts))
. NonEmpty.groupAllWith1 (^.core)
createTree' :: (Ord r, Measured v p)
=> NonEmpty (r :+ p)
-> RangeTree v p r
createTree' pts = RangeTree t
where
t = view _1
. foldUp (\(SP l dl) _ (SP r dr) -> let d = dl <> dr in SP (Node l d r) d
)
(\(Elem (x :+ ld)) -> let v = measure ld
in SP (Leaf $ NodeData (Min x) (Max x) (v,ld))
(NodeData (Min x) (Max x) v)
)
. asBalancedBinLeafTree $ pts
toAscList :: RangeTree v p r -> NonEmpty (r :+ p)
toAscList = fmap (\(NodeData (Min x) _ (_,d)) -> x :+ d) . toNonEmpty . _unRangeTree
search :: (Ord r, Monoid v) => Range r -> RangeTree v p r -> v
search qr = mconcat . search' qr
search' :: Ord r
=> Range r -> RangeTree v p r -> [v]
search' qr = search'' qr . _unRangeTree
search'' :: Ord r
=> Range r
-> BinLeafTree (NodeData v r) (NodeData (v,q) r)
-> [v]
search'' qr t = case t of
Leaf (NodeData _ _ (v,_)) | qr `covers` rangeOf t -> [v]
| otherwise -> []
Node l (NodeData _ _ v) r | qr `covers` rangeOf t -> [v]
| otherwise -> msearch l <> msearch r
where
msearch t' | qr `intersects` rangeOf t' = search'' qr t'
| otherwise = []
rangeOf :: BinLeafTree (NodeData v r) (NodeData v' r) -> Range r
rangeOf (Leaf d) = rangeOf' d
rangeOf (Node _ d _) = rangeOf' d
rangeOf' :: NodeData v r -> Range r
rangeOf' (NodeData (Min mi) (Max ma) _) = ClosedRange mi ma
createReportingTree :: Ord r => NonEmpty (r :+ [p]) -> RangeTree (Report p) (Report p) r
createReportingTree = createTree . fmap (&extra %~ Report)
report :: (Ord r) => Range r -> RangeTree (Report p) q r -> [p]
report qr = reportList . search qr
newtype CountOf p = CountOf [p]
deriving (Show,Eq,Ord,Functor,Foldable,Semigroup,Monoid)
instance Measured (Count p) (CountOf p) where
measure (CountOf xs) = Count $ length xs
createCountingTree :: Ord r => NonEmpty (r :+ [p]) -> RangeTree (Count p) (CountOf p) r
createCountingTree = createTree . fmap (&extra %~ CountOf)
count :: Ord r => Range r -> RangeTree (Count p) q r -> Int
count qr = getCount . search qr