module Main where import Data.Char import qualified Data.Map as M data Token = Number Double | ParenOpen | ParenClose | AddOp | MulOp | DivOp | SubOp deriving (Show, Eq) isOp:: Token -> Bool isOp AddOp = True isOp MulOp = True isOp DivOp = True isOp SubOp = True isOp _ = False scanNumber:: String -> (Double, String) scanNumber xs = (num, str) where (n, str) = span isNumber xs num = read n :: Double opmap:: M.Map Char Token opmap = M.fromList [ ('+', AddOp), ('*', MulOp), ('/', DivOp), ('(', ParenOpen), ('-', SubOp), (')', ParenClose)] tokenize:: String -> [Maybe Token] tokenize s = loop s [] where loop str tokens | null str = tokens | isNumber $ head str = let (num, str') = scanNumber str tokens' = tokens ++ [Just (Number num)] in loop str' tokens' -- Skip whitespaces | (\c -> c == ' ') $ head str = loop (tail str) tokens -- Otherwise lookup for op | otherwise = loop (tail str) (tokens ++ [M.lookup (head str) opmap]) opPriority :: Token -> Int opPriority AddOp = 0 opPriority SubOp = 0 opPriority MulOp = 1 opPriority DivOp = 1 opPriority ParenOpen = 2 opPriority ParenClose = 2 opPriority (Number _) = 3 -- Shunting yard algo transform:: [Maybe Token] -> [Token] -- tokens - stack - output transform ts = transform' ts [] [] where transform' [] [] out = out transform' [] st out = if head st == ParenOpen then error "Mismatched parentheses" else transform' [] (tail st) (out ++ [head st]) transform' (t:ts) st out = case t of Nothing -> error "Illegal tokens" Just (Number n) -> transform' ts st (out ++ [Number n]) Just ParenOpen -> transform' ts (ParenOpen:st) out Just ParenClose -> transform' ts st0 out0 where st0 = tail $ dropWhile (/= ParenOpen) st out0 = out ++ takeWhile (/= ParenOpen) st Just o1 -> transform' ts st1 out1 where cond o2 = isOp o2 && (opPriority o1 <= opPriority o2) spl = span cond st st1 = o1 : snd spl out1 = out ++ fst spl eval :: [Token] -> Token eval ts = head $ eval' [] ts where eval' :: [Token] -> [Token] -> [Token] eval' st (t:ts) = let numFromToken (Number n) = n fstNum = numFromToken . head sndNum = numFromToken . head . tail rem = tail . tail in case t of Number n -> eval' (t : st) ts AddOp -> eval' ((Number (sndNum st + fstNum st)) : (rem st)) ts MulOp -> eval' ((Number (sndNum st * fstNum st)) : (rem st)) ts DivOp -> eval' ((Number (sndNum st / fstNum st)) : (rem st)) ts SubOp -> eval' ((Number (sndNum st - fstNum st)) : (rem st)) ts eval' st [] = st main = do s <- getLine let Number res = eval $ transform $ tokenize s print res