I recently finished reading Learn you a Haskell for great good!. Even though some topics are a bit over my head (
Monads anyone?), I wanted to try my hand at a fairly difficult problem. I chose to write a eval function that correctly handles parenthesis and the order of operations. I think this is pretty good, but I can see some things that need improvement.
module Eval where data Token = Times | Div | Add | Sub | LPren | RPren | Number Float deriving (Show, Eq) tokenise :: String -> Token tokenise n = case n of "*" -> Times "/" -> Div "+" -> Add "-" -> Sub "(" -> LPren ")" -> RPren _ -> Number $ read n parse :: String -> [Token] parse s = map tokenise $ tokens s reduce :: [Token] -> Float reduce tokens = let groups = prenGroups tokens results = map reduce groups leftover = substitute tokens results orderOfOps = [Times, Div, Add, Sub] in unpackNum $ head $ foldl (flip reduceAllOfOp) leftover orderOfOps -- The expression passed to this function must be ONLY numbers an ops in proper form, -- num, (op, num)* reduceAllOfOp :: Token -> [Token] -> [Token] reduceAllOfOp tok (x:op:y:rest) = if op == tok then let xn = unpackNum x yn = unpackNum y oper = getOp op in reduceAllOfOp tok ((Number $ oper xn yn):rest) else x:op:(reduceAllOfOp tok (y:rest)) reduceAllOfOp _ toks = toks -- substitute numbers in for prenthisis groups, pram 1 is the problem, pram 2 is a list of numbers substitute :: [Token] -> [Float] -> [Token] substitute ts  = ts substitute ts ns = let head' = takeWhile (/=LPren) ts tail' = tail $ dropWhile (/=LPren) ts rprenIdx = findMatchingRPren tail' (_, tail'') = splitAt rprenIdx tail' in head' ++ [Number $ head ns] ++ substitute tail'' (tail ns) unpackNum :: Token -> Float unpackNum (Number num) = num unpackNum _ = error "Not a number!!" isNum :: Token -> Bool isNum (Number _) = True isNum _ = False getOp :: Token -> Float -> Float -> Float getOp tok = case tok of Times -> (*) Div -> (/) Add -> (+) Sub -> (-) _ -> error "Not an op!!" -- this is also a very big mess, but not quite as bad as `findMatchingRPren` prenGroups :: [Token] -> [[Token]] prenGroups  =  prenGroups tokens = if all (`elem` tokens) [LPren, RPren] -- remove the head of the tokens, returns ... (`...) ...` then let tail' = tail $ dropWhile (/=LPren) tokens prenLoc = findMatchingRPren tail' -- returns ... (`...``) ...` (group, rest) = splitAt (prenLoc-1) tail' -- the `tail` call is to remove the pren from the list in group:prenGroups (tail rest) else  -- THIS IS A HORRIBLE FLAMING PIECE OF UGLY JUNK THAT SHOULD BE DESTROYED ON SIGHT! -- unfortunatly it is the only thing that I can think of that works... type Counter = (Int, Int, Bool) findMatchingRPren :: [Token] -> Int findMatchingRPren t = let fun = (\(runningCount, splitIdx, done) tok -> let count = runningCount + case tok of RPren -> -1 LPren -> 1 _ -> 0 in if done then (runningCount, splitIdx, done) else (if count == 0 then (count, splitIdx+1, True) else (count, splitIdx+1, False))) :: Counter -> Token -> Counter res = foldl fun ((1, 0, False) :: Counter) t in case res of (_, idx, _) -> idx -- ================ end of interesting code ===================== -- tokens :: String -> [String] tokens  =  tokens s = let s' = trim s isOp = (`elem` "+-*/()") (head', tail') = if isOp $ head s' then ([head s'], tail s') else break isOp s' in trim head':tokens tail' -- remove leading and trailing space trim :: String -> String trim (' ':ta) = trim ta trim s = if last s == ' ' then trim $ init s else s eval :: String -> Maybe Float eval e = Just $ reduce $ parse e show' :: [Token] -> String show' = concatMap (\x -> case x of Times -> "*" Div -> "/" Add -> "+" Sub -> "-" LPren -> "(" RPren -> ")" Number x -> show x)
So my questions are:
- How can I write the
findMatchingRPrenfunction more elegantly?
- How does my naming look (e.g. the use of
- What would be the best way to extract the shared code from
- What general improvements can be made to my algorithm?
- Just anything else you can see that could be improved...