Binary Search - List, Array, UArray, Vector, UVector

bs_1_list.hs

{-# OPTIONS_GHC -Wall #-}
module Main (main) where

import Data.List (unfoldr)

bs :: [Int] -> Int -> Int
bs ys key = binarySearch ys 0 (length ys - 1) key where
    binarySearch xs l h k
        | h <  l = -1
        | k == x = m
        | k <  x = binarySearch xs l (m - 1) k
        | k >  x = binarySearch xs (m + 1) h k
        where
            x = xs !! m
            m = l + (h - l) `div` 2
    binarySearch _ _ _ _ = error "Boo"

main :: IO ()
main = do
    let e = 5::Int -- 7, the exponent used in the other tests would take too long, hence the 5
    
    let xs = [(1::Int) .. (10::Int) ^ e]
    print $ sum $ unfoldr (\i -> if i > 0 then Just (bs xs i, i - 1) else Nothing) ((10::Int) ^ e)
    
    {-
    pwm@pwm-mbp code/bs # time ./bs_1_list.hsc
    4999950000
          256.03 real       249.34 user         1.81 sys
    -}

bs_2_array.hs

{-# OPTIONS_GHC -Wall #-}
module Main (main) where

import Data.List (unfoldr)
import qualified Data.Array as A

bs :: A.Array Int Int -> Int -> Int
bs ys key = binarySearch ys 0 (snd (A.bounds ys)) key where
    binarySearch xs l h k
        | h <  l = -1
        | k == x = m
        | k <  x = binarySearch xs l (m - 1) k
        | k >  x = binarySearch xs (m + 1) h k
        where
            x = xs A.! m
            m = l + (h - l) `div` 2
    binarySearch _ _ _ _ = error "Boo"

main :: IO ()
main = do
    let e = 7::Int
    
    let xs = [(1::Int) .. (10::Int) ^ e]
    let axs = (A.array (0, (length xs - 1)) [(i - 1, i) | i <- xs])
    print $ sum $ unfoldr (\i -> if i > 0 then Just (bs axs i, i - 1) else Nothing) ((10::Int) ^ e)
    
    {-
    pwm@pwm-mbp code/bs # time ./bs_2_array.hsc
    49999995000000
            5.80 real         5.36 user         0.39 sys
    -}

bs_3_uarray.hs

{-# OPTIONS_GHC -Wall #-}
module Main (main) where

import Data.List (unfoldr)
import qualified Data.Array.Unboxed as UA

bs :: UA.Array Int Int -> Int -> Int
bs ys key = binarySearch ys 0 (snd (UA.bounds ys)) key where
    binarySearch xs l h k
        | h <  l = -1
        | k == x = m
        | k <  x = binarySearch xs l (m - 1) k
        | k >  x = binarySearch xs (m + 1) h k
        where
            x = xs UA.! m
            m = l + (h - l) `div` 2
    binarySearch _ _ _ _ = error "Boo"

main :: IO ()
main = do
    let e = 7::Int
    
    let xs = [(1::Int) .. (10::Int) ^ e]
    let axs = (UA.array (0, (length xs - 1)) [(i - 1, i) | i <- xs])
    print $ sum $ unfoldr (\i -> if i > 0 then Just (bs axs i, i - 1) else Nothing) ((10::Int) ^ e)
    
    {-
    pwm@pwm-mbp code/bs # time ./bs_3_uarray.hsc
    49999995000000
            5.81 real         5.39 user         0.37 sys
    -}

bs_4_vector.hs

{-# OPTIONS_GHC -Wall #-}
module Main (main) where

import Data.List (unfoldr)
import qualified Data.Vector as V

bs :: V.Vector Int -> Int -> Int
bs ys key = binarySearch ys 0 (V.length ys - 1) key where
    binarySearch xs l h k
        | h <  l = -1
        | k == x = m
        | k <  x = binarySearch xs l (m - 1) k
        | k >  x = binarySearch xs (m + 1) h k
        where
            x = xs V.! m
            m = l + (h - l) `div` 2
    binarySearch _ _ _ _ = error "Boo"

main :: IO ()
main = do
    let e = 7::Int
    
    let xs = [(1::Int) .. (10::Int) ^ e]
    let axs = V.fromList xs
    print $ sum $ unfoldr (\i -> if i > 0 then Just (bs axs i, i - 1) else Nothing) ((10::Int) ^ e)
    
    {-
    pwm@pwm-mbp code/bs # time ./bs_4_vector.hsc
    49999995000000
            7.07 real         6.73 user         0.27 sys
    -}

bs_5_uvector.hs

{-# OPTIONS_GHC -Wall #-}
module Main (main) where

import Data.List (unfoldr)
import qualified Data.Vector.Unboxed as UV

bs :: UV.Vector Int -> Int -> Int
bs ys key = binarySearch ys 0 (UV.length ys - 1) key where
    binarySearch xs l h k
        | h <  l = -1
        | k == x = m
        | k <  x = binarySearch xs l (m - 1) k
        | k >  x = binarySearch xs (m + 1) h k
        where
            x = xs UV.! m
            m = l + (h - l) `div` 2
    binarySearch _ _ _ _ = error "Boo"

main :: IO ()
main = do
    let e = 7::Int
    
    let xs = [(1::Int) .. (10::Int) ^ e]
    let axs = UV.fromList xs
    print $ sum $ unfoldr (\i -> if i > 0 then Just (bs axs i, i - 1) else Nothing) ((10::Int) ^ e)
    
    {-
    pwm@pwm-mbp code/bs # time ./bs_5_uvector.hsc
    49999995000000
            5.12 real         4.91 user         0.14 sys
    -}