Search in Rotated Array

In [1]:

    

import Data.Array
import Data.Maybe


    

In [2]:

    

searchRotated :: (Ix i, Integral i, Show i, Ord e) => e -> Array i e -> Maybe i
searchRotated x xs =
    let
        midpoint left right = left + (right - left) `div` 2
        
        binarySearch left right -- [, ]
            | left > right = Nothing
            | otherwise =
                case compare x (xs ! middle) of
                    EQ -> Just middle
                    LT -> binarySearch left (middle - 1)
                    GT -> binarySearch (middle + 1) right
            where
                middle = midpoint left right
        
        modifiedSearch left right
            | left > right = Nothing
            | otherwise =
                let
                    middle = midpoint left right
                    middleElem = xs ! middle
                    firstElem = xs ! left
                    lastElem = xs ! right
                in
                    if
                        middleElem == x then Just middle
                    else
                        case compare firstElem middleElem of
                            EQ -> case compare middleElem lastElem of
                                EQ -> listToMaybe $ catMaybes 
                                    [ modifiedSearch left (middle - 1)
                                    , modifiedSearch (middle + 1) right ]
                                LT -> binarySearch (middle + 1) right
                                GT -> modifiedSearch (middle + 1) right
                            LT -> -- left side sorted
                                if x < middleElem && x >= firstElem then
                                    binarySearch left (middle - 1)
                                else
                                    modifiedSearch (middle + 1) right
                            GT -> -- right side sorted
                                if x > middleElem && x <= lastElem then
                                    binarySearch (middle + 1) right
                                else
                                    modifiedSearch left (middle - 1)
    in
        uncurry modifiedSearch $ bounds xs


    

In [3]:

    

searchRotated 3 $ listArray (1, 10) [1..10]
searchRotated (-3) $ listArray (1, 10) [1..10]


    

    





Just3






    





Nothing

In [4]:

    

searchRotated' :: (Ix i, Ord e) => e -> Array i e -> Maybe i
searchRotated' x = fmap fst . listToMaybe . filter ((x ==) . snd) . assocs


    

In [5]:

    

searchRotated' 3 $ listArray (1, 10) [1..10]
searchRotated' (-3) $ listArray (1, 10) [1..10]


    

    





Just3






    





Nothing

In [6]:

    

import Data.List (nub)


    

In [7]:

    

{-# LANGUAGE ScopedTypeVariables #-}


    

In [8]:

    

testSearchRotated :: forall a. (Num a, Ord a, Enum a, Show a) => [a] -> Bool
testSearchRotated items =
    let

        indices = [1..length items]
        rotations = map (uncurry (flip (++)) . (`splitAt` items)) indices
        haystacks = map (listArray (head indices, last indices)) rotations
        needles = [(minimum items - 1) .. (maximum items + 1)]

        checkRotation :: (Ix i, Integral i, Show i) => Array i a -> Bool
        checkRotation haystack =
            let
                results = zip needles $ map (`searchRotated` haystack) needles
                checkResult (needle, Nothing) = needle `notElem` items
                checkResult (needle, Just index) = needle == (haystack ! index)
            in
                all checkResult results

    in
        all checkRotation haystacks


    

In [9]:

    

testSearchRotated $ replicate 7 1 ++ [1,3,5]


    

    






True

In [10]:

    

import Test.QuickCheck
import Data.List (sort)


    

In [11]:

    

testSearchRotatedRandomized :: [Int] -> Bool
testSearchRotatedRandomized = testSearchRotated . sort


    

In [12]:

    

quickCheck testSearchRotatedRandomized


    

    






+++ OK, passed 100 tests.