Programming Praxis – String Search: Boyer-Moore

In yesterday’s Programming Praxis problem we have to implement a more efficient string search algorithm than the brute force approach we did earlier, namely the Horspool variation of the Boyer-Moore algorithm. Let’s get started.

Our import:

import Data.Map (findWithDefault, fromList, (!))

The algorithm this time is a bit longer than the brute force one, but it’s nothing too bad. In lines 2-4 we cache some values to remove some duplication and possibly avoid recalculation. The last four lines are the actual algorithm and the first line just calls it with the proper initial arguments.

horspool :: Ord a => [a] -> Maybe Int -> [a] -> Maybe Int
horspool pat skip xs = f (lp - 1 + maybe 0 id skip) p' where
    (lp, lxs, p') = (length pat, length xs, reverse pat)
    t = fromList $ zip pat [lp - 1, lp - 2..]
    m = fromList $ zip [0..] xs
    f n []     = Just (n + 1)
    f n (p:ps) | n >= lxs   = Nothing
	       | p == m ! n = f (n - 1) ps
               | otherwise  = f (n + findWithDefault lp (m ! n) t) p'

When we test our algorithm with the same test suite as last time we can see everything is working correctly:

test :: (String -> Maybe Int -> String -> Maybe Int) -> IO ()
test f = do assertEqual (f ""   Nothing  "Hello World") (Just 0)
            assertEqual (f "He" Nothing  "Hello World") (Just 0)
            assertEqual (f "od" Nothing  "Bonsai Code") (Just 8)
            assertEqual (f "ef" Nothing  "Bonsai Code") (Nothing)
            assertEqual (f ""   (Just 1) "Hello World") (Just 1)
            assertEqual (f "He" (Just 1) "Hello World") (Nothing)
            assertEqual (f "od" (Just 1) "Bonsai Code") (Just 8)
            assertEqual (f "ef" (Just 1) "Bonsai Code") (Nothing)
         where assertEqual a b = print (a == b, a, b)

main :: IO ()
main = test horspool