Octree 0.2.3 → 0.3
raw patch · 4 files changed
+36/−24 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Data.Octree: depth :: Octree a -> Int
Files
- Data/Octree.hs +1/−0
- Data/Octree/Internal.hs +15/−8
- Octree.cabal +1/−1
- tests/test_Octree.hs +19/−15
Data/Octree.hs view
@@ -5,6 +5,7 @@ lookup, insert, nearest,+ depth, withinRange) where
Data/Octree/Internal.hs view
@@ -1,11 +1,12 @@-{-# LANGUAGE ScopedTypeVariables, RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables, DisambiguateRecordFields #-} module Data.Octree.Internal(Vector3(..), dist, Octree(..), lookup, nearest, withinRange, fromList, toList, insert, -- internal ODir(..), octreeStep, octantDistance, splitBy', joinStep, splitStep, allOctants, octantDistance', cmp,- pickClosest+ pickClosest,+ depth ) where import Data.Vector.V3@@ -16,6 +17,7 @@ import Data.List(sort, sortBy) import Data.Maybe(maybeToList, listToMaybe) import Data.Bits((.&.))+import Control.Arrow(second) import Test.QuickCheck.All(quickCheckAll) import Test.QuickCheck.Arbitrary @@ -27,12 +29,13 @@ dist :: Vector3 -> Vector3 -> Double dist u v = norm (u - v) +-- | Datatype for nodes within Octree. data Octree a = Node { split :: Vector3, nwu, nwd, neu, ned, swu, swd, seu, sed :: Octree a } | Leaf { unLeaf :: [(Vector3, a)] } deriving (Show) instance Functor Octree where- fmap f (Leaf l) = Leaf . fmap (\(c, a) -> (c, f a)) $ l+ fmap f (Leaf l) = Leaf . fmap (Control.Arrow.second f) $ l fmap f (Node { split = sp, nwu = anwu, nwd = anwd,@@ -54,6 +57,10 @@ -- | Enumerated type to indicate octants in 3D-space relative to given center. data ODir = SWD | SED | NWD | NED | SWU | SEU | NWU | NEU deriving (Eq, Ord, Enum, Show, Bounded) +depth :: Octree a -> Int+depth (Leaf l) = 0+depth (Node _ a b c d e f g h) = Prelude.maximum . map (\n -> depth n + 1) $ [a, b, c, d, e, f, g, h]+ -- | Internal method that gives octant of a first vector relative to the second vector as a center. cmp :: Vector3 -> Vector3 -> ODir cmp ca cb = joinStep (cx, cy, cz)@@ -173,6 +180,7 @@ then Leaf aList else let splitPoint :: Vector3 = massCenter aList in splitBy' fromList splitPoint aList+ -- | Internal method, that splits a list into octants depending on coordinates, -- | and then applies a specified function to each of these sublists, -- | in order to create subnodes of the Octree@@ -257,7 +265,7 @@ nearest node pt = selectFrom candidates where candidates = map findCandidate . sortBy compareDistance . octantDistances $ pt - split node compareDistance a b = compare (snd a) (snd b)- findCandidate (octant, d) = (maybeToList . nearest' $ octreeStep node $ octant, d)+ findCandidate (octant, d) = (maybeToList . nearest' . octreeStep node $ octant, d) selectFrom (([], _d) : cs) = selectFrom cs selectFrom (([best], _d) : cs) = selectFrom' best cs selectFrom [] = Nothing@@ -284,10 +292,9 @@ -- | Returns all points within Octree that are within a given distance from argument. withinRange :: Scalar -> Vector3 -> Octree a -> [(Vector3, a)] withinRange r pt (Leaf l) = filter (\(lpt, _) -> dist pt lpt <= r) l-withinRange r pt node = (concat . -- merge results- map recurseOctant . -- recurse over remaining octants- filter ((<=r) . snd) . -- discard octants that are out of range- octantDistances $ pt - split node) -- find octant distances+withinRange r pt node = concatMap recurseOctant . -- recurse over remaining octants, and merge results+ filter ((<=r) . snd) . -- discard octants that are out of range+ octantDistances $ pt - split node -- find octant distances where recurseOctant (octant, _d) = withinRange r pt . octreeStep node $ octant
Octree.cabal view
@@ -1,5 +1,5 @@ name: Octree-version: 0.2.3+version: 0.3 stability: beta homepage: https://github.com/mgajda/octree package-url: http://hackage.haskell.org/package/octree
tests/test_Octree.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} module Main(main) where import Data.Octree.Internal@@ -10,6 +10,7 @@ import Test.QuickCheck.Arbitrary import Data.Vector.Class+import Control.Arrow(second) -- | For testing purposes instance Ord Vector3 where@@ -30,8 +31,14 @@ -- for easier testing origin :: Vector3-origin = fromInteger 0+origin = 0 +prop_depth a = (depth oct <= ((+1) . ceiling $ expectedDepth)) &&+ (depth oct >= ((\a -> a-1) . floor $ expectedDepth))+ where+ expectedDepth = (logBase 8 :: Double -> Double) . fromIntegral . length $ a+ oct :: Octree Int = fromList a+ prop_cmp1 a b = cmp a b == joinStep (dx >= 0, dy >= 0, dz >= 0) where Vector3 dx dy dz = a - b @@ -41,24 +48,24 @@ prop_stepDescription a b = splitStep (cmp a b) == (v3x a >= v3x b, v3y a >= v3y b, v3z a >= v3z b) prop_octantDistanceNoGreaterThanInterpointDistance0 ptA ptB = triangleInequality - where triangleInequality = (octantDistance' aptA (cmp ptB origin)) <= (dist aptA ptB)+ where triangleInequality = octantDistance' aptA (cmp ptB origin) <= dist aptA ptB aptA = abs ptA prop_octantDistanceNoGreaterThanInterpointDistance ptA ptB vp = triangleInequality- where triangleInequality = (octantDistance (ptA - vp) (cmp ptB vp)) <= (dist ptA ptB)- sameOctant = (cmp ptA vp) == (cmp ptB vp)+ where triangleInequality = octantDistance (ptA - vp) (cmp ptB vp) <= dist ptA ptB+ sameOctant = cmp ptA vp == cmp ptB vp prop_octantDistanceNoGreaterThanInterpointDistanceZero ptA ptB = triangleInequality- where triangleInequality = (octantDistance ptA (cmp ptB origin)) <= (dist ptA ptB)- sameOctant = (cmp ptA origin) == (cmp ptB origin)+ where triangleInequality = octantDistance ptA (cmp ptB origin) <= dist ptA ptB+ sameOctant = cmp ptA origin == cmp ptB origin prop_octantDistanceNoGreaterThanInterpointDistanceZero0 ptA ptB = triangleInequality- where triangleInequality = (octantDistance aptA (cmp ptB origin)) <= (dist aptA ptB)- sameOctant = (cmp aptA origin) == (cmp ptB origin)+ where triangleInequality = octantDistance aptA (cmp ptB origin) <= dist aptA ptB+ sameOctant = cmp aptA origin == cmp ptB origin aptA = abs ptA prop_octantDistanceNoGreaterThanCentroidDistance pt vp = all testFun allOctants- where testFun odir = (octantDistance (pt - vp) odir) <= dist pt vp+ where testFun odir = octantDistance (pt - vp) odir <= dist pt vp prop_splitByPrime splitPt pt = (unLeaf . octreeStep ot . cmp pt $ splitPt) == [arg] where ot = splitBy' Leaf splitPt [arg] @@ -94,9 +101,6 @@ prop_fmap2 l = genericProperty_fmap (*2) l prop_fmap3 l = genericProperty_fmap show l -genericProperty_fmap f l = (sort . mapSnd f $ l) == (sort . toList . fmap f . fromList $ l)- where- mapSnd :: (a -> b) -> [(c, a)] -> [(c, b)]- mapSnd f l = map (\(c, a) -> (c, f a)) l+genericProperty_fmap f l = (sort . map (Control.Arrow.second f) $ l) == (sort . toList . fmap f . fromList $ l) -main = do $quickCheckAll+main = $quickCheckAll