Octree 0.5.4.3 → 0.5.4.4

raw patch · 6 files changed

+85/−62 lines, 6 filesdep −markdown-unlitdep ~QuickCheckPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: markdown-unlit

Dependency ranges changed: QuickCheck

API changes (from Hackage documentation)

Files

• Data/Octree.hs +3/−1
• Data/Octree/Internal.hs +27/−13
• Octree.cabal +14/−10
• README.lhs +0/−30
• changelog +7/−0
• tests/test_Octree.hs +34/−8

@@ -1,9 +1,11 @@ module Data.Octree(Octree,                    Vector3(..),-                   dist, +                   dist,                    fromList, toList,                    lookup,                    insert,+                   delete,+                   deleteBy,                    nearest,                    depth,                    size,

@@ -1,7 +1,7 @@ {-# LANGUAGE ScopedTypeVariables, DisambiguateRecordFields #-} {-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} module Data.Octree.Internal(Vector3(..), dist,-                            Octree(..), lookup, nearest, withinRange, fromList, toList, insert,+                            Octree(..), lookup, nearest, withinRange, fromList, toList, insert, delete, deleteBy,                             -- internal                             ODir(..),                             octreeStep, octantDistance, splitBy', joinStep, splitStep, allOctants, octantDistance',@@ -20,7 +20,7 @@  --import Text.Show import Prelude hiding(lookup, foldr)-import Data.List(sort, sortBy)+import qualified Data.List as List (delete, deleteBy, sortBy) import Data.Maybe(maybeToList, listToMaybe) import Data.Bits((.&.)) import Control.Arrow(second)@@ -33,7 +33,7 @@  -- | distance between two vectors dist ::  Vector3 -> Vector3 -> Double-dist u v = norm (u - v) +dist u v = norm (u - v)  -- | Datatype for nodes within Octree. data Octree a = Node { split :: Vector3,@@ -59,10 +59,10 @@ octreeStep ot NWU = nwu ot octreeStep ot NWD = nwd ot octreeStep ot NEU = neu ot-octreeStep ot NED = ned ot -octreeStep ot SWU = swu ot -octreeStep ot SWD = swd ot -octreeStep ot SEU = seu ot +octreeStep ot NED = ned ot+octreeStep ot SWU = swu ot+octreeStep ot SWD = swd ot+octreeStep ot SEU = seu ot octreeStep ot SED = sed ot  -- | Function that splits octant name into three boolean values, depending of sign of a relative coordinate in that octant.@@ -107,7 +107,7 @@ -- | Toggles octant names depending on a signs of vector coordinates -- | for use in octantDistance. toggle :: Vector3 -> ODir -> ODir-toggle dp odir = +toggle dp odir =   joinStep ((v3x dp >= 0) `xor` not u,             (v3y dp >= 0) `xor` not v,             (v3z dp >= 0) `xor` not w)@@ -226,12 +226,27 @@         insert' (Leaf l) = fromList ((pt, dat) : l)         insert' _        = error "Impossible in insert'" +-- | Deletes a point from an Octree.+-- | NOTE: If there are duplicate points, it only deletes one of them.+delete :: (Eq a) => (Vector3, a) -> Octree a -> Octree a+delete tup@(pt, _) ot = applyByPath delete' path ot+  where path             = pathTo pt ot+        delete' (Leaf l) = fromList (List.delete tup l)+        delete' _        = error "Impossible in delete'" +-- | Deletes a point from an Octree with the provided equality check.+-- | NOTE: If there are duplicate points, it only deletes one of them.+deleteBy :: ((Vector3, a) -> (Vector3, a) -> Bool) -> (Vector3, a) -> Octree a -> Octree a+deleteBy eq tup@(pt, _) ot = applyByPath deleteBy' path ot+  where path             = pathTo pt ot+        deleteBy' (Leaf l) = fromList (List.deleteBy eq tup l)+        deleteBy' _        = error "Impossible in deleteBy'"+ -- | Internal: finds candidates for nearest neighbour lazily for each octant; -- | they are returned in a list of (octant, min. bound for distance, Maybe candidate) tuples. candidates' :: Vector3 -> Octree a -> [(ODir, Double, [(Vector3, a)])] candidates' pt (Leaf l) = []-candidates' pt node     = map findCandidates . sortBy compareDistance . octantDistances $ pt - split node+candidates' pt node     = map findCandidates . List.sortBy compareDistance . octantDistances $ pt - split node   where     findCandidates (octant, d) = (octant, d, maybeToList . pickClosest pt . toList . octreeStep node $ octant)     compareDistance a b  = compare (snd a) (snd b)@@ -245,7 +260,7 @@ nearest :: Octree a -> Vector3 -> Maybe (Vector3, a) nearest (Leaf l) pt = pickClosest pt l nearest node     pt = selectFrom candidates-  where candidates                 = map findCandidate . sortBy compareDistance . octantDistances $ pt - split node+  where candidates                 = map findCandidate . List.sortBy compareDistance . octantDistances $ pt - split node         compareDistance a b  = compare (snd a) (snd b)         findCandidate (octant, d) = (maybeToList . nearest' . octreeStep node $ octant, d)         selectFrom (([],     _d) : cs) = selectFrom       cs@@ -253,7 +268,7 @@         selectFrom []                  = Nothing         nearest'   n                   = nearest n pt -        +         selectFrom' best (([],     d) : cs)                          = selectFrom' best     cs         -- TODO: FAILS: shortcut guard to avoid recursion over whole structure (since d is bound for distance within octant):         selectFrom' best ((c,      d) : cs) | d > dist pt (fst best) = Just best@@ -263,7 +278,7 @@                              else next         selectFrom' best []                                          = Just best --- | Internal method that picks from a given list a point closest to argument, +-- | Internal method that picks from a given list a point closest to argument, pickClosest ::  Vector3 -> [(Vector3, t)] -> Maybe (Vector3, t) pickClosest pt []     = Nothing pickClosest pt (a:as) = Just $ foldr (pickCloser pt) a as@@ -292,4 +307,3 @@  size :: Octree a -> Int size =  length . toList-

@@ -1,5 +1,5 @@ name:                Octree-version:             0.5.4.3+version:             0.5.4.4 stability:           beta homepage:            https://github.com/mgajda/octree package-url:         http://hackage.haskell.org/package/octree@@ -18,14 +18,18 @@  build-type:          Simple cabal-version:       >=1.8-tested-with:         GHC==7.6.3,GHC==7.8.3+tested-with:         GHC==7.6.3+                    ,GHC==7.8.4+                    ,GHC==7.10.3+                    ,GHC==8.0.1+                    ,GHC==8.2.2  source-repository head   type:     git   location: git@github.com:mgajda/octree.git  Library-   build-depends:    base>=4.0 && < 4.10, AC-Vector >= 2.3.0, QuickCheck >= 2.4.0+   build-depends:    base>=4.0 && < 4.11, AC-Vector >= 2.3.0, QuickCheck >= 2.4.0    exposed-modules:  Data.Octree    other-modules:    Data.Octree.Internal    exposed:          True@@ -33,13 +37,13 @@  Test-suite test_Octree   Type:              exitcode-stdio-1.0-  Build-depends:     base>=4.0 && < 4.10, AC-Vector >= 2.3.0, QuickCheck >= 2.4.0+  Build-depends:     base>=4.0 && < 4.11, AC-Vector >= 2.3.0, QuickCheck >= 2.8.0   Main-is:           tests/test_Octree.hs -Test-suite readme-  type:           exitcode-stdio-1.0-  -- We have a symlink: README.lhs -> README.md-  main-is:        README.lhs-  Build-depends:  base>=4.0 && < 4.10, AC-Vector >= 2.3.0, QuickCheck >= 2.4.0, markdown-unlit-  ghc-options:    -pgmL markdown-unlit+--Test-suite readme+--  type:           exitcode-stdio-1.0+--  -- We have a symlink: README.lhs -> README.md+--  main-is:        README.lhs+--  Build-depends:  base>=4.0 && < 4.11, AC-Vector >= 2.3.0, QuickCheck >= 2.4.0, markdown-unlit+--  ghc-options:    -pgmL markdown-unlit 

@@ -1,30 +0,0 @@-octree-======-This is a simple Octree implementation in Haskell.--[![Build Status](https://api.travis-ci.org/BioHaskell/octree.png?branch=master)](https://www.travis-ci.org/BioHaskell/octree)--To use simply:--~~~ {.haskell}-module Main where--import Data.Octree as O--import Data.Vector.V3--main = do let oct = fromList [(Vector3 1 2 3, "a"),-                              (Vector3 3 4 5, "b"),-                              (Vector3 8 8 8, "c")]-              report msg elt = putStrLn $ msg ++ show elt-          report "Nearest     :" $ O.nearest     oct     $ Vector3 2 2 3-          report "Within range:" $ O.withinRange oct 5.0 $ Vector3 2 2 3-          return ()-~~~--*For now it uses AC-Vector package for vectors, but I may change it to use Tensor package used by OpenGL package, if there is interest.*-*So far I still wait for package with vector operations (like dot, cross producton, vector projection and rejection) on Tensor types.*--Official releases are on [Hackage](http://hackage.haskell.org/package/Octree).--This package is also a part of [Stackage](http://daniel-diaz.github.io/stackagelist/) - a stable subset of Hackage.

@@ -1,4 +1,11 @@ -*-Changelog-*-+0.5.4.4 Dec 2017+	* Remove doctest since it is fragile (depends on markdown-unlit being+	on path.)++0.5.4.3 Nov 2017+	* Relax deps for GHC 8.2+ 0.5.4.3 May 2016 	* Relax base dependency for GHC 8.0 (and base 4.9) 

@@ -1,13 +1,16 @@ {-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}-module Main(main) where+module Main where  import Data.Octree.Internal import Data.Octree() -- test that interface module is not broken import Prelude hiding(lookup) import Data.List(sort, sortBy)+import qualified Data.List as List (delete, nub)  import Test.QuickCheck.All(quickCheckAll) import Test.QuickCheck.Arbitrary+import Test.QuickCheck.Gen (elements)+import Test.QuickCheck.Modifiers (NonEmptyList (..))  import Data.Vector.Class import Control.Arrow(second)@@ -27,6 +30,15 @@                  z <- arbitrary                  return $ Vector3 x y z +data ElementListWithElement a = ElementListWithElement [(Vector3, a)] (Vector3, a) deriving (Show)++instance Arbitrary a => Arbitrary (ElementListWithElement a) where+  arbitrary = do+    nonEmptyElementList <- arbitrary+    let elementList = getNonEmpty nonEmptyElementList+    element <- elements elementList+    return $ ElementListWithElement elementList element+ -- | These are tests for internal helper functions:  -- for easier testing@@ -68,7 +80,7 @@   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] +  where ot   = splitBy' Leaf splitPt [arg]         arg  = (pt, dist pt splitPt)  @@ -83,23 +95,34 @@  prop_fromToList         l = sort l == (sort . toList . fromList $ l) prop_insertionPreserved l = sort l == (sort . toList . foldr insert (Leaf []) $ l)+prop_delete             (ElementListWithElement l e) = sort (List.delete e l) == (sort . toList . delete e . fromList $ l)+prop_delete_empty       e = [] == (toList . delete e . fromList $ [])++prop_delete_nonexisting :: forall t. Ord t => NonEmptyList (Vector3, t) -> Bool+prop_delete_nonexisting l = sort uniqueListTail == (sort . toList . delete e . fromList $ uniqueListTail)+  where uniqueList = List.nub $ getNonEmpty l+        (e:uniqueListTail) = uniqueList prop_nearest            l pt = nearest (fromList l) pt == naiveNearest pt l prop_naiveWithinRange   r l pt = naiveWithinRange r pt l == (sort . map fst . (\o -> withinRange o r pt) . fromList . tuplify pt $ l)  tuplify pt = map (\a -> (a, dist pt a)) -compareDistance pt a b = compare (dist pt (fst a)) (dist pt (fst b))+compareDistance pt (a,_) (b,_) = compare (dist pt a) (dist pt b) -naiveNearest pt l = if byDist == [] then Nothing else Just . head $ byDist+naiveNearest pt [] = Nothing+naiveNearest pt l  = Just $ head byDist   where byDist = sortBy (compareDistance pt) l -naiveWithinRange r pt l = sort . filter (\p -> dist pt p <= r) $ l+naiveWithinRange r pt = sort . filter withinRange+  where+    withinRange p = dist pt p <= r  -- unfortunately there is no Arbitrary for (a -> b) -- since generic properties are quite common, I wonder how to force Quickcheck to default something reasonable?-prop_fmap1 l = genericProperty_fmap (+1) l-prop_fmap2 l = genericProperty_fmap (*2) l-prop_fmap3 l = genericProperty_fmap show l+prop_fmap1,prop_fmap2 :: [(Vector3, Int)] -> Bool+prop_fmap1 = genericProperty_fmap (+1)+prop_fmap2 = genericProperty_fmap (*2)+prop_fmap3 = genericProperty_fmap (show :: Int -> String)  genericProperty_fmap f l = (sort . map (Control.Arrow.second f) $ l) == (sort . toList . fmap f . fromList $ l) @@ -111,4 +134,7 @@  prop_size l = size (fromList l) == length l +return []+ main = $quickCheckAll+