| Safe Haskell | Safe-Inferred |
|---|---|
| Language | Haskell2010 |
Data.QuadTree
Synopsis
- data QuadTree a = QuadTree {
- ot_default :: a
- ot_root_pow :: Integer
- ot_tree :: Free a
- fill :: forall a. Rect Rational -> a -> QuadTree a -> QuadTree a
- combineAla :: forall n a. (Coercible a n, Semigroup n) => (a -> n) -> QuadTree a -> QuadTree a -> QuadTree a
- lookup :: V2 Rational -> QuadTree a -> a
- query :: Semilattice s => (a -> s) -> Rect Rational -> QuadTree a -> s
- fuse :: Eq a => QuadTree a -> QuadTree a
- elements :: Ord a => QuadTree a -> Set a
- toRects :: QuadTree a -> [(Rect Rational, a)]
- boundingRect :: QuadTree a -> Rect Rational
- defaultValue :: QuadTree a -> a
- data Rect a = Rect {}
- mkRectByPow :: Integer -> Rect Rational
- midpoint :: Fractional a => Rect a -> V2 a
- subdivide :: Fractional a => Rect a -> V4 (Rect a)
- rectCorners :: Num a => Rect a -> V4 (V2 a)
- data V2 a = V2 !a !a
- data V4 a = V4 !a !a !a !a
Documentation
A type mapping values at (infinitely precise) locations in 2D
space. That is, you can consider an QuadTree to be a function , equipped with efficient means of querying the space.V2
Rational -> a
QuadTrees should usually be constructed using their Monoidal or
Applicative interfaces, as well as by way of the fill
function.
Constructors
| QuadTree | |
Fields
| |
Instances
| Applicative QuadTree Source # | |
| Functor QuadTree Source # | |
| Monoid a => Monoid (QuadTree a) Source # | |
| Semigroup a => Semigroup (QuadTree a) Source # | |
| Num a => Num (QuadTree a) Source # | |
Defined in Data.QuadTree | |
| Show a => Show (QuadTree a) Source # | |
| Eq a => Eq (QuadTree a) Source # | |
| Semilattice a => Semilattice (QuadTree a) Source # | |
Constructing QuadTrees
combineAla :: forall n a. (Coercible a n, Semigroup n) => (a -> n) -> QuadTree a -> QuadTree a -> QuadTree a Source #
Combine two QuadTrees using a different semigroup than usual. For
example, in order to replace any values in qt1 with those covered by
qt2, we can use:
combineAlaLastqt1 qt2
Spatially Querying QuadTrees
lookup :: V2 Rational -> QuadTree a -> a Source #
Get the value at the given position in the QuadTree.
query :: Semilattice s => (a -> s) -> Rect Rational -> QuadTree a -> s Source #
Query a region of space in an QuadTree. This method is a special case of
foldMap, specialized to finite regions.
For example, if you'd like to check if everything in the Rect has
a specific value, use All as your choice of Semilattice. If
you'd like to check whether anything in the space has a value, instead use
Any.
Eliminating QuadTrees
fuse :: Eq a => QuadTree a -> QuadTree a Source #
Fuse together all adjacent regions of space which contain the same value. This will speed up subsequent queries, but requires traversing the entire tree.
toRects :: QuadTree a -> [(Rect Rational, a)] Source #
Partition the QuadTree into contiguous, singular-valued Rects.
Satsifies the law
foldr (uncurryfill) (pure $defaultValueot) (toRectsot) == ot
defaultValue :: QuadTree a -> a Source #
Get the value used to fill the infinity of space in an QuadTree.
Constructing Rects
An axis-aligned bounding box in 3-space.
Instances
| Functor Rect Source # | |
| Generic (Rect a) Source # | |
| Read a => Read (Rect a) Source # | |
| Show a => Show (Rect a) Source # | |
| Eq a => Eq (Rect a) Source # | |
| Ord a => Ord (Rect a) Source # | |
| type Rep (Rect a) Source # | |
Defined in Data.QuadTree.Internal type Rep (Rect a) = D1 ('MetaData "Rect" "Data.QuadTree.Internal" "nspace-0.2.0.0-JcrzAw5ubjR6TX1H0E6SmC" 'False) (C1 ('MetaCons "Rect" 'PrefixI 'True) (S1 ('MetaSel ('Just "r_pos") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (V2 a)) :*: S1 ('MetaSel ('Just "r_size") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (V2 a)))) | |
mkRectByPow :: Integer -> Rect Rational Source #
Construct a Rect centered around $(0, 0, 0)$, with side length $2n$.
Eliminating Rects
Indexing Types
A 2-dimensional vector
>>>pure 1 :: V2 IntV2 1 1
>>>V2 1 2 + V2 3 4V2 4 6
>>>V2 1 2 * V2 3 4V2 3 8
>>>sum (V2 1 2)3
Constructors
| V2 !a !a |
Instances
| Representable V2 | |
| MonadFix V2 | |
| MonadZip V2 | |
| Foldable V2 | |
Defined in Linear.V2 Methods fold :: Monoid m => V2 m -> m # foldMap :: Monoid m => (a -> m) -> V2 a -> m # foldMap' :: Monoid m => (a -> m) -> V2 a -> m # foldr :: (a -> b -> b) -> b -> V2 a -> b # foldr' :: (a -> b -> b) -> b -> V2 a -> b # foldl :: (b -> a -> b) -> b -> V2 a -> b # foldl' :: (b -> a -> b) -> b -> V2 a -> b # foldr1 :: (a -> a -> a) -> V2 a -> a # foldl1 :: (a -> a -> a) -> V2 a -> a # elem :: Eq a => a -> V2 a -> Bool # maximum :: Ord a => V2 a -> a # | |
| Eq1 V2 | |
| Ord1 V2 | |
| Read1 V2 | |
| Show1 V2 | |
| Traversable V2 | |
| Applicative V2 | |
| Functor V2 | |
| Monad V2 | |
| Serial1 V2 | |
Defined in Linear.V2 Methods serializeWith :: MonadPut m => (a -> m ()) -> V2 a -> m () # deserializeWith :: MonadGet m => m a -> m (V2 a) # | |
| Distributive V2 | |
| Foldable1 V2 | |
Defined in Linear.V2 Methods fold1 :: Semigroup m => V2 m -> m # foldMap1 :: Semigroup m => (a -> m) -> V2 a -> m # foldMap1' :: Semigroup m => (a -> m) -> V2 a -> m # toNonEmpty :: V2 a -> NonEmpty a # maximum :: Ord a => V2 a -> a # minimum :: Ord a => V2 a -> a # foldrMap1 :: (a -> b) -> (a -> b -> b) -> V2 a -> b # foldlMap1' :: (a -> b) -> (b -> a -> b) -> V2 a -> b # foldlMap1 :: (a -> b) -> (b -> a -> b) -> V2 a -> b # foldrMap1' :: (a -> b) -> (a -> b -> b) -> V2 a -> b # | |
| Hashable1 V2 | |
| Metric V2 | |
| Finite V2 | |
| R1 V2 | |
| R2 V2 | |
| Additive V2 | |
| Apply V2 | |
| Bind V2 | |
| Traversable1 V2 | |
| Generic1 V2 | |
| Unbox a => Vector Vector (V2 a) | |
Defined in Linear.V2 Methods basicUnsafeFreeze :: Mutable Vector s (V2 a) -> ST s (Vector (V2 a)) # basicUnsafeThaw :: Vector (V2 a) -> ST s (Mutable Vector s (V2 a)) # basicLength :: Vector (V2 a) -> Int # basicUnsafeSlice :: Int -> Int -> Vector (V2 a) -> Vector (V2 a) # basicUnsafeIndexM :: Vector (V2 a) -> Int -> Box (V2 a) # basicUnsafeCopy :: Mutable Vector s (V2 a) -> Vector (V2 a) -> ST s () # | |
| Unbox a => MVector MVector (V2 a) | |
Defined in Linear.V2 Methods basicLength :: MVector s (V2 a) -> Int # basicUnsafeSlice :: Int -> Int -> MVector s (V2 a) -> MVector s (V2 a) # basicOverlaps :: MVector s (V2 a) -> MVector s (V2 a) -> Bool # basicUnsafeNew :: Int -> ST s (MVector s (V2 a)) # basicInitialize :: MVector s (V2 a) -> ST s () # basicUnsafeReplicate :: Int -> V2 a -> ST s (MVector s (V2 a)) # basicUnsafeRead :: MVector s (V2 a) -> Int -> ST s (V2 a) # basicUnsafeWrite :: MVector s (V2 a) -> Int -> V2 a -> ST s () # basicClear :: MVector s (V2 a) -> ST s () # basicSet :: MVector s (V2 a) -> V2 a -> ST s () # basicUnsafeCopy :: MVector s (V2 a) -> MVector s (V2 a) -> ST s () # basicUnsafeMove :: MVector s (V2 a) -> MVector s (V2 a) -> ST s () # basicUnsafeGrow :: MVector s (V2 a) -> Int -> ST s (MVector s (V2 a)) # | |
| Data a => Data (V2 a) | |
Defined in Linear.V2 Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> V2 a -> c (V2 a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (V2 a) # dataTypeOf :: V2 a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (V2 a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (V2 a)) # gmapT :: (forall b. Data b => b -> b) -> V2 a -> V2 a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> V2 a -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> V2 a -> r # gmapQ :: (forall d. Data d => d -> u) -> V2 a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> V2 a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> V2 a -> m (V2 a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> V2 a -> m (V2 a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> V2 a -> m (V2 a) # | |
| Storable a => Storable (V2 a) | |
| Monoid a => Monoid (V2 a) | |
| Semigroup a => Semigroup (V2 a) | |
| Bounded a => Bounded (V2 a) | |
| Floating a => Floating (V2 a) | |
| Generic (V2 a) | |
| Ix a => Ix (V2 a) | |
| Num a => Num (V2 a) | |
| Read a => Read (V2 a) | |
| Fractional a => Fractional (V2 a) | |
| Show a => Show (V2 a) | |
| Binary a => Binary (V2 a) | |
| Serial a => Serial (V2 a) | |
| Serialize a => Serialize (V2 a) | |
| NFData a => NFData (V2 a) | |
| Eq a => Eq (V2 a) | |
| Ord a => Ord (V2 a) | |
| Hashable a => Hashable (V2 a) | |
| Ixed (V2 a) | |
| Epsilon a => Epsilon (V2 a) | |
| Random a => Random (V2 a) | |
| Unbox a => Unbox (V2 a) | |
Defined in Linear.V2 | |
| FoldableWithIndex (E V2) V2 | |
| FunctorWithIndex (E V2) V2 | |
| TraversableWithIndex (E V2) V2 | |
| Lift a => Lift (V2 a :: Type) | |
| Each (V2 a) (V2 b) a b | |
| Field1 (V2 a) (V2 a) a a | |
| Field2 (V2 a) (V2 a) a a | |
| type Rep V2 | |
| type Size V2 | |
| type Rep1 V2 | |
Defined in Linear.V2 type Rep1 V2 = D1 ('MetaData "V2" "Linear.V2" "linear-1.22-ANafbhSdznBKD15zEySBd9" 'False) (C1 ('MetaCons "V2" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) Par1 :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) Par1)) | |
| data MVector s (V2 a) | |
| type Rep (V2 a) | |
Defined in Linear.V2 type Rep (V2 a) = D1 ('MetaData "V2" "Linear.V2" "linear-1.22-ANafbhSdznBKD15zEySBd9" 'False) (C1 ('MetaCons "V2" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 a) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 a))) | |
| type Index (V2 a) | |
| type IxValue (V2 a) | |
| data Vector (V2 a) | |
A 4-dimensional vector.
Constructors
| V4 !a !a !a !a |
Instances
| Representable V4 | |
| MonadFix V4 | |
| MonadZip V4 | |
| Foldable V4 | |
Defined in Linear.V4 Methods fold :: Monoid m => V4 m -> m # foldMap :: Monoid m => (a -> m) -> V4 a -> m # foldMap' :: Monoid m => (a -> m) -> V4 a -> m # foldr :: (a -> b -> b) -> b -> V4 a -> b # foldr' :: (a -> b -> b) -> b -> V4 a -> b # foldl :: (b -> a -> b) -> b -> V4 a -> b # foldl' :: (b -> a -> b) -> b -> V4 a -> b # foldr1 :: (a -> a -> a) -> V4 a -> a # foldl1 :: (a -> a -> a) -> V4 a -> a # elem :: Eq a => a -> V4 a -> Bool # maximum :: Ord a => V4 a -> a # | |
| Eq1 V4 | |
| Ord1 V4 | |
| Read1 V4 | |
| Show1 V4 | |
| Traversable V4 | |
| Applicative V4 | |
| Functor V4 | |
| Monad V4 | |
| Serial1 V4 | |
Defined in Linear.V4 Methods serializeWith :: MonadPut m => (a -> m ()) -> V4 a -> m () # deserializeWith :: MonadGet m => m a -> m (V4 a) # | |
| Distributive V4 | |
| Foldable1 V4 | |
Defined in Linear.V4 Methods fold1 :: Semigroup m => V4 m -> m # foldMap1 :: Semigroup m => (a -> m) -> V4 a -> m # foldMap1' :: Semigroup m => (a -> m) -> V4 a -> m # toNonEmpty :: V4 a -> NonEmpty a # maximum :: Ord a => V4 a -> a # minimum :: Ord a => V4 a -> a # foldrMap1 :: (a -> b) -> (a -> b -> b) -> V4 a -> b # foldlMap1' :: (a -> b) -> (b -> a -> b) -> V4 a -> b # foldlMap1 :: (a -> b) -> (b -> a -> b) -> V4 a -> b # foldrMap1' :: (a -> b) -> (a -> b -> b) -> V4 a -> b # | |
| Hashable1 V4 | |
| Metric V4 | |
| Finite V4 | |
| R1 V4 | |
| R2 V4 | |
| R3 V4 | |
| R4 V4 | |
| Additive V4 | |
| Apply V4 | |
| Bind V4 | |
| Traversable1 V4 | |
| Generic1 V4 | |
| Unbox a => Vector Vector (V4 a) | |
Defined in Linear.V4 Methods basicUnsafeFreeze :: Mutable Vector s (V4 a) -> ST s (Vector (V4 a)) # basicUnsafeThaw :: Vector (V4 a) -> ST s (Mutable Vector s (V4 a)) # basicLength :: Vector (V4 a) -> Int # basicUnsafeSlice :: Int -> Int -> Vector (V4 a) -> Vector (V4 a) # basicUnsafeIndexM :: Vector (V4 a) -> Int -> Box (V4 a) # basicUnsafeCopy :: Mutable Vector s (V4 a) -> Vector (V4 a) -> ST s () # | |
| Unbox a => MVector MVector (V4 a) | |
Defined in Linear.V4 Methods basicLength :: MVector s (V4 a) -> Int # basicUnsafeSlice :: Int -> Int -> MVector s (V4 a) -> MVector s (V4 a) # basicOverlaps :: MVector s (V4 a) -> MVector s (V4 a) -> Bool # basicUnsafeNew :: Int -> ST s (MVector s (V4 a)) # basicInitialize :: MVector s (V4 a) -> ST s () # basicUnsafeReplicate :: Int -> V4 a -> ST s (MVector s (V4 a)) # basicUnsafeRead :: MVector s (V4 a) -> Int -> ST s (V4 a) # basicUnsafeWrite :: MVector s (V4 a) -> Int -> V4 a -> ST s () # basicClear :: MVector s (V4 a) -> ST s () # basicSet :: MVector s (V4 a) -> V4 a -> ST s () # basicUnsafeCopy :: MVector s (V4 a) -> MVector s (V4 a) -> ST s () # basicUnsafeMove :: MVector s (V4 a) -> MVector s (V4 a) -> ST s () # basicUnsafeGrow :: MVector s (V4 a) -> Int -> ST s (MVector s (V4 a)) # | |
| Data a => Data (V4 a) | |
Defined in Linear.V4 Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> V4 a -> c (V4 a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (V4 a) # dataTypeOf :: V4 a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (V4 a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (V4 a)) # gmapT :: (forall b. Data b => b -> b) -> V4 a -> V4 a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> V4 a -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> V4 a -> r # gmapQ :: (forall d. Data d => d -> u) -> V4 a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> V4 a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> V4 a -> m (V4 a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> V4 a -> m (V4 a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> V4 a -> m (V4 a) # | |
| Storable a => Storable (V4 a) | |
| Monoid a => Monoid (V4 a) | |
| Semigroup a => Semigroup (V4 a) | |
| Bounded a => Bounded (V4 a) | |
| Floating a => Floating (V4 a) | |
| Generic (V4 a) | |
| Ix a => Ix (V4 a) | |
| Num a => Num (V4 a) | |
| Read a => Read (V4 a) | |
| Fractional a => Fractional (V4 a) | |
| Show a => Show (V4 a) | |
| Binary a => Binary (V4 a) | |
| Serial a => Serial (V4 a) | |
| Serialize a => Serialize (V4 a) | |
| NFData a => NFData (V4 a) | |
| Eq a => Eq (V4 a) | |
| Ord a => Ord (V4 a) | |
| Hashable a => Hashable (V4 a) | |
| Ixed (V4 a) | |
| Epsilon a => Epsilon (V4 a) | |
| Random a => Random (V4 a) | |
| Unbox a => Unbox (V4 a) | |
Defined in Linear.V4 | |
| FoldableWithIndex (E V4) V4 | |
| FunctorWithIndex (E V4) V4 | |
| TraversableWithIndex (E V4) V4 | |
| Lift a => Lift (V4 a :: Type) | |
| Each (V4 a) (V4 b) a b | |
| Field1 (V4 a) (V4 a) a a | |
| Field2 (V4 a) (V4 a) a a | |
| Field3 (V4 a) (V4 a) a a | |
| Field4 (V4 a) (V4 a) a a | |
| type Rep V4 | |
| type Size V4 | |
| type Rep1 V4 | |
Defined in Linear.V4 type Rep1 V4 = D1 ('MetaData "V4" "Linear.V4" "linear-1.22-ANafbhSdznBKD15zEySBd9" 'False) (C1 ('MetaCons "V4" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) Par1 :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) Par1) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) Par1 :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) Par1))) | |
| data MVector s (V4 a) | |
| type Rep (V4 a) | |
Defined in Linear.V4 type Rep (V4 a) = D1 ('MetaData "V4" "Linear.V4" "linear-1.22-ANafbhSdznBKD15zEySBd9" 'False) (C1 ('MetaCons "V4" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 a) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 a)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 a) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 a)))) | |
| type Index (V4 a) | |
| type IxValue (V4 a) | |
| data Vector (V4 a) | |