module Main ( main ) where import Data.RTree.Base import Data.RTree.MBB hiding (mbb) -- import qualified Data.Set as S import Prelude hiding (lookup, map, null, length) import Data.Binary (encode, decode) import Data.Function (on) import Data.List ((\\)) import qualified Data.List as L (map, length) import Control.Applicative ((<$>)) import Test.Framework import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Test.HUnit hiding (Test, Testable) import Text.Show.Functions () --import Graphics.Gnuplot.Simple -- todo: write tests main :: IO () main = do defaultMain [ testCase "test_null" test_null , testCase "test_singleton" test_singleton , testCase "test_insert" test_insert , testCase "test_lookup" test_lookup , testCase "test_lookupRange" test_lookupRange , testCase "test_lookupRangeWithKey" test_lookupRangeWithKey , testCase "test_union" test_union , testCase "test_unionWith" test_unionWith , testCase "test_length" test_length , testCase "test_keys" test_keys , testCase "test_values" test_values , testCase "test_delete" test_delete , testCase "test_fromList" test_fromList , testCase "test_binary" test_binary -- , testProperty "map a StringMap" prop_map ] -- ------------------------ t_mbb1, t_mbb2 , t_mbb3, t_mbb4, t_mbb5, t_mbb6 :: MBB t_mbb1 = (MBB 0.0 0.0 1.0 1.0) t_mbb2 = (MBB 5.0 0.0 6.0 1.0) t_mbb3 = (MBB 1.0 2.0 2.0 3.0) t_mbb4 = (MBB 6.0 2.0 7.0 3.0) t_mbb5 = (MBB 3.0 3.0 4.0 4.0) t_mbb6 = (MBB 0.0 0.0 0.0 0.0) t_1, t_2, t_3, t_4, t_5, t_6 :: RTree String t_1 = singleton t_mbb1 "a" t_2 = singleton t_mbb2 "b" t_3 = singleton t_mbb3 "c" t_4 = singleton t_mbb4 "d" t_5 = singleton t_mbb5 "e" t_6 = singleton t_mbb6 "f" u_1, u_2 :: [(MBB, String)] u_1 = [(t_mbb1, "a"), (t_mbb2, "b"),(t_mbb3, "c"),(t_mbb4, "d")] u_2 = [(t_mbb5, "e"), (t_mbb6, "f")] ++ u_1 tu_1, tu_2 :: RTree String tu_1 = fromList u_1 tu_2 = fromList u_2 -- ------------------------ eqRt :: (Show a, Eq a) => RTree a -> RTree a -> Assertion eqRt = eqList `on` toList eqList :: (Show a, Eq a) => [a] -> [a] -> Assertion eqList l1 l2 = [] @=? (l1 \\ l2) -- ------------------------ test_null :: Assertion test_null = do null empty @?= True null t_1 @?= False test_singleton :: Assertion test_singleton = do t_1 `eqRt` t_1 length t_1 @?= 1 keys t_1 @?= [t_mbb1] values t_1 @?= ["a"] test_insert :: Assertion test_insert = do insert t_mbb2 "b" t_1 `eqRt` fromList [(t_mbb1, "a"), (t_mbb2, "b")] insert t_mbb1 "a" t_2 `eqRt` fromList [(t_mbb1, "a"), (t_mbb2, "b")] insert t_mbb1 "a+" t_1 `eqRt` fromList [(t_mbb1, "a+")] insert t_mbb1 "a" empty `eqRt` t_1 insert t_mbb5 "e" (fromList u_1) `eqRt` fromList (u_1 ++ [(t_mbb5, "e")]) insert t_mbb6 "f" (fromList u_1) `eqRt` fromList (u_1 ++ [(t_mbb6, "f")]) test_lookup :: Assertion test_lookup = do lookup t_mbb3 t_3 @?= Just "c" lookup t_mbb1 tu_1 @?= Just "a" lookup t_mbb2 tu_2 @?= Just "b" lookup t_mbb3 tu_2 @?= Just "c" lookup t_mbb4 tu_2 @?= Just "d" lookup t_mbb5 tu_2 @?= Just "e" lookup t_mbb6 tu_2 @?= Just "f" lookup t_mbb1 empty @?= (Nothing :: Maybe ()) lookup t_mbb6 (fromList u_1) @?= Nothing test_lookupRange :: Assertion test_lookupRange = do lookupRange t_mbb3 t_3 @?= ["c"] lookupRange t_mbb1 tu_1 @?= ["a"] lookupRange t_mbb2 tu_2 @?= ["b"] lookupRange t_mbb3 tu_2 @?= ["c"] lookupRange t_mbb4 tu_2 @?= ["d"] lookupRange t_mbb5 tu_2 @?= ["e"] lookupRange t_mbb6 tu_2 @?= ["f"] lookupRange (MBB 1.0 1.0 7.0 3.0) tu_2 @?= ["c", "d"] lookupRange (MBB 0.0 0.0 1.0 1.0) tu_2 @?= ["f", "a"] lookupRange (MBB 0.0 0.0 7.0 4.0) tu_2 @?= ["e","c","f","a","b","d"] -- todo order irrelevant test_lookupRangeWithKey :: Assertion test_lookupRangeWithKey = do lookupRangeWithKey t_mbb3 t_3 @?= [(t_mbb3, "c")] lookupRangeWithKey t_mbb1 tu_1 @?= [(t_mbb1, "a")] lookupRangeWithKey t_mbb2 tu_2 @?= [(t_mbb2, "b")] lookupRangeWithKey t_mbb3 tu_2 @?= [(t_mbb3, "c")] lookupRangeWithKey t_mbb4 tu_2 @?= [(t_mbb4, "d")] lookupRangeWithKey (MBB 1.0 1.0 7.0 3.0) tu_2 @?= [(t_mbb3, "c"), (t_mbb4, "d")] lookupRangeWithKey (MBB 0.0 0.0 1.0 1.0) tu_2 @?= [(t_mbb6, "f"), (t_mbb1, "a")] lookupRangeWithKey (MBB 0.0 0.0 7.0 4.0) tu_2 `eqList` u_2 -- todo order irrelevant test_union :: Assertion test_union = do union empty empty `eqRt` (empty :: RTree ()) union tu_2 tu_1 `eqRt` tu_2 union t_1 empty `eqRt` t_1 union empty t_1 `eqRt` t_1 test_unionWith :: Assertion test_unionWith = do unionWith undefined empty empty `eqRt` (empty :: RTree ()) unionWith (++) tu_2 tu_1 `eqRt` (fromList [(t_mbb1,"aa"),(t_mbb2,"bb"),(t_mbb3,"cc"),(t_mbb4,"dd"),(t_mbb5,"e"),(t_mbb6,"f")]) -- tu_2 test_length :: Assertion test_length = do length empty @?= 0 length t_1 @?= 1 length tu_2 @?= L.length u_2 test_keys :: Assertion test_keys = do keys empty @?= [] keys t_1 @?= [t_mbb1] keys tu_2 `eqList` (fst <$> u_2) test_values :: Assertion test_values = do values empty @?= ([] :: [()]) values t_1 @?= ["a"] values tu_2 `eqList` (snd <$> u_2) test_delete :: Assertion test_delete = do let d1 = delete (MBB 3.0 3.0 4.0 4.0) tu_2 values d1 @?= ["c","f","a","b","d"] let d2 = delete (MBB 1.0 2.0 2.0 3.0) d1 values d2 @?= ["f","a","b","d"] let d3 = delete (MBB 0.0 0.0 0.0 0.0) d2 values d3 @?= ["a","b","d"] let d4 = delete (MBB 5.0 0.0 6.0 1.0) d3 values d4 @?= ["a","d"] let d5 = delete (MBB 0.0 0.0 1.0 1.0) d4 values d5 @?= ["d"] let d6 = delete (MBB 6.0 2.0 7.0 3.0) d5 values d6 @?= [] test_fromList :: Assertion test_fromList = do fromList [] `eqRt` (empty :: RTree ()) test_binary :: Assertion test_binary = do (decode $ encode $ tu_2) @?= tu_2 {- test_toList :: Assertion test_delete :: Assertion -} -- ------------------------- {- t_p = node (mbb 6469.0 9103.0 6656.0 9721.0) [ Leaf {getmbb = (mbb 6469.0 9103.0 6469.0 9721.0), getElem = ()}, Leaf {getmbb = (mbb 6786.0 9678.0 6656.0 9651.0), getElem = ()}, Leaf {getmbb = (mbb 6593.0 9103.0 6593.0 9721.0), getElem = ()}] t_pp = Leaf {getmbb = (mbb 6531.0 9103.0 6531.0 9721.0), getElem = ()} t_ppp = union t_pp t_p -} {- mbbToPath :: MBB -> [(Double, Double)] mbbToPath (MBB ulx uly brx bry) = [(ulx, uly),(brx, uly),(brx, bry),(ulx, bry),(ulx, uly)] rtreeToPaths :: RTree a -> [[(Double, Double)]] rtreeToPaths = foldWithMBB handleLeaf handleNode [] where handleLeaf mbb _ = [mbbToPath mbb] handleNode mbb xs = [mbbToPath mbb] ++ (concat xs) plotRtree :: RTree a -> IO () plotRtree tree = do print [p20 ulx brx, p20 uly bry] print [ulx, brx, uly, bry] plotPaths [Key Nothing, XRange $ p20 ulx brx, YRange $ p20 uly bry] $ rtreeToPaths tree where (MBB ulx uly brx bry) = getMBB tree p20 l r = (l - ((r-l) / 5), r + ((r-l) / 5)) testData :: FilePath -> IO (RTree ()) testData p = do d <- lines <$> readFile p let pairs = zip (listToMBB <$> (L.map read d)) (replicate 100000000 ()) return $ fromList pairs where listToMBB :: [Double] -> MBB listToMBB [ulx, uly, brx, bry] = MBB ulx uly brx bry listToMBB xs = error $ "invalid data " ++ show xs -}