diff --git a/app/Main.hs b/app/Main.hs index 669c576..5644a65 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -2,7 +2,7 @@ module Main (main) where import Text.Parsec -import Lib (exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions) +import Lib (exprparser, evaluate, replaceVars) import Data.Map (Map) import qualified Data.Map as Map @@ -10,31 +10,29 @@ import Data.Ratio import System.IO -initVars :: Map String Rational -initVars = Map.fromList [("pi", 245850922 % 78256779), ("e", 271801 % 99990)] - main :: IO () -main = ioLoop initVars +main = ioLoop precision = 5 :: Int showRatio :: Int -> Rational -> String -showRatio p r = (if (r < 0) then "-" else "") ++ prepoint_digits ++ (if (length postpoint_digits > 0) then ("." ++ postpoint_digits) else "") +showRatio p r = (if (r < 0) then "-" else "") ++ prepoint_digits ++ "." ++ postpoint_digits where prepoint_digits = init . show . round . abs $ (r * 10) - postpoint_digits = reverse . dropWhile (=='0') . reverse .(take p) . (drop (length prepoint_digits)) . show . round . abs $ (r * 10^p) + postpoint_digits = (take p) . (drop (length prepoint_digits)) . show . round . abs $ (r * 10^p) -useResult :: Map String Rational -> Either ParseError Expr -> String -useResult vs (Right expr) = either id ((showRatio precision) . evaluate) $ replaceVars expr vs -useResult vs (Left error) = show error +useResult (Right e) = (showRatio precision) . evaluate $ replaceVars e vars +useResult (Left e) = show e -ioLoop :: Map String Rational -> IO () -ioLoop vs = do done <- isEOF - if done - then putStrLn "Quit!" - else do inp <- getLine - let expr = parse exprparser "" inp - let uvs = either (const vs) (\e -> Map.unionWith (flip const) vs (extractVariableDefinitions e)) expr - putStrLn $ useResult uvs expr - ioLoop uvs +vars :: Map String Rational +vars = Map.fromList [("pi", 245850922 % 78256779), ("e", 271801 % 99990)] + +ioLoop :: IO () +ioLoop = do done <- isEOF + if done + then putStrLn "Quit!" + else do inp <- getLine + let expr = parse exprparser "" inp + putStrLn . useResult $ expr + ioLoop diff --git a/src/Lib.hs b/src/Lib.hs index ceee931..2b24d47 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,5 +1,5 @@ module Lib - ( exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions + ( exprparser, evaluate, replaceVars ) where import Control.Applicative((<*)) @@ -14,7 +14,7 @@ import Text.Parsec.Expr import Text.Parsec.Token import Text.Parsec.Language -data Expr = Variable String | Constant Rational | Binary BinaryOperator Expr Expr | VariableDefinition String Rational +data Expr = Variable String | Constant Rational | Binary BinaryOperator Expr Expr deriving Show data BinaryOperator = Plus | Minus | Multiply | Divide | Power deriving Show @@ -73,42 +73,9 @@ constantRational = do let natural_length = length . show $ natural let decimal_length = length decimal_digits let numerator = natural * (10 ^ decimal_length) + decimal - let denominator = 10 ^ decimal_length + let denominator = 10 ^ (decimal_length + natural_length - 1) return (numerator % denominator) -variableDefinition :: Parser Expr -variableDefinition = try (do - name <- m_identifier - _ <- char '=' - value <- constantInteger <|> constantRational - return (VariableDefinition name value) - ) - -term = m_parens exprparser - <|> variableDefinition - <|> fmap Variable m_identifier - <|> fmap Constant constantInteger - <|> fmap Constant constantRational - -extractVariableDefinitions :: Expr -> Map.Map String Rational -extractVariableDefinitions (VariableDefinition name value) = Map.singleton name value -extractVariableDefinitions (Binary _ a b) = Map.union (extractVariableDefinitions a) (extractVariableDefinitions b) -extractVariableDefinitions (Constant _) = Map.empty -extractVariableDefinitions (Variable _) = Map.empty - -replaceVars :: Expr -> Map.Map String Rational -> Either String Expr -replaceVars (Constant c) vs = Right $ Constant c -replaceVars (Variable name) vs = maybe (Left ("Usage of unknown variable: '" ++ name ++ "'\nSuggestion: define the variable\n++ " ++ name ++ "=42")) (Right . Constant . id) $ Map.lookup name vs -replaceVars (VariableDefinition _ value ) vs = Right $ Constant value -replaceVars (Binary op l r) vs = case leftBranch of - Left s -> Left s - Right a -> case rightBranch of - Left s -> Left s - Right b -> Right $ Binary op a b - where - leftBranch = replaceVars l vs - rightBranch = replaceVars r vs - {- - a/b ^ c/d - (a ^ c/d) / b ^ (c/d) @@ -120,6 +87,16 @@ rationalPower a b = rationalPower' (numerator a, denominator a) (numerator b, de rationalPower' (a, b) (c, 1) = a ^ c % b ^ c rationalPower' _ _ = error "Powers with unnatural numbers are not supported yet" +term = m_parens exprparser + <|> fmap Variable m_identifier + <|> fmap Constant constantInteger + <|> fmap Constant constantRational + +replaceVars :: Expr -> Map.Map String Rational -> Expr +replaceVars (Variable name) vs = Constant . maybe (0 % 1) id $ Map.lookup name vs +replaceVars (Binary op a b) vs = Binary op (replaceVars a vs) (replaceVars b vs) +replaceVars (Constant c) vs = Constant c + evaluate :: Expr -> Rational evaluate (Constant c) = c evaluate (Binary Plus a b) = evaluate a + evaluate b @@ -127,4 +104,3 @@ evaluate (Binary Minus a b) = evaluate a - evaluate b evaluate (Binary Divide a b) = evaluate a / evaluate b evaluate (Binary Multiply a b) = evaluate a * evaluate b evaluate (Binary Power a b) = rationalPower (evaluate a) (evaluate b) -evaluate (Variable _) = error "Unreachable Code"