Add benchmark of lookupGE to choose best implementation.
authorMilan Straka <fox@ucw.cz>
Mon, 23 Apr 2012 08:57:45 +0000 (10:57 +0200)
committerMilan Straka <fox@ucw.cz>
Mon, 23 Apr 2012 08:57:45 +0000 (10:57 +0200)
Most of the code is by Twan van Laarhoven, thanks.

benchmarks/LookupGE/IntMap.hs [new file with mode: 0644]
benchmarks/LookupGE/LookupGE_IntMap.hs [new file with mode: 0644]
benchmarks/LookupGE/LookupGE_Map.hs [new file with mode: 0644]
benchmarks/LookupGE/Makefile [new file with mode: 0644]
benchmarks/LookupGE/Map.hs [new file with mode: 0644]

diff --git a/benchmarks/LookupGE/IntMap.hs b/benchmarks/LookupGE/IntMap.hs
new file mode 100644 (file)
index 0000000..c1ed847
--- /dev/null
@@ -0,0 +1,51 @@
+{-# LANGUAGE BangPatterns #-}
+module Main where
+
+import Control.DeepSeq
+import Control.Exception (evaluate)
+import Control.Monad.Trans (liftIO)
+import Criterion.Config
+import Criterion.Main
+import Data.List (foldl')
+import qualified Data.IntMap as M
+import qualified LookupGE_IntMap as M
+import Data.Maybe (fromMaybe)
+import Prelude hiding (lookup)
+
+main :: IO ()
+main = do
+    defaultMainWith
+        defaultConfig
+        (liftIO . evaluate $ rnf [m_even, m_odd, m_large])
+        [b f | b <- benches, f <- funs1]
+  where
+    m_even = M.fromAscList elems_even :: M.IntMap Int
+    m_odd  = M.fromAscList elems_odd :: M.IntMap Int
+    m_large = M.fromAscList elems_large :: M.IntMap Int
+    bound = 2^12
+    elems_even  = zip evens evens
+    elems_odd   = zip odds odds
+    elems_large = zip large large
+    evens = [2,4..bound]
+    odds  = [1,3..bound]
+    large = [1,100..50*bound]
+    benches =
+          [ \(n,fun) -> bench (n++" present")  $ nf (fge fun evens) m_even
+          , \(n,fun) -> bench (n++" absent")   $ nf (fge fun evens) m_odd
+          , \(n,fun) -> bench (n++" far")      $ nf (fge fun odds)  m_large
+          , \(n,fun) -> bench (n++" !present") $ nf (fge2 fun evens) m_even
+          , \(n,fun) -> bench (n++" !absent")  $ nf (fge2 fun evens) m_odd
+          , \(n,fun) -> bench (n++" !far")     $ nf (fge2 fun odds)  m_large
+          ]
+    funs1 = [ ("GE split", M.lookupGE1)
+            , ("GE Craig", M.lookupGE2)
+            , ("GE Twan", M.lookupGE3)
+            , ("GE Milan", M.lookupGE4) ]
+
+fge :: (Int -> M.IntMap Int -> Maybe (Int,Int)) -> [Int] -> M.IntMap Int -> (Int,Int)
+fge fun xs m = foldl' (\n k -> fromMaybe n (fun k m)) (0,0) xs
+
+-- forcing values inside tuples!
+fge2 :: (Int -> M.IntMap Int -> Maybe (Int,Int)) -> [Int] -> M.IntMap Int -> (Int,Int)
+fge2 fun xs m = foldl' (\n@(!_, !_) k -> fromMaybe n (fun k m)) (0,0) xs
+
diff --git a/benchmarks/LookupGE/LookupGE_IntMap.hs b/benchmarks/LookupGE/LookupGE_IntMap.hs
new file mode 100644 (file)
index 0000000..76fb705
--- /dev/null
@@ -0,0 +1,106 @@
+{-# LANGUAGE CPP #-}
+module LookupGE_IntMap where
+
+import Prelude hiding (null)
+import Data.IntMap.Base
+#ifdef TESTING
+import Test.QuickCheck
+#endif
+
+lookupGE1 :: Key -> IntMap a -> Maybe (Key,a)
+lookupGE1 k m =
+    case splitLookup k m of
+        (_,Just v,_)  -> Just (k,v)
+        (_,Nothing,r) -> findMinMaybe r
+
+lookupGE2 :: Key -> IntMap a -> Maybe (Key,a)
+lookupGE2 k t = case t of
+    Bin _ m l r | m < 0 -> if k >= 0
+      then go l
+      else case go r of
+        Nothing -> Just $ findMin l
+        justx -> justx
+    _ -> go t
+  where
+    go (Bin p m l r)
+      | nomatch k p m = if k < p
+        then Just $ findMin l
+        else Nothing
+      | zero k m = case go l of
+        Nothing -> Just $ findMin r
+        justx -> justx
+      | otherwise = go r
+    go (Tip ky y)
+      | k > ky = Nothing
+      | otherwise = Just (ky, y)
+    go Nil = Nothing
+
+lookupGE3 :: Key -> IntMap a -> Maybe (Key,a)
+lookupGE3 k t = k `seq` case t of
+    Bin _ m l r | m < 0 -> if k >= 0
+      then go Nothing l
+      else go (Just (findMin l)) r
+    _ -> go Nothing t
+  where
+    go def (Bin p m l r)
+      | nomatch k p m = if k < p then Just $ findMin l else def
+      | zero k m  = go (Just $ findMin r) l
+      | otherwise = go def r
+    go def (Tip ky y)
+      | k > ky    = def
+      | otherwise = Just (ky, y)
+    go def Nil  = def
+
+lookupGE4 :: Key -> IntMap a -> Maybe (Key,a)
+lookupGE4 k t = k `seq` case t of
+    Bin _ m l r | m < 0 -> if k >= 0 then goNothing l
+                                     else goJust l r
+    _ -> goNothing t
+  where
+    goNothing (Bin p m l r)
+      | nomatch k p m = if k < p then fMin l else Nothing
+      | zero k m  = goJust r l
+      | otherwise = goNothing r
+    goNothing (Tip ky y)
+      | k > ky    = Nothing
+      | otherwise = Just (ky, y)
+    goNothing Nil  = Nothing
+
+    goJust def (Bin p m l r)
+      | nomatch k p m = if k < p then fMin l else fMin def
+      | zero k m  = goJust r l
+      | otherwise = goJust def r
+    goJust def (Tip ky y)
+      | k > ky    = fMin def
+      | otherwise = Just (ky, y)
+    goJust def Nil  = fMin def
+
+    fMin :: IntMap a -> Maybe (Key, a)
+    fMin Nil = Nothing
+    fMin (Tip ky y) = Just (ky, y)
+    fMin (Bin _ _ l _) = fMin l
+
+-------------------------------------------------------------------------------
+-- Utilities
+-------------------------------------------------------------------------------
+
+-- | /O(log n)/. The minimal key of the map.
+findMinMaybe :: IntMap a -> Maybe (Key, a)
+findMinMaybe m
+  | null m = Nothing
+  | otherwise = Just (findMin m)
+
+#ifdef TESTING
+-------------------------------------------------------------------------------
+-- Properties:
+-------------------------------------------------------------------------------
+
+prop_lookupGE12 :: Int -> [Int] -> Bool
+prop_lookupGE12 x xs = case fromList $ zip xs xs of m -> lookupGE1 x m == lookupGE2 x m
+
+prop_lookupGE13 :: Int -> [Int] -> Bool
+prop_lookupGE13 x xs = case fromList $ zip xs xs of m -> lookupGE1 x m == lookupGE3 x m
+
+prop_lookupGE14 :: Int -> [Int] -> Bool
+prop_lookupGE14 x xs = case fromList $ zip xs xs of m -> lookupGE1 x m == lookupGE4 x m
+#endif
diff --git a/benchmarks/LookupGE/LookupGE_Map.hs b/benchmarks/LookupGE/LookupGE_Map.hs
new file mode 100644 (file)
index 0000000..829a05f
--- /dev/null
@@ -0,0 +1,78 @@
+{-# LANGUAGE BangPatterns, CPP #-}
+module LookupGE_Map where
+
+import Data.Map.Base
+#ifdef TESTING
+import Test.QuickCheck
+#endif
+
+lookupGE1 :: Ord k => k -> Map k a -> Maybe (k,a)
+lookupGE1 k m =
+    case splitLookup k m of
+        (_,Just v,_)  -> Just (k,v)
+        (_,Nothing,r) -> findMinMaybe r
+{-# INLINABLE lookupGE1 #-}
+
+lookupGE2 :: Ord k => k -> Map k a -> Maybe (k,a)
+lookupGE2 = go
+  where
+    go !_ Tip = Nothing
+    go !k (Bin _ kx x l r) =
+        case compare k kx of
+            LT -> case go k l of
+                    Nothing -> Just (kx,x)
+                    ret -> ret
+            GT -> go k r
+            EQ -> Just (kx,x)
+{-# INLINABLE lookupGE2 #-}
+
+lookupGE3 :: Ord k => k -> Map k a -> Maybe (k,a)
+lookupGE3 = go Nothing
+  where
+    go def !_ Tip = def
+    go def !k (Bin _ kx x l r) =
+        case compare k kx of
+            LT -> go (Just (kx,x)) k l
+            GT -> go def k r
+            EQ -> Just (kx,x)
+{-# INLINABLE lookupGE3 #-}
+
+lookupGE4 :: Ord k => k -> Map k a -> Maybe (k,a)
+lookupGE4 k = k `seq` goNothing
+  where
+    goNothing Tip = Nothing
+    goNothing (Bin _ kx x l r) = case compare k kx of
+                                   LT -> goJust kx x l
+                                   EQ -> Just (kx, x)
+                                   GT -> goNothing r
+
+    goJust ky y Tip = Just (ky, y)
+    goJust ky y (Bin _ kx x l r) = case compare k kx of
+                                     LT -> goJust kx x l
+                                     EQ -> Just (kx, x)
+                                     GT -> goJust ky y r
+{-# INLINABLE lookupGE4 #-}
+
+-------------------------------------------------------------------------------
+-- Utilities
+-------------------------------------------------------------------------------
+
+findMinMaybe :: Map k a -> Maybe (k,a)
+findMinMaybe (Bin _ kx x Tip _)  = Just (kx,x)
+findMinMaybe (Bin _ _  _ l _)    = findMinMaybe l
+findMinMaybe Tip                 = Nothing
+
+#ifdef TESTING
+-------------------------------------------------------------------------------
+-- Properties:
+-------------------------------------------------------------------------------
+
+prop_lookupGE12 :: Int -> [Int] -> Bool
+prop_lookupGE12 x xs = case fromList $ zip xs xs of m -> lookupGE1 x m == lookupGE2 x m
+
+prop_lookupGE13 :: Int -> [Int] -> Bool
+prop_lookupGE13 x xs = case fromList $ zip xs xs of m -> lookupGE1 x m == lookupGE3 x m
+
+prop_lookupGE14 :: Int -> [Int] -> Bool
+prop_lookupGE14 x xs = case fromList $ zip xs xs of m -> lookupGE1 x m == lookupGE4 x m
+#endif
diff --git a/benchmarks/LookupGE/Makefile b/benchmarks/LookupGE/Makefile
new file mode 100644 (file)
index 0000000..019967b
--- /dev/null
@@ -0,0 +1,3 @@
+TOP = ..
+
+include ../Makefile
diff --git a/benchmarks/LookupGE/Map.hs b/benchmarks/LookupGE/Map.hs
new file mode 100644 (file)
index 0000000..4677f06
--- /dev/null
@@ -0,0 +1,50 @@
+{-# LANGUAGE BangPatterns #-}
+module Main where
+
+import Control.DeepSeq
+import Control.Exception (evaluate)
+import Control.Monad.Trans (liftIO)
+import Criterion.Config
+import Criterion.Main
+import Data.List (foldl')
+import qualified Data.Map as M
+import qualified LookupGE_Map as M
+import Data.Maybe (fromMaybe)
+import Prelude hiding (lookup)
+
+main :: IO ()
+main = do
+    defaultMainWith
+        defaultConfig
+        (liftIO . evaluate $ rnf [m_even, m_odd, m_large])
+        [b f | b <- benches, f <- funs1]
+  where
+    m_even = M.fromAscList elems_even :: M.Map Int Int
+    m_odd  = M.fromAscList elems_odd :: M.Map Int Int
+    m_large = M.fromAscList elems_large :: M.Map Int Int
+    bound = 2^10
+    elems_even  = zip evens evens
+    elems_odd   = zip odds odds
+    elems_large = zip large large
+    evens = [2,4..bound]
+    odds  = [1,3..bound]
+    large = [1,100..50*bound]
+    benches =
+          [ \(n,fun) -> bench (n++" present")  $ nf (fge fun evens) m_even
+          , \(n,fun) -> bench (n++" absent")   $ nf (fge fun evens) m_odd
+          , \(n,fun) -> bench (n++" far")      $ nf (fge fun odds)  m_large
+          , \(n,fun) -> bench (n++" !present") $ nf (fge2 fun evens) m_even
+          , \(n,fun) -> bench (n++" !absent")  $ nf (fge2 fun evens) m_odd
+          , \(n,fun) -> bench (n++" !far")     $ nf (fge2 fun odds)  m_large
+          ]
+    funs1 = [ ("GE split", M.lookupGE1)
+            , ("GE caseof", M.lookupGE2)
+            , ("GE Twan", M.lookupGE3)
+            , ("GE Milan", M.lookupGE4) ]
+
+fge :: (Int -> M.Map Int Int -> Maybe (Int,Int)) -> [Int] -> M.Map Int Int -> (Int,Int)
+fge fun xs m = foldl' (\n k -> fromMaybe n (fun k m)) (0,0) xs
+
+-- forcing values inside tuples!
+fge2 :: (Int -> M.Map Int Int -> Maybe (Int,Int)) -> [Int] -> M.Map Int Int -> (Int,Int)
+fge2 fun xs m = foldl' (\n@(!_, !_) k -> fromMaybe n (fun k m)) (0,0) xs