diff --git a/arithmetic/Main.hs b/arithmetic/Main.hs new file mode 100644 index 0000000..23d52e0 --- /dev/null +++ b/arithmetic/Main.hs @@ -0,0 +1,86 @@ +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' [] [] q = q + transform' [] s q = + if head s == ParenOpen + then error "Mismatched parentheses" + else transform' [] (tail s) (q ++ [head s]) + transform' (x:xs) s q = case x of + Nothing -> error "Illegal tokens" + (Just (Number n)) -> transform' xs s (q ++ [Number n]) + (Just ParenOpen) -> transform' xs (ParenOpen:s) q + (Just ParenClose) -> transform' xs s0 q0 where + s0 = tail $ dropWhile (/= ParenOpen) s + q0 = q ++ takeWhile (/= ParenOpen) s + (Just o1) -> transform' xs s1 q1 where + cond o2 = isOp o2 && (opPriority o1 < opPriority o2) + spl = span cond s + s1 = o1 : snd spl + q1 = q ++ 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 (fstNum st + sndNum st)) : (rem st)) ts + MulOp -> eval' ((Number (fstNum st * sndNum 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 diff --git a/seminar01/Factorial.hs b/factorial/Factorial.hs similarity index 100% rename from seminar01/Factorial.hs rename to factorial/Factorial.hs