In [1]:
import Data.Array
In [2]:
data Listy i e = Listy (Array i e)
In [3]:
elementAt :: (Ix i, Show i) => Listy i e -> i -> Maybe e
elementAt (Listy xs) i =
let
(left, right) = bounds xs
in
if left <= i && i <= right then
Just $ xs ! i
else
Nothing
lowerBound :: (Ix i) => Listy i e -> i
lowerBound (Listy xs) = fst $ bounds xs
In [4]:
{-# LANGUAGE ScopedTypeVariables #-}
In [5]:
import Data.Maybe (maybe)
In [6]:
searchSorted :: forall i e. (Integral i, Ix i, Show i, Ord e) => e -> Listy i e -> Maybe i
searchSorted x xs =
let
start = lowerBound xs
comparison :: i -> i -> Maybe i -> Maybe i
comparison left middle maybeRight =
case xs `elementAt` middle of
Nothing -> binarySearch left (Just (middle - 1))
Just x' ->
case compare x x' of
EQ -> Just middle
LT -> binarySearch left (Just (middle - 1))
GT -> binarySearch (middle + 1) maybeRight
binarySearch :: i -> Maybe i -> Maybe i
binarySearch left maybeRight
| maybe False (left >) maybeRight = Nothing
| otherwise =
let
middle = case maybeRight of
Just right -> left + (right - left) `div` 2
Nothing -> 2 * left - start + 1
in
comparison left middle maybeRight
in
binarySearch start Nothing
In [7]:
import Data.List (nub)
import Data.Maybe (isNothing)
In [8]:
testSearchSorted :: [Int] -> Bool
testSearchSorted [] = True
testSearchSorted xs =
let
xs' = Listy $ listArray (1, length xs) xs
needles = nub xs
needles' = filter (`notElem` needles) [pred (head needles) .. succ (last needles)]
checkIndex :: (Int, Maybe Int) -> Bool
checkIndex (needle, index) = maybe False (\i -> (xs' `elementAt` i) == Just needle) index
in
all checkIndex (zip needles $ map (`searchSorted` xs') needles) &&
all isNothing (map (`searchSorted` xs') needles')
testSearchSorted [-5..5]
In [9]:
import Test.QuickCheck
import Data.List (sort)
In [10]:
testSearchSortedRandomized :: [Int] -> Bool
testSearchSortedRandomized = testSearchSorted . sort
In [11]:
quickCheck testSearchSortedRandomized