Posts Tagged ‘expression’

Programming Praxis – Infix Expression Evaluation

July 20, 2012

In today’s Programming Praxis exercise, our goal is to write a function to evaluate mathematical expressions. Let’s get started, shall we?

Basically this exercise boils down to writing a small parser. As always, Parsec is my go-to library for this task.

import Control.Applicative ((<$), (<$>))
import Text.Parsec
import Text.Parsec.Expr
import Text.Parsec.Language
import Text.Parsec.Token

Since parsing mathematical expressions is such a common task, Parsec has some built-in functionality for it. Also, I’m using lexeme parsers so I don’t have to manually deal with whitespace. The reason for choosing the mondrian token parser rather than haskell is that — in Haskell signifies a comment, whereas in this case it means subtracting a negative number. Obviously I could just use the haskell definition and modify the commentLine string, but this was shorter. The reason for using a custom number parser instead of the default one for natural numbers is that we must also deal with numbers in which the digits are separated by whitespace.

eval :: String -> Either ParseError Double
eval = parse expr "" where
    expr  = buildExpressionParser table term
    term  = parens mondrian expr <|> (read <$> many1 (lexeme mondrian digit))
    table = [ [prefix "-" negate]
            , [binary "*" (*), binary "/" (/) ]
            , [binary "+" (+), binary "-" (-) ]
            ]
    prefix name fun = Prefix (fun <$ symbol mondrian name)
    binary name fun = Infix  (fun <$ symbol mondrian name) AssocLeft

To see if everything is working properly, we have a decent-sized test suite:

main :: IO ()
main = mapM_ (print . (\(a,b) -> either (const False) (== b) $ eval a))
           [ ("123",         123)
           , ("-123",        -123)
           , ("(123)",       123)
           , ("(((123)))",   123)
           , ("1 2 3",       123)
           , ("1+2",         1 + 2)
           , ("1+-2",        1 + (-2))
           , ("1-2",         1 - 2)
           , ("1--2",        1 - (-2))
           , ("2*3",         2 * 3)
           , ("2*-3",        2 * (-3))
           , ("2/3",         2 / 3)
           , ("2/-3",        2 / (-3))
           , ("2*3+4",       2 * 3 + 4)
           , ("2-3*4",       2 - 3 * 4)
           , ("2/3+4",       2 / 3 + 4)
           , ("2-3/4",       2 - 3 / 4)
           , ("2*(3+4)",     2 * (3 + 4))
           , ("(2-3)*4",     (2 - 3) * 4)
           , ("2/(3+4)",     2 / (3 + 4))
           , ("(2-3)/4",     (2 - 3) / 4)
           , ("1+2+3+4",     1 + 2 + 3 + 4)
           , ("1-2-3",       1 - 2 - 3)
           , ("1*2*3*4",     1 * 2 * 3 * 4)
           , ("1/2/3",       1 / 2 / 3)
           , ("123+456*789", 123 + 456 * 789)
           ]

Programming Praxis – Expression Evaluation

April 16, 2010

In today’s Programming Praxis exercise our task to write a parser for simple mathematical expressions. Let’s get started, shall we?

Some imports:

import Control.Applicative
import Text.Parsec hiding ((<|>))

We’re going to be using a somewhat different approach than the provided Scheme solution. Rather than doing everything ourselves, we will use the Parsec library, which is the go-to solution for writing parsers in Haskell. This, however, results in a small limitation. Parsec is a parser combinator library, and parser combinators cannot deal with left-recursive grammars. The grammar in the assignment is left-recursive, because if we were to enter the rule expr = expr + term (as I did in my first attempt in solving this), our program will enter an infinite loop. Fortunately, left-recursive grammars can be fairly easily rewritten using the chain functions in Parsec.

An expression is one or more terms, separated by addition and subtraction operators.

expr = chainl1 term ((+) <$ char '+' <|> (-) <$ char '-')

A term works just like an expression, but with multiplication and divison.

term = chainl1 fact ((*) <$ char '*' <|> div <$ char '/')

Factors need no change from the specified grammar: they’re either numbers or expressions in parentheses.

fact = read <$> many1 digit <|> char '(' *> expr <* char ')'

Evaluating an expression is trivial. The only extra step is to filter out all the spaces, since they have not been defined in the grammar but are present in the test cases.

eval :: String -> Int
eval = either (error . show) id . parse expr "" . filter (/= ' ')

A quick test shows that our rewritten grammar passes all of the test cases correctly:

main :: IO ()
main = mapM_ print [eval "6+2"            == 8
                   ,eval "6-2"            == 4
                   ,eval "6*2"            == 12
                   ,eval "6/2"            == 3
                   ,eval "6 * 2"          == 12
                   ,eval "2+3*4"          == 14
                   ,eval "2*3+4"          == 10
                   ,eval "2+3+4"          == 9
                   ,eval "2-3-4"          == -5
                   ,eval "2*3*4"          == 24
                   ,eval "(2+3)*4"        == 20
                   ,eval "(2*3)+4"        == 10
                   ,eval "2+(3*4)"        == 14
                   ,eval "2*(3+4)"        == 14
                   ,eval "12 * (34 + 56)" == 1080
                   ]

Using a parser library and slightly rewriting the grammar reduces the amount of required lines from 48 to 4. That’s a good trade-off in my book.

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 – 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.