data-r-tree 0.0.4.0 → 0.0.5.0

raw patch · 7 files changed

+214/−93 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/RTree.hs +1/−1
• Data/RTree/Base.hs +22/−21
• Data/RTree/MBB.hs +5/−5
• Data/RTree/Strict.hs +159/−50
• changelog.md +5/−0
• data-r-tree.cabal +1/−1
• test/RTreeStrict.hs +21/−15

@@ -23,7 +23,7 @@ -}  -module Data.RTree +module Data.RTree (     -- * 'MBB'     MBB.MBB

@@ -61,12 +61,12 @@ ) where -import           Prelude hiding (lookup, length, null)+import           Prelude hiding (lookup, length, null, map)  import           Data.Binary import           Data.Function (on) import           Data.List (maximumBy, minimumBy, partition)-import qualified Data.List as L (length)+import qualified Data.List as L (length,map) import           Data.Maybe (catMaybes, isJust) import qualified Data.Maybe as Maybe (mapMaybe) import           Data.Monoid (Monoid, mempty, mappend)@@ -79,14 +79,14 @@  import           Data.RTree.MBB hiding (mbb) -data RTree a = +data RTree a =       Node4 {getMBB :: {-# UNPACK #-} ! MBB, getC1 :: ! (RTree a), getC2 :: ! (RTree a), getC3 :: ! (RTree a), getC4 :: ! (RTree a) }     | Node3 {getMBB :: {-# UNPACK #-} ! MBB, getC1 :: ! (RTree a), getC2 :: ! (RTree a), getC3 :: ! (RTree a) }     | Node2 {getMBB :: {-# UNPACK #-} ! MBB, getC1 :: ! (RTree a), getC2 :: ! (RTree a) }     | Node  {getMBB ::                  MBB, getChildren' :: [RTree a] }     | Leaf  {getMBB :: {-# UNPACK #-} ! MBB, getElem :: a}     | Empty-    deriving (Show, Eq, Functor, Typeable, Generic)+    deriving (Show, Eq, Typeable, Generic, Functor)  -- | It is possible, to change these constants, but the tree won't be space optimal anymore. m, n :: Int@@ -176,7 +176,7 @@   -- ------------------------------------- insert +-- insert  -- | Inserts an element whith the given 'MBB' and a value in a tree. The combining function will be used if the value already exists. insertWith :: (a -> a -> a) -> MBB -> a -> RTree a -> RTree a@@ -193,7 +193,7 @@ simpleMergeEqNode _ l _ = l  -- | Unifies left and right 'RTree'. Will create invalid trees, if the tree is not a leaf and contains 'MBB's which---  also exists in the left tree. Much faster than union, though. +--  also exists in the left tree. Much faster than union, though. unionDistinctWith :: (a -> a -> a) -> RTree a -> RTree a -> RTree a unionDistinctWith _ Empty{} t           = t unionDistinctWith _ t       Empty{}     = t@@ -208,13 +208,13 @@     where     newNode = addLeaf f left right --- | Únifies left and right 'RTree'. Will create invalid trees, if the tree is not a leaf and contains 'MBB'"'s which---  also exists in the left tree. Much faster than union, though. +-- | Únifies left and right 'RTree'. Will create invalid trees, if the tree is not a leaf and contains 'MBB's which+--  also exists in the left tree. Much faster than union, though. unionDistinct :: RTree a -> RTree a -> RTree a unionDistinct = unionDistinctWith const  addLeaf :: (a -> a -> a) -> RTree a -> RTree a -> RTree a-addLeaf f left right +addLeaf f left right     | depth left + 1 == depth right = node (newNode `unionMBB'` right) (newNode : nonEq)     | otherwise                     = node (left `unionMBB'` right) newChildren     where@@ -228,10 +228,10 @@ findNodeWithMinimalAreaIncrease :: (a -> a -> a) -> RTree a -> [RTree a] -> [RTree a] findNodeWithMinimalAreaIncrease f leaf children = splitMinimal xsAndIncrease     where---  xsAndIncrease :: [(RTree a, Double)]    +--  xsAndIncrease :: [(RTree a, Double)]     xsAndIncrease = zip children ((areaIncreasesWith leaf) <$> children)     minimalIncrease = minimum $ snd <$> xsAndIncrease---  xsAndIncrease' :: [(RTree a, Double)]   +--  xsAndIncrease' :: [(RTree a, Double)]     splitMinimal [] = []     splitMinimal ((t,mbb):xs)         | mbb == minimalIncrease = unionDistinctSplit f leaf t ++ (fst <$> xs)@@ -304,14 +304,14 @@ lookup mbb t@Leaf{}     | mbb == getMBB t = Just $ getElem t     | otherwise = Nothing-lookup mbb t = case founds of +lookup mbb t = case founds of     [] -> Nothing     x:_ -> Just x     where     matches = filter (\x -> (getMBB x) `containsMBB` mbb) $ getChildren t-    founds = catMaybes $ map (lookup mbb) matches+    founds = catMaybes $ L.map (lookup mbb) matches --- | returns all keys and values, which are located in the given bounding box. +-- | returns all keys and values, which are located in the given bounding box. lookupRangeWithKey :: MBB -> RTree a -> [(MBB, a)] lookupRangeWithKey _ Empty = [] lookupRangeWithKey mbb t@Leaf{}@@ -323,7 +323,7 @@     founds = concatMap (lookupRangeWithKey mbb) matches     intersectRTree x = isJust $ mbb `intersectMBB` (getMBB x) --- | returns all values, which are located in the given bounding box. +-- | returns all values, which are located in the given bounding box. lookupRange :: MBB -> RTree a -> [a] lookupRange mbb t = snd <$> (lookupRangeWithKey mbb t) @@ -333,7 +333,7 @@ -- | Delete a key and its value from the RTree. When the key is not a member of the tree, the original tree is returned. delete :: MBB -> RTree a -> RTree a delete _   Empty = Empty-delete mbb  t@Leaf{} +delete mbb  t@Leaf{}     | mbb == getMBB t = Empty     | otherwise       = t delete mbb root@@ -344,13 +344,13 @@   delete' :: MBB -> RTree a -> RTree a-delete' mbb  t@Leaf{} +delete' mbb  t@Leaf{}     | mbb == getMBB t = Empty     | otherwise       = t delete' mbb t = fromList' $ orphans ++ [newValidNode]     where     (matches, noMatches) = partition (\x -> (getMBB x) `containsMBB` mbb) $ getChildren t-    matches' = filter (not . null) $ map (delete' mbb) matches+    matches' = filter (not . null) $ L.map (delete' mbb) matches     (orphans, validMatches) = foldr handleInvalid ([], []) matches' --  handleInvalid :: RTree a -> ([RTree a], [RTree a]) -> ([RTree a], [RTree a])     handleInvalid l@Leaf{} (orphans', validMatches') = (orphans', l:validMatches')@@ -376,7 +376,7 @@     | otherwise            = unionWith f t2 t1  -- | Unifies the first and the second tree into one.--- If an 'MBB' is a key in both trees, the value from the left tree is chosen. +-- If an 'MBB' is a key in both trees, the value from the left tree is chosen. -- -- prop> union = unionWith const union :: RTree a -> RTree a -> RTree a@@ -399,7 +399,7 @@     True -> True     False -> error ( "invalid " ++ show (L.length c) ++ " " ++ show context )     where-    isBalanced :: RTree a -> Bool +    isBalanced :: RTree a -> Bool     isBalanced (Leaf _ _ ) = True     isBalanced x' = (and $ isBalanced <$> c') && (and $ (== depth (head c')) <$> (depth <$> c'))         where@@ -437,7 +437,7 @@ depth t = 1 + (depth $ head $ getChildren t)  -- | returns the number of elements in a tree-length :: RTree a -> Int +length :: RTree a -> Int length Empty = 0 length (Leaf {}) = 1 length t = sum $ length <$> (getChildren t)@@ -476,3 +476,4 @@ instance (Monoid a) => Monoid (RTree a) where     mempty = empty     mappend = unionWith mappend+

@@ -10,8 +10,8 @@   Stability  : experimental   Portability: not portable -  This module provides a minimal bounding box. -  +  This module provides a minimal bounding box.+ -}  @@ -31,7 +31,7 @@  import Control.Applicative ((<$>), (<*>)) -import GHC.Generics (Generic)  +import GHC.Generics (Generic)  -- | Minimal bounding box data MBB = MBB {getUlx :: {-# UNPACK #-} ! Double, getUly :: {-# UNPACK #-} ! Double, getBrx :: {-# UNPACK #-} ! Double, getBry :: {-# UNPACK #-} ! Double}@@ -63,7 +63,7 @@ containsMBB :: MBB -> MBB -> Bool containsMBB (MBB x11 y11 x12 y12) (MBB x21 y21 x22 y22) =  x11 <= x21 && y11 <= y21 && x12 >= x22 && y12 >= y22 --- | returns the intersection of both mbbs. Returns Nothing, if they don't intersect. +-- | returns the intersection of both mbbs. Returns Nothing, if they don't intersect. intersectMBB :: MBB -> MBB -> Maybe MBB intersectMBB (MBB ulx uly brx bry) (MBB ulx' uly' brx' bry')     | ulx'' <= brx'' && uly'' <= bry'' = Just $ MBB ulx'' uly'' brx'' bry''@@ -73,7 +73,7 @@     uly'' = max uly uly'     brx'' = min brx brx'     bry'' = min bry bry'- +  instance Show MBB where     show (MBB ulx uly brx bry) = concat ["mbb ", show ulx, " ", show uly, " ", show brx, " ", show bry]

@@ -1,4 +1,8 @@ {-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ {- |     Module     : Data.RTree.Strict     Copyright  : Copyright (c) 2014, Birte Wagner, Sebastian Philipp@@ -8,7 +12,7 @@     Stability  : experimental     Portability: not portable -    This is the Strict version of 'Data.RTree'+    This is the Strict version of 'Data.RTree.RTree'      the following property should be true (by using 'GHC.AssertNF.isNF' ) : @@ -24,7 +28,9 @@     MBB     , MBB.mbb     -- * Data Type-    , RTree+    , RTree ()+    , toLazy+    , toStrict     -- * Constructors     , empty     , singleton@@ -49,113 +55,189 @@     , toList ) where -import           Prelude hiding (lookup, length, null)+import           Prelude hiding (lookup, length, null, map)++import           Data.Binary import           Data.Function (on) import qualified Data.List as L (length) import qualified Data.Maybe as Maybe (mapMaybe)+import           Data.Monoid (Monoid)+import           Data.Typeable (Typeable) -import           Control.Applicative ((<$>))-import           Data.RTree.Base hiding (singleton, fromList, insertWith, unionDistinctWith, unionWith, insert, mapMaybe, union, fromList', unionDistinct, unionDistinctSplit)+import           Control.DeepSeq (NFData)+import           Data.Functor+import           GHC.Generics (Generic)+--import           Data.RTree.Base hiding (RTree, singleton, fromList, insertWith, unionDistinctWith, unionWith, insert, mapMaybe, union, fromList', unionDistinct, unionDistinctSplit)+import qualified Data.RTree.Base as Lazy import           Data.RTree.MBB hiding (mbb)-import qualified  Data.RTree.MBB as MBB+import qualified Data.RTree.MBB as MBB ++newtype RTree a = RTree {toLazy' :: Lazy.RTree a}+    deriving (Show, Eq, Typeable, Generic, NFData, Binary, Monoid)++-- | converts a lazy RTree into a strict RTree +-- /O(n)/+toStrict :: Lazy.RTree a -> RTree a+toStrict t = map id (RTree t)++-- | converts a strict RTree into a lazy RTree+-- /O(1)/+toLazy :: RTree a -> Lazy.RTree a+toLazy = toLazy' -- --------------- -- smart constuctors +-- | creates an empty tree+empty :: RTree a+empty = RTree Lazy.Empty++-- | returns 'True', if empty+--+-- prop> null empty = True+null :: RTree a -> Bool+null = Lazy.null . toLazy+ -- | creates a single element tree singleton :: MBB -> a -> RTree a-singleton mbb !x = Leaf mbb x+singleton mbb !x = RTree $ Lazy.Leaf mbb x  -- ---------------------------------- -- Lists  -- | creates a tree out of pairs fromList :: [(MBB, a)] -> RTree a-fromList l = fromList' $ (uncurry singleton) <$> l+fromList l = RTree $ fromList' $ (toLazy . (uncurry singleton)) <$> l  -- | merges all singletons into a single tree.-fromList' :: [RTree a] -> RTree a-fromList' [] = empty+fromList' :: [Lazy.RTree a] -> Lazy.RTree a+fromList' [] = Lazy.empty fromList' ts = foldr1 unionDistinct ts++-- | creates a list of pairs out of a tree+--+-- prop> toList t = zip (keys t) (values t)+toList :: RTree a -> [(MBB, a)]+toList = Lazy.toList . toLazy++-- | returns all keys in this tree+--+-- prop> toList t = zip (keys t) (values t)+keys :: RTree a -> [MBB]+keys = Lazy.keys . toLazy+-- | returns all values in this tree+--+-- prop> toList t = zip (keys t) (values t)+values :: RTree a -> [a]+values = Lazy.values . toLazy++ -- ------------------------------------- insert +-- insert  -- | Inserts an element whith the given 'MBB' and a value in a tree. The combining function will be used if the value already exists. insertWith :: (a -> a -> a) -> MBB -> a -> RTree a -> RTree a-insertWith f mbb e oldRoot = unionDistinctWith f (singleton mbb e) oldRoot+insertWith f mbb e oldRoot = RTree $ insertWithStrictLazy f mbb e (toLazy oldRoot) +insertWithStrictLazy :: (a -> a -> a) -> MBB -> a -> Lazy.RTree a -> Lazy.RTree a+insertWithStrictLazy f mbb e oldRoot = unionDistinctWith f (toLazy $ singleton mbb e) oldRoot -- | Inserts an element whith the given 'MBB' and a value in a tree. An existing value will be overwritten with the given one. -- -- prop> insert = insertWith const insert :: MBB -> a -> RTree a -> RTree a insert = insertWith const -simpleMergeEqNode :: (a -> a -> a) -> RTree a -> RTree a -> RTree a-simpleMergeEqNode f l@Leaf{} r = Leaf (getMBB l) $! (on f getElem l r)+simpleMergeEqNode :: (a -> a -> a) -> Lazy.RTree a -> Lazy.RTree a -> Lazy.RTree a+simpleMergeEqNode f l@Lazy.Leaf{} r = Lazy.Leaf (Lazy.getMBB l) $! (on f Lazy.getElem l r) simpleMergeEqNode _ l _ = l  -- | Unifies left and right 'RTree'. Will create invalid trees, if the tree is not a leaf and contains 'MBB's which---  also exists in the left tree. Much faster than union, though. -unionDistinctWith :: (a -> a -> a) -> RTree a -> RTree a -> RTree a-unionDistinctWith _ Empty{} t           = t-unionDistinctWith _ t       Empty{}     = t-unionDistinctWith f t1@Leaf{} t2@Leaf{}-    | on (==) getMBB t1 t2              = simpleMergeEqNode f t1 t2-    | otherwise                         = createNodeWithChildren [t1, t2] -- root case+--  also exists in the left tree. Much faster than union, though.+unionDistinctWith :: (a -> a -> a) -> Lazy.RTree a -> Lazy.RTree a -> Lazy.RTree a+unionDistinctWith _ Lazy.Empty{}   t                = t+unionDistinctWith _ t              Lazy.Empty{}     = t+unionDistinctWith f t1@Lazy.Leaf{} t2@Lazy.Leaf{}+    | on (==) Lazy.getMBB t1 t2       = simpleMergeEqNode f t1 t2+    | otherwise                       = Lazy.createNodeWithChildren [t1, t2] -- root case unionDistinctWith f left right-    | depth left > depth right              = unionDistinctWith f right left-    | depth left == depth right             = fromList' $ (getChildren left) ++ [right]-    | (L.length $ getChildren newNode) > n  = createNodeWithChildren $ splitNode newNode-    | otherwise                             = newNode+    | Lazy.depth left > Lazy.depth right              = unionDistinctWith f right left+    | Lazy.depth left == Lazy.depth right             = fromList' $ (Lazy.getChildren left) ++ [right]+    | (L.length $ Lazy.getChildren newNode) > Lazy.n  = Lazy.createNodeWithChildren $ Lazy.splitNode newNode+    | otherwise                                       = newNode     where     newNode = addLeaf f left right --- | Únifies left and right 'RTree'. Will create invalid trees, if the tree is not a leaf and contains 'MBB'"'s which---  also exists in the left tree. Much faster than union, though. -unionDistinct :: RTree a -> RTree a -> RTree a+-- | Unifies left and right 'RTree'. Will create invalid trees, if the tree is not a leaf and contains 'MBB's which+--  also exists in the left tree. Much faster than union, though.+unionDistinct :: Lazy.RTree a -> Lazy.RTree a -> Lazy.RTree a unionDistinct = unionDistinctWith const -addLeaf :: (a -> a -> a) -> RTree a -> RTree a -> RTree a-addLeaf f left right -    | depth left + 1 == depth right = node (newNode `unionMBB'` right) (newNode : nonEq)-    | otherwise                     = node (left `unionMBB'` right) newChildren+addLeaf :: (a -> a -> a) -> Lazy.RTree a -> Lazy.RTree a -> Lazy.RTree a+addLeaf f left right+    | Lazy.depth left + 1 == Lazy.depth right = Lazy.node (newNode `Lazy.unionMBB'` right) (newNode : nonEq)+    | otherwise                               = Lazy.node (left `Lazy.unionMBB'` right) newChildren     where-    newChildren = findNodeWithMinimalAreaIncrease f left (getChildren right)-    (eq, nonEq) = partition (on (==) getMBB left) $ getChildren right+    newChildren = findNodeWithMinimalAreaIncrease f left (Lazy.getChildren right)+    (eq, nonEq) = Lazy.partition (on (==) Lazy.getMBB left) $ Lazy.getChildren right     newNode = case eq of         [] -> left         [x] -> simpleMergeEqNode f left x         _ -> error "addLeaf: invalid RTree" -findNodeWithMinimalAreaIncrease :: (a -> a -> a) -> RTree a -> [RTree a] -> [RTree a]+findNodeWithMinimalAreaIncrease :: (a -> a -> a) -> Lazy.RTree a -> [Lazy.RTree a] -> [Lazy.RTree a] findNodeWithMinimalAreaIncrease f leaf children = splitMinimal xsAndIncrease     where---  xsAndIncrease :: [(RTree a, Double)]    -    xsAndIncrease = zip children ((areaIncreasesWith leaf) <$> children)+--  xsAndIncrease :: [(RTree a, Double)]+    xsAndIncrease = zip children ((Lazy.areaIncreasesWith leaf) <$> children)     minimalIncrease = minimum $ snd <$> xsAndIncrease---  xsAndIncrease' :: [(RTree a, Double)]   +--  xsAndIncrease' :: [(RTree a, Double)]     splitMinimal [] = []     splitMinimal ((t,mbb):xs)         | mbb == minimalIncrease = unionDistinctSplit f leaf t ++ (fst <$> xs)-        | otherwise            = t : splitMinimal xs+        | otherwise              = t : splitMinimal xs -unionDistinctSplit :: (a -> a -> a) -> RTree a -> RTree a -> [RTree a]+unionDistinctSplit :: (a -> a -> a) -> Lazy.RTree a -> Lazy.RTree a -> [Lazy.RTree a] unionDistinctSplit f leaf e-    | (L.length $ getChildren newLeaf) > n = splitNode newLeaf-    | otherwise = [newLeaf]+    | (L.length $ Lazy.getChildren newLeaf) > Lazy.n = Lazy.splitNode newLeaf+    | otherwise                                      = [newLeaf]     where     newLeaf = addLeaf f leaf e +-- -----------------+-- lookup++-- | returns the value if it exists in the tree+lookup :: MBB -> RTree a -> Maybe a+lookup mbb = Lazy.lookup mbb . toLazy++-- | returns all keys and values, which are located in the given bounding box.+lookupRangeWithKey :: MBB -> RTree a -> [(MBB, a)]+lookupRangeWithKey mbb = Lazy.lookupRangeWithKey mbb . toLazy++-- | returns all values, which are located in the given bounding box.+lookupRange :: MBB -> RTree a -> [a]+lookupRange mbb = Lazy.lookupRange mbb . toLazy++-- -----------+-- delete++-- | Delete a key and its value from the RTree. When the key is not a member of the tree, the original tree is returned.+delete :: MBB -> RTree a -> RTree a+delete mbb = RTree . Lazy.delete mbb . toLazy+-- ---------------+ -- | Unifies the first and the second tree into one. The combining function is used for elemets which exists in both trees. unionWith :: (a -> a -> a) -> RTree a -> RTree a -> RTree a-unionWith _ l     Empty    = l-unionWith _ Empty r        = r-unionWith f t1 t2-    | depth t1 <= depth t2 = foldr (uncurry (insertWith f)) t2 (toList t1)-    | otherwise            = unionWith f t2 t1+unionWith f' l' r' = RTree $ unionWith' f' (toLazy l') (toLazy r')+    where+    unionWith' _ l          Lazy.Empty   = l+    unionWith' _ Lazy.Empty r            = r+    unionWith' f t1 t2+        | Lazy.depth t1 <= Lazy.depth t2 = foldr (uncurry (insertWithStrictLazy f)) t2 (Lazy.toList t1)+        | otherwise            = unionWith' f t2 t1  -- | Unifies the first and the second tree into one.--- If an 'MBB' is a key in both trees, the value from the left tree is chosen. +-- If an 'MBB' is a key in both trees, the value from the left tree is chosen. -- -- prop> union = unionWith const union :: RTree a -> RTree a -> RTree a@@ -166,5 +248,32 @@ mapMaybe f t = fromList $ Maybe.mapMaybe func $ toList t     where     func (mbb,x) = case f x of-            Nothing -> Nothing-            Just x' -> Just (mbb, x')+        Nothing -> Nothing+        Just x' -> Just (mbb, x')++++++-- | maps strictly over the 'RTree'+map :: (a -> b) -> RTree a -> RTree b+map f' = RTree . map' f' . toLazy+    where+    map' f (Lazy.Node4 mbb x y z w) = Lazy.Node4 mbb (map' f x) (map' f y) (map' f z) (map' f w)+    map' f (Lazy.Node3 mbb x y z)   = Lazy.Node3 mbb (map' f x) (map' f y) (map' f z)+    map' f (Lazy.Node2 mbb x y)     = Lazy.Node2 mbb (map' f x) (map' f y)+    map' f (Lazy.Node mbb xs)       = Lazy.Node mbb (map' f <$> xs)+    map' f (Lazy.Leaf mbb e)        = toLazy $ singleton mbb (f e)+    map' _ Lazy.Empty = Lazy.Empty+-- ----------------------++-- | returns the number of elements in a tree+length :: RTree a -> Int+length = Lazy.length . toLazy++-- | 'RTree' is not really a Functor.+-- Because thsi law dowsn't hold:+--+-- prop> fmap id = id+instance Functor RTree where+    fmap = map

@@ -4,3 +4,8 @@  * Added Data.Binary interface for GHC 7.6 +## 0.0.5.0++* changed the Functor instance of Data.RTree.Strict to be strict++* Data.RTree.Strict.RTree is now a newtype of Data.RTree.RTree

@@ -1,5 +1,5 @@ name:                data-r-tree-version:             0.0.4.0+version:             0.0.5.0 synopsis:            R-Tree is a spatial data structure similar to Quadtrees or B-Trees. description:         R-Tree is a spatial data structure similar to Quadtrees or B-Trees.   

@@ -6,29 +6,25 @@ where  -- import qualified Data.RTree                       as Lazy    -- just for dev.-import           Prelude                              hiding (lookup, map, mapM,+import            Prelude                              hiding (lookup, map, mapM,                                                        null, succ)  --import           Control.Arrow                        (second)-import           Control.Applicative ((<$>), (<*>))-import           Control.DeepSeq                      (($!!))+import            Control.Applicative ((<$>))+import            Control.DeepSeq                      (($!!)) -import           Data.Monoid-import           Data.RTree.Strict-import           Data.RTree.MBB+import            Data.Monoid+import            Data.RTree.Strict+import qualified  Data.RTree as L+import            Data.RTree.MBB -import           GHC.AssertNF+import            GHC.AssertNF  -- import           System.IO -import           Test.Framework-import           Test.Framework.Providers.HUnit-import           Test.Framework.Providers.QuickCheck2-import           Test.HUnit                           hiding (Test, Testable)-import qualified Test.QuickCheck                      as Q (Property, arbitrary)-import qualified Test.QuickCheck.Monadic              as Q (PropertyM, assert,-                                                            monadicIO, pick,-                                                            run)+import            Test.Framework+import            Test.Framework.Providers.HUnit+import            Test.HUnit                           hiding (Test, Testable)  newtype Attr = A [Int]     deriving (Show)@@ -80,6 +76,10 @@        , testCase "tu_2" (checkIsNF test_union)        , testCase "test_insertWith1" (checkIsNF test_insertWith1)        , testCase "test_insertWith" (checkIsNF test_insertWith)+       , testCase "test_map" (checkIsNF test_map)+       , testCase "test_toStrict" (checkIsNF test_toStrict)++        --, testCase "m1" (checkIsNF m1)        --, testCase "m2" (checkIsNF m2)        --, testCase "m3" (checkIsNF m3)@@ -135,11 +135,17 @@ test_union :: RTree Attr test_union = unionWith mappend tu_1 t_6 +test_map :: RTree Attr+test_map = fmap id tu_1+ test_insertWith1 :: RTree Attr test_insertWith1 = insertWith mappend t_mbb1 (mkA' 4) t_1  test_insertWith :: RTree Attr test_insertWith = insertWith mappend t_mbb6 (mkA' 6) tu_2++test_toStrict :: RTree Attr+test_toStrict = toStrict $ L.fromList u_2