nspace 0.1.0.0 → 0.2.0.0

raw patch · 9 files changed

+210/−15 lines, 9 filesdep +hspecPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−1
• nspace.cabal +6/−1
• src/Data/OctTree.hs +1/−3
• src/Data/OctTree/Internal.hs +2/−2
• src/Data/QuadTree.hs +3/−4
• src/Data/QuadTree/Internal.hs +2/−2
• test/OctTreeSpec.hs +89/−0
• test/QuadTreeSpec.hs +92/−0
• test/Spec.hs +1/−2

@@ -6,6 +6,19 @@ and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). + ## Unreleased -## 0.1.0.0 - YYYY-MM-DD++## 0.2.0.0 - 2024-01-01++- Removed `Data.QuadTree.rect` function+- Removed `Data.OctTree.cube` function+- Fixed a bug in `rectContainsPoint` when dealing with negative sizes+- Fixed a bug in `cubeContainsPoint` when dealing with negative sizes+++## 0.1.0.0 - 2023-12-31++- Unreleased upon a suspecting world+

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           nspace-version:        0.1.0.0+version:        0.2.0.0 synopsis:       Efficient, infinite-precision 2D and 3D spatial containers. description:    Please see the README on GitHub at <https://github.com/isovector/nspace#readme> category:       Data Structures@@ -71,6 +71,8 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:+      OctTreeSpec+      QuadTreeSpec       Paths_nspace   autogen-modules:       Paths_nspace@@ -97,12 +99,15 @@       TypeApplications       ViewPatterns   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-tool-depends:+      hspec-discover:hspec-discover >=2.0   build-depends:       QuickCheck     , base >=4.7 && <5     , checkers     , containers     , hashable+    , hspec     , linear     , monoidal-containers     , nspace

@@ -5,7 +5,6 @@   ( OctTree (..)      -- * Constructing 'OctTree's-  , cube   , fill   , combineAla @@ -78,8 +77,7 @@ -- 'Rational' -> a@, equipped with efficient means of querying the space. -- -- 'OctTree's should usually be constructed using their 'Monoid'al or--- 'Applicative' interfaces, as well as by way of the 'cube' and 'fill'--- functions.+-- 'Applicative' interfaces, as well as by way of the 'fill' function. data OctTree a = OctTree   { ot_default  :: a   , ot_root_pow :: Integer

@@ -47,10 +47,10 @@ ------------------------------------------------------------------------------ -- | Does the cube contain a given point? cubeContainsPoint :: (Ord a, Num a) => Cube a -> V3 a -> Bool-cubeContainsPoint (Cube _ (V3 w h d)) _+cubeContainsPoint (normalize -> Cube _ (V3 w h d)) _   | w <= 0 || h <= 0 || d <= 0   = False-cubeContainsPoint (Cube (V3 x y z) (V3 w h d)) (V3 tx ty tz) =+cubeContainsPoint (normalize -> Cube (V3 x y z) (V3 w h d)) (V3 tx ty tz) =   and     [ x <= tx     , y <= ty

@@ -5,7 +5,6 @@   ( QuadTree (..)      -- * Constructing 'QuadTree's-  , rect   , fill   , combineAla @@ -74,8 +73,8 @@ -- 'Rational' -> a@, equipped with efficient means of querying the space. -- -- 'QuadTree's should usually be constructed using their 'Monoid'al or--- 'Applicative' interfaces, as well as by way of the 'rect' and 'fill'--- functions.+-- 'Applicative' interfaces, as well as by way of the 'fill'+-- function. data QuadTree a = QuadTree   { ot_default  :: a   , ot_root_pow :: Integer@@ -247,7 +246,7 @@ -- Satsifies the law -- -- @--- 'foldMap' (uncurry $ 'rect' ('defaultValue' ot)) ('toRects' ot) == ot+-- foldr (uncurry 'fill') (pure $ 'defaultValue' ot) ('toRects' ot) == ot -- @ toRects :: QuadTree a -> [(Rect Rational, a)] toRects (QuadTree _ n q) = toRectsImpl (mkRectByPow n) q

@@ -45,10 +45,10 @@ ------------------------------------------------------------------------------ -- | Does the rect contain a given point? rectContainsPoint :: (Ord a, Num a) => Rect a -> V2 a -> Bool-rectContainsPoint (Rect _ (V2 w h)) _+rectContainsPoint (normalize -> Rect _ (V2 w h)) _   | w <= 0 || h <= 0   = False-rectContainsPoint (Rect (V2 x y) (V2 w h)) (V2 tx ty) =+rectContainsPoint (normalize -> Rect (V2 x y) (V2 w h)) (V2 tx ty) =   and     [ x <= tx     , y <= ty

@@ -0,0 +1,89 @@+{-# OPTIONS_GHC -Wno-orphans #-}++module OctTreeSpec where++import Data.Foldable+import Data.Monoid (Sum)+import Data.OctTree hiding (elements)+import Data.OctTree.Internal (cubeContainsPoint, Free(..))+import Data.Ratio+import Data.Semigroup (Any(..), Max(..))+import Data.Semilattice+import Prelude hiding (lookup)+import QuadTreeSpec ()+import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck+import Test.QuickCheck.Checkers+import Test.QuickCheck.Classes++instance Arbitrary a => Arbitrary (Oct a) where+  arbitrary = Oct <$> arbitrary <*> arbitrary+  shrink = genericShrink++instance Arbitrary a => Arbitrary (Cube a) where+  arbitrary = Cube <$> arbitrary <*> arbitrary+  shrink = genericShrink++instance Arbitrary a => Arbitrary (V3 a) where+  arbitrary = V3 <$> arbitrary <*> arbitrary <*> arbitrary+  shrink = genericShrink++instance EqProp a => EqProp (OctTree a) where+  q1 =-= q2 = property $ \a -> flip lookup q1 a =-= flip lookup q2 a++instance Arbitrary a => Arbitrary (Free a) where+  arbitrary =+    let terminal = [Fill <$> arbitrary]+     in sized $ \n ->+          case n <= 1 of+            True -> oneof terminal+            False -> oneof $+              [ Split <$> Test.QuickCheck.scale (`div` 4) arbitrary+              ] <> terminal+  shrink = genericShrink++instance Arbitrary a => Arbitrary (OctTree a) where+  arbitrary = OctTree <$> arbitrary <*> elements [0..10] <*> arbitrary++observe :: OctTree a -> V3 Rational -> a+observe = flip lookup++propBatch :: String -> TestBatch -> Spec+propBatch s = describe s . traverse_ (uncurry prop) . unbatch++spec :: Spec+spec = modifyMaxSuccess (const 10000) $ do+  prop "empty" $ \(a :: Int) ->+    observe (pure a)+      =-= const a++  prop "fill" $ \r (a :: Int) q ->+    observe (fill r a q)+      =-= \p -> if cubeContainsPoint r p then a else observe q p++  prop "fuse" $ \(q :: OctTree (Sum Int)) ->+    observe (fuse q)+      =-= observe q++  prop "query" $ \(applyFun -> f :: Bool -> Any) q x y z w h d ->+    let r = Cube (V3 x y z) (V3 w h d) in+      query f r q =-= f (lookup (midpoint r) q) /\+        foldr1 (/\) ((flip (query f) q) <$> subdivide r)++  prop "tocubes" $ \(ot :: OctTree Int) -> do+    ot =-= foldr (uncurry fill) (pure $ defaultValue ot) (toCubes ot)+++  prop "mempty" $+    observe (mempty @(OctTree (Sum Int)))+      =-= mempty++  prop "<>" $ \(q1 :: OctTree (Sum Int)) q2 ->+    observe (q1 <> q2)+      =-= observe q1 <> observe q2++  propBatch "OctTree Semigroup" $ semigroup ((0 :: Max Int), (0 :: Int))+  propBatch "OctTree Monoid" $ monoid ((0 :: Max Int), ([] :: [Int]))+  propBatch "OctTree Applicative" $ applicative (undefined :: OctTree (Int, Int, Int))+

@@ -0,0 +1,92 @@+{-# OPTIONS_GHC -Wno-orphans #-}++module QuadTreeSpec where++import Data.Foldable+import Data.Monoid (Sum)+import Data.QuadTree hiding (elements)+import Data.QuadTree.Internal (rectContainsPoint, Free(..))+import Data.Ratio+import Data.Semigroup (Any(..), Max(..))+import Data.Semilattice+import Prelude hiding (lookup)+import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck+import Test.QuickCheck.Checkers+import Test.QuickCheck.Classes++instance Arbitrary a => Arbitrary (Max a) where+  arbitrary = Max <$> arbitrary+  shrink = genericShrink++instance Arbitrary a => Arbitrary (V4 a) where+  arbitrary = V4 <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+  shrink = genericShrink++instance Arbitrary a => Arbitrary (Rect a) where+  arbitrary = Rect <$> arbitrary <*> arbitrary+  shrink = genericShrink++instance Arbitrary a => Arbitrary (V2 a) where+  arbitrary = V2 <$> arbitrary <*> arbitrary+  shrink = genericShrink++instance EqProp a => EqProp (QuadTree a) where+  q1 =-= q2 = property $ \a -> flip lookup q1 a =-= flip lookup q2 a++instance Arbitrary a => Arbitrary (Free a) where+  arbitrary =+    let terminal = [Fill <$> arbitrary]+     in sized $ \n ->+          case n <= 1 of+            True -> oneof terminal+            False -> oneof $+              [ Split <$> Test.QuickCheck.scale (`div` 4) arbitrary+              ] <> terminal+  shrink = genericShrink++instance Arbitrary a => Arbitrary (QuadTree a) where+  arbitrary = QuadTree <$> arbitrary <*> elements [0..10] <*> arbitrary++observe :: QuadTree a -> V2 Rational -> a+observe = flip lookup++propBatch :: String -> TestBatch -> Spec+propBatch s = describe s . traverse_ (uncurry prop) . unbatch++spec :: Spec+spec = modifyMaxSuccess (const 10000) $ do+  prop "empty" $ \(a :: Int) ->+    observe (pure a)+      =-= const a++  prop "fill" $ \r (a :: Int) q ->+    observe (fill r a q)+      =-= \p -> if rectContainsPoint r p then a else observe q p++  prop "fuse" $ \(q :: QuadTree (Sum Int)) ->+    observe (fuse q)+      =-= observe q++  prop "query" $ \(applyFun -> f :: Bool -> Any) q x y w h ->+    let r = Rect (V2 x y) (V2 w h) in+      query f r q =-= f (lookup (midpoint r) q) /\+        foldr1 (/\) ((flip (query f) q) <$> subdivide r)++  prop "toRects" $ \(ot :: QuadTree Int) -> do+    ot =-= foldr (uncurry fill) (pure $ defaultValue ot) (toRects ot)+++  prop "mempty" $+    observe (mempty @(QuadTree (Sum Int)))+      =-= mempty++  prop "<>" $ \(q1 :: QuadTree (Sum Int)) q2 ->+    observe (q1 <> q2)+      =-= observe q1 <> observe q2++  propBatch "QuadTree Semigroup" $ semigroup ((0 :: Max Int), (0 :: Int))+  propBatch "QuadTree Monoid" $ monoid ((0 :: Max Int), ([] :: [Int]))+  propBatch "QuadTree Applicative" $ applicative (undefined :: QuadTree (Int, Int, Int))+

@@ -1,2 +1,1 @@-main :: IO ()-main = putStrLn "Test suite not yet implemented"+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}