Archive for September, 2009

Programming Praxis – Grep

September 25, 2009

Before we begin, a small note: I’ll be on conference in Istanbul next week, so I won’t be here for the next two exercises.

In today’s Programming Praxis exercise we’re supposed to implement grep based on the regex matching functions we wrote in previous exercises. Let’s get started.

First, some imports.

import System.Environment
import Text.Printf

Obviously, we’re going to need the code we wrote in the previous two exercises.

--Code from the previous two exercises goes here

grepString shows all the lines of the input that (don’t) contain the regular expression, prefixed by the filename if one is provided.

grepString :: Bool -> Maybe String -> [Chunk] -> String -> IO ()
grepString b p cs = mapM_ (printf "%s%s\n" $ maybe "" (++ ": ") p) .
                    filter ((== b) . match cs) . lines

grep searches all the given files, or the standard input if none are provided, for the regular expression.

grep :: Bool -> [String] -> IO ()
grep _ []     = error "Not enough arguments provided"
grep b (r:ps) = either print (f ps) $ parseRegex r where
    f [] cs = grepString b Nothing cs =<< getLine
    f _  cs = mapM_ (\p -> grepString b (Just p) cs =<< readFile p) ps

Finally, main checks whether to display the lines that do or do not match.

main :: IO ()
main = f =<< getArgs where
           f ("-v":args) = grep False args
           f args        = grep True  args

And that’s it. See you guys in a week.

Programming Praxis – Regular Expressions, Part 2

September 18, 2009

Last time we wrote a parser for simple regular expressions. In today’s exercise, we have to write the matcher that checks if the input string matches the parsed regex. Since we wrote a similar matcher in the Beautiful Code exercise, this is mostly going to be a retread of that code. Still, let’s have a look.

A quick import:

import Data.List

This is the data structure we defined last time. Obviously we’re going to need it here again.

data Elem = Lit Char | Esc Char | Any | Set Bool [Elem] deriving Show
data Chunk = Elem Elem | BoL | EoL | Star Elem deriving Show

matchElem is the only new function, because, since we now have two additional cases, it’s clearer to make a separate function out of it.

matchElem :: Elem -> Char -> Bool
matchElem e c = case e of Lit l    -> l == c
                          Esc s    -> show c == '\\':[s]
                          Set b es -> b == any (`matchElem` c) es
                          Any      -> True

The other three functions have only received some small tweaks compared to the previous version. The logic remains unchanged.

matchHere :: [Chunk] -> String -> Bool
matchHere (Elem r:rs) (x:xs) = matchElem r x && matchHere rs xs
matchHere (Star e:r)  xs     = matchStar e r xs
matchHere [EoL]       xs     = null xs
matchHere r           _      = null r

matchStar :: Elem -> [Chunk] -> String -> Bool
matchStar _ r xs     | matchHere r xs = True
matchStar e r (x:xs) = matchElem e x && matchStar e r xs
matchStar _ _ _      = False

match :: [Chunk] -> String -> Bool
match (BoL:r) = matchHere r
match r       = any (matchHere r) . tails

A quick test shows everything working correctly:

main :: IO ()
main = do
    expect False [Elem digit, Star digit]
    expect True  [BoL, Elem Any, Star Any, EoL]
    expect True  hello
    expect True  ([BoL, Star $ Lit ' '] ++ hello ++ [Star $ Lit ' ', EoL])
    expect False [BoL, Elem $ Set False [Lit 'x'], Star Any,
                  Elem digit, Star $ Lit ' ', Elem $ Lit 'x', EoL]
    where expect b cs = print $ match cs "hello" == b
          digit = Set True $ map Lit ['0'..'9']
          hello = map (Elem . Lit) "hello"

Piece of cake.

Programming Praxis – Regular Expressions, Part 1

September 15, 2009

In today’s Programming Praxis problem our task is to write a parser for simple regular expressions. Since Haskell has a very good parser library called Parsec, we’re going to be using that. Let’s get started.

First, some imports:

import Control.Applicative ((<$>), (*>), (<*), (<*>))
import Data.Char
import Text.Parsec
import Text.Parsec.String

Next we define our data structure. There are seven constructs we have to implement, split into two groups based on whether or not they can be followed by a star or not.

data Elem = Lit Char | Esc Char | Any | Set Bool [Elem] deriving Show
data Chunk = Elem Elem | BoL | EoL | Star Elem deriving Show

The parser itself is not too difficult if you know how the operators from Control.Applicative work. <$> means apply the function on the left to the result of the parser on the right. <*, *> and <*> take only the result on the left, right and both sides respectively.

regex :: Parser [Chunk]
regex = (++) <$> bol <*> many chunk where
    bol = option [] (const [BoL] <$> char '^')
    chunk = choice [Star <$> try (element <* char '*'),
                    const EoL <$> try (char '$' <* eof),
                    Elem <$> element]
    element = choice [esc <$> try (char '\\' *> anyChar),
                      const Any <$> char '.',
                      Set False . expandSet <$> set "[^",
                      Set True . expandSet <$> set "[",
                      Lit <$> noneOf "]"]
    esc c = if elem c "nt" then Esc c else Lit c
    set s = try (string s *> many1 element <* char ']')
    expandSet (Lit a:Lit '-':Lit b:xs)
        | validRange a b = map Lit [a..b] ++ expandSet xs
    expandSet (x:xs) = x : expandSet xs
    expandSet _ = []
    validRange a b = b > a && ((isLower a && isLower b) ||
                               (isUpper a && isUpper b) ||
                               (isDigit a && isDigit b))

With the parser written, the function to parse a string is trivial:

parseRegex :: String -> Either ParseError [Chunk]
parseRegex = parse regex ""

Some tests to see if everything is working properly:

main :: IO ()
main = mapM_ print [parseRegex "[0-9][0-9]*",
                    parseRegex "^..*$",
                    parseRegex "hello",
                    parseRegex "^ *hello *$",
                    parseRegex "^[^x].*[0-9] *x$"]

Piece of cake. Next time we do the implementation.

Programming Praxis – Beautiful Code

September 11, 2009

Today’s Programming Praxis is about beautiful code. Specifically, it concerns a bit of C code that can match simple regular expressions. The code in question is widely considered as beautiful code. Personally I’d say the idea behind the code is good, but that the beauty of the code sample itself is being held back by a language that requires too much dealing with trivial stuff (e.g. having to manually increment pointers to move through a string), making the code needlessly long. Fortunately, our assignment is to implement the algorithm using the features and idioms of our own language, so let’s see what we can do with a slightly more modern language:

First, an import:

import Data.List

Since the algorithm itself isn’t all that difficult, we’ll focus on the features of Haskell that are used in this version. the top-level function shows pattern matching (replacing all those if statements), first-class functions (the argument for map) and partial application (match returns a function that takes a string and returns a bool).

match :: String -> String -> Bool
match ('^':r) = matchHere r
match r       = or . map (matchHere r) . tails

matchHere shows more pattern matching and adds lazy evaluation (if the check on the first character of the regex in the third line fails, the second condition is not checked).

matchHere :: String -> String -> Bool
matchHere (c:'*':r) xs  = matchStar c r xs
matchHere "$"       xs  = null xs
matchHere (r:rs) (x:xs) = (r == '.' || r == x) && matchHere rs xs
matchHere r      _      = null r

matchStar adds pattern guards to the mix.

matchStar :: Char -> String -> String -> Bool
matchStar _ r xs     | matchHere r xs = True
matchStar c r (x:xs) = (c == '.' || c == x) && matchStar c r xs
matchStar _ _ _      = False

Using the test suite from Programming Praxis (shortened here due to length) we can see our function works correctly:

main :: IO ()
main = do mapM_ print [
              match "a" "a",
              match "a" "b" == False,
              match "a*a*a" "aaa",
              match "a*a*a" "xxxxx" == False]

With less than half the code size of the original, and a more high-level approach, I prefer this version over the original, but I guess beauty is in the eye of the beholder.

Programming Praxis – Ron’s Cipher #4

September 4, 2009

In today’s Programming Praxis problem, we have to implement the RC4 cipher, which is often used in protocols such as SSL and WEP. Let’s have a go, shall we?

First, some imports:

import Data.Bits
import Data.Char
import Data.IntMap ((!), fromList, insert, size, IntMap)

In this algorithm we’re going to have to swap two elements of a list twice, so let’s make a function for it. In order to speed this operation up, we’re going to use IntMaps instead of plain lists.

swap :: Int -> Int -> IntMap a -> IntMap a
swap i j a = insert j (a ! i) $ insert i (a ! j) a

The algorithm consists of two steps. The first step is to create a list of 256 integers based on the key.

rc4init :: IntMap Char -> IntMap Int
rc4init key = snd $ foldl (\(j, a) i ->
    let j' = mod (j + a ! i + ord (key ! mod i (size key))) 256
    in (j', swap i j' a)) (0, s) [0..255] where
    s = fromList $ zip [0..] [0..255]

In the second step, we create a stream of characters based on the result of step 1, which is xor’ed with the input string.

rc4 :: String -> String -> String
rc4 key = map chr . zipWith xor (stream key) . map ord where
    stream = s 0 0 . rc4init . fromList . zip [0..]
    s i' j' k' = k ! (mod (k ! i + k ! j) 256) : s i j k where
                 i = mod (i' + 1) 256
                 j = mod (j' + k' ! i) 256
                 k = swap i j k'

Let’s see if that works correctly:

main :: IO ()
main = do print $ rc4 "Kata" "Bonsai Code"
          print . rc4 "Kata" $ rc4 "Kata" "Bonsai Code"

Yup. 11 lines, not too shabby.

Programming Praxis – String Search: Rabin-Karp

September 1, 2009

Today’s Programming Praxis problem marks the end of the string search series. In this final entry, we have to implement the Rabin-Karp search algorithm. Let’s see what we can do.

First some imports:

import Data.Char
import Data.List

We need the ascii values of the characters in the string, and since the hash values we’re going to be using can get quite large, we’re going to use Integers.

asciis :: String -> [Integer]
asciis = map (fromIntegral . ord)

The hash function treats the list of ascii values as a base 256 number.

hash :: Num a => [a] -> a
hash = sum . zipWith (*) (iterate (* 256) 1) . reverse

For the algorithm, we need the hashes of all the pattern-length substrings of the search string.

hashes :: Int -> String -> [Integer]
hashes p xs = scanl (\s (f,t) -> 256*s - 256^p*f + t) (hash $ take p ascs) .
              zip ascs $ drop p ascs where ascs = asciis xs

With those helper functions defined, the search algorithm becomes fairly straightforward:

rabinKarp :: String -> Maybe Int -> String -> Maybe Int
rabinKarp p s = lookup (hash $ asciis p) . drop (maybe 0 id s) .
                flip zip [0..] . hashes (length p)

And as before, we run our algorithm through the test suite:

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 rabinKarp

Everything’s working correctly. Not bad for 6 lines of code.