ui.hs (5012B)
1 {-# OPTIONS_GHC -Wall #-} 2 {-# LANGUAGE TemplateHaskell #-} 3 4 import Data.List 5 import Data.Hashable (Hashable) 6 import Data.HashMap.Strict hiding (filter) 7 import Control.Monad 8 import Test.QuickCheck 9 import Test.QuickCheck.All 10 import Criterion.Main 11 import Criterion.Config 12 import System.Random.MWC 13 14 -- O(n^2) ---------------------------------------------------------------------- 15 16 -- nub, loop + elem are O(n^2) 17 i0 :: Eq a => [a] -> [a] -> [a] 18 i0 _ [] = [] 19 i0 [] _ = [] 20 i0 (x:xs) ys = nub $ if x `elem` ys then x : i0 xs ys else i0 xs ys 21 22 -- nub is O(n^2), otherwise linear 23 u0 :: Eq a => [a] -> [a] -> [a] 24 u0 xs ys = nub $ xs ++ go xs ys 25 where go as [] = as 26 go [] bs = bs 27 go as (b:bs) = if b `notElem` as then b : go as bs else go as bs 28 29 -- O(n log n) ------------------------------------------------------------------ 30 31 -- sort (mergesort) is O(n log n), otherwise linear 32 i1 :: Ord a => [a] -> [a] -> [a] 33 i1 xs ys = go (sort xs) (sort ys) [] 34 where go [] _ cs = cs 35 go _ [] cs = cs 36 go al@(a:as) bl@(b:bs) cs = case compare a b of 37 LT -> go as bl cs 38 GT -> go al bs cs 39 EQ -> go as bs (b:cs) 40 41 -- sort (mergesort) is O(n log n), otherwise linear 42 u1 :: Ord a => [a] -> [a] -> [a] 43 u1 xs ys = go (sort xs) (sort ys) [] 44 where go [] bs cs = bs ++ cs 45 go as [] cs = as ++ cs 46 go al@(a:as) bl@(b:bs) cs = case compare a b of 47 LT -> go as bl (a:cs) 48 GT -> go al bs (b:cs) 49 EQ -> go as bs (a:cs) 50 51 -- O(n) ------------------------------------------------------------------------ 52 53 -- filter, fromList, zip are O(n), otherwise constant 54 i2 :: (Enum a, Eq a, Hashable a) => [a] -> [a] -> [a] 55 i2 xs = filter (\y -> member y . fromList $ zip xs ([1..] :: [Int])) 56 57 -- filter, fromList, zip are O(n), otherwise constant 58 u2 :: (Eq k, Hashable k) => [k] -> [k] -> [k] 59 u2 xs ys = xs ++ 60 filter (\y -> not . member y . fromList $ zip xs ([1..] :: [Int])) ys 61 62 -- Tests ----------------------------------------------------------------------- 63 64 prop_i0ResultElementsAreInBoth :: Eq a => [a] -> [a] -> Bool 65 prop_i0ResultElementsAreInBoth xs ys = all (`elem` xs) zs && all (`elem` ys) zs 66 where zs = i0 xs ys 67 68 prop_i1ResultElementsAreInBoth :: Ord a => [a] -> [a] -> Bool 69 prop_i1ResultElementsAreInBoth xs ys = all (`elem` xs) zs && all (`elem` ys) zs 70 where zs = i1 xs ys 71 72 prop_i2ResultElementsAreInBoth :: (Enum a, Eq a, Num a, Hashable a) 73 => [a] -> [a] -> Bool 74 prop_i2ResultElementsAreInBoth xs ys = all (`elem` xs) zs && all (`elem` ys) zs 75 where zs = i2 xs ys 76 77 prop_u0ResultElementsInAtLeastOne :: Eq a => [a] -> [a] -> Bool 78 prop_u0ResultElementsInAtLeastOne xs ys = all (`elem` (xs ++ ys)) zs 79 where zs = u0 xs ys 80 81 prop_u1ResultElementsInAtLeastOne :: Ord a => [a] -> [a] -> Bool 82 prop_u1ResultElementsInAtLeastOne xs ys = all (`elem` (xs ++ ys)) zs 83 where zs = u1 xs ys 84 85 prop_u2ResultElementsInAtLeastOne :: (Eq a, Hashable a) => [a] -> [a] -> Bool 86 prop_u2ResultElementsInAtLeastOne xs ys = all (`elem` (xs ++ ys)) zs 87 where zs = u2 xs ys 88 89 runTestSuite :: IO Bool 90 runTestSuite = $forAllProperties 91 (quickCheckWithResult (stdArgs {maxSuccess = 1000})) 92 93 -- Benchmarks ------------------------------------------------------------------ 94 95 myConfig :: Config 96 myConfig = defaultConfig { cfgPerformGC = ljust True } 97 98 main :: IO () 99 main = do 100 prng <- create 101 [l0s, l1s] <- replicateM 2 $ replicateM 75 (uniformR (1 :: Int, 100) prng) 102 [l0m, l1m] <- replicateM 2 $ replicateM 125 (uniformR (1 :: Int, 100) prng) 103 [l0l, l1l] <- replicateM 2 $ replicateM 250 (uniformR (1 :: Int, 100) prng) 104 105 void runTestSuite 106 107 defaultMain [ 108 bgroup "intersection - i0 " [ bench "i0s" $ nf (i0 l0s) l1s 109 , bench "i0m" $ nf (i0 l0m) l1m 110 , bench "i0l" $ nf (i0 l0l) l1l ] 111 112 , bgroup "intersection - i1 " [ bench "i1s" $ nf (i1 l0s) l1s 113 , bench "i1m" $ nf (i1 l0m) l1m 114 , bench "i1l" $ nf (i1 l0l) l1l ] 115 116 , bgroup "intersection - i2 " [ bench "i2s" $ nf (i2 l0s) l1s 117 , bench "i2m" $ nf (i2 l0m) l1m 118 , bench "i2l" $ nf (i2 l0l) l1l ] 119 120 , bgroup "union - u0 " [ bench "u0s" $ nf (u0 l0s) l1s 121 , bench "u0m" $ nf (u0 l0m) l1m 122 , bench "u0l" $ nf (u0 l0l) l1l ] 123 124 , bgroup "union - u1 " [ bench "u1s" $ nf (u1 l0s) l1s 125 , bench "u1m" $ nf (u1 l0m) l1m 126 , bench "u1l" $ nf (u1 l0l) l1l ] 127 128 , bgroup "union - u2 " [ bench "u2s" $ nf (u2 l0s) l1s 129 , bench "u2m" $ nf (u2 l0m) l1m 130 , bench "u2l" $ nf (u2 l0l) l1l ] 131 ] 132