Archive for August, 2009

Programming Praxis – String Search: Boyer-Moore

August 29, 2009

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
Advertisements

Programming Praxis – Brute Force

August 21, 2009

Today’s Programming Praxis post is another easy one. We have to implement a brute-force string search. Let’s get started.

Our import:

import Data.List

Since it’s no extra effort, we’ll just make our search function generic.

bruteSearch :: Eq a => [a] -> Maybe Int -> [a] -> Maybe Int
bruteSearch n o = fmap fst . find (isPrefixOf n . snd) .
                  drop (maybe 0 id o) . zip [0..] . tails

With that out of the way, let’s define our test suite:

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

And let’s run it to see if everything’s in order.

main :: IO ()
main = test bruteSearch

It works fine, but obviously it’s not the most efficient search algorithm. For that you’ll have to wait for the upcoming other search algorithms.

Programming Praxis – Blum Blum Shub

August 18, 2009

In today’s Programming Praxis problem we have to implement a stream cipher based on the Blum Blum Shub method. Let’s get started.

First our imports:

import Data.Bits
import Data.Char

This is our random number generator. I’m using the least significant 3 bits instead of just one because it scrambles the original message a bit more.

rng :: Int -> Int -> [Int]
rng m = map (.&. 7) . tail . iterate (\n -> mod (n ^ 2) m)

Encoding or decoding is a simple matter of xor’ing the message and the random number stream.

cipher :: Int -> Int -> Int -> String -> String
cipher s p q = map chr . zipWith xor (rng (p * q) s) . map ord

And that’s all there is to it. Let’s see if it works:

main :: IO ()
main = do print $ cipher 3 11 19 "Bonsai Code"
          print . cipher 3 11 19 $ cipher 3 11 19 "Bonsai Code"

Seems to work just fine. Not bad for just two lines of code.

Programming Praxis – Pairing Heaps

August 14, 2009

Righty, I’m back from vacation so let’s get right back to business. In today’s Programming Praxis problem we have another data structure to implement. Let’s get started.

The data structure is a simple tree:

data PairingHeap a = Empty | Node a [PairingHeap a]

findFirst, merge and insert are fairly trivial.

findFirst :: PairingHeap a -> Maybe a
findFirst Empty      = Nothing
findFirst (Node n _) = Just n

merge :: Ord a => PairingHeap a -> PairingHeap a -> PairingHeap a
merge Empty p = p
merge p Empty = p
merge m@(Node x ps) n@(Node y qs) | y < x     = Node y (m:qs)
                                  | otherwise = Node x (n:ps)

insert :: Ord a => a -> PairingHeap a -> PairingHeap a
insert x = merge (Node x [])

For deleteFirst, just folding merge over ps would work as well, but the implementation calls for two passes, presumably for efficiency reasons.

deleteFirst :: Ord a => PairingHeap a -> PairingHeap a
deleteFirst Empty       = Empty
deleteFirst (Node _ ps) = foldr merge Empty $ pair ps where
    pair (a:b:xs) = merge a b : pair xs
    pair xs       = xs

And to implement the priority queue we need fromList, toList and pqSort from the priority queues exercise.

fromList :: Ord a => [a] -> PairingHeap a
fromList = foldr insert Empty

toList :: Ord a => PairingHeap a -> [a]
toList Empty        = []
toList n@(Node x _) = x : toList (deleteFirst n)

pqSort :: Ord a => [a] -> [a]
pqSort = toList . fromList

Let’s test if everything works:

main :: IO ()
main = print $ pqSort [3, 7, 8, 1, 2, 9, 6, 4, 5]

Yup. Simple enough.