From 16aca9a66b6c4abd4dd73eb91f2f18bc6b675e2d Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Mon, 16 Sep 2024 10:54:43 +0200 Subject: [PATCH 1/3] Removed trailing zeroes and point --- app/Main.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 5644a65..0100982 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -16,10 +16,10 @@ main = ioLoop precision = 5 :: Int showRatio :: Int -> Rational -> String -showRatio p r = (if (r < 0) then "-" else "") ++ prepoint_digits ++ "." ++ postpoint_digits +showRatio p r = (if (r < 0) then "-" else "") ++ prepoint_digits ++ (if (length postpoint_digits > 0) then ("." ++ postpoint_digits) else "") where prepoint_digits = init . show . round . abs $ (r * 10) - postpoint_digits = (take p) . (drop (length prepoint_digits)) . show . round . abs $ (r * 10^p) + postpoint_digits = reverse .dropWhile (=='0') . reverse .(take p) . (drop (length prepoint_digits)) . show . round . abs $ (r * 10^p) useResult (Right e) = (showRatio precision) . evaluate $ replaceVars e vars useResult (Left e) = show e From 9e7ad28c5ccf816bbcc7bd67009955bb46edbce6 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Mon, 16 Sep 2024 11:38:22 +0200 Subject: [PATCH 2/3] Error out for undefined variables --- app/Main.hs | 7 ++++--- src/Lib.hs | 18 +++++++++++++----- 2 files changed, 17 insertions(+), 8 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 0100982..167abc2 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) +import Lib (exprparser, evaluate, replaceVars, Expr) import Data.Map (Map) import qualified Data.Map as Map @@ -21,8 +21,9 @@ showRatio p r = (if (r < 0) then "-" else "") ++ prepoint_digits ++ (if (length 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) -useResult (Right e) = (showRatio precision) . evaluate $ replaceVars e vars -useResult (Left e) = show e +useResult :: Either ParseError Expr -> String +useResult (Right expr) = either id ((showRatio precision) . evaluate) $ replaceVars expr vars +useResult (Left error) = show error vars :: Map String Rational vars = Map.fromList [("pi", 245850922 % 78256779), ("e", 271801 % 99990)] diff --git a/src/Lib.hs b/src/Lib.hs index 2b24d47..b9c05aa 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,5 +1,5 @@ module Lib - ( exprparser, evaluate, replaceVars + ( exprparser, evaluate, replaceVars, Expr ) where import Control.Applicative((<*)) @@ -92,10 +92,17 @@ term = m_parens exprparser <|> 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 +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 (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 evaluate :: Expr -> Rational evaluate (Constant c) = c @@ -104,3 +111,4 @@ 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" From 3dc3e3b8425db0932f9c584dae1832feb5ef96ac Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Mon, 16 Sep 2024 12:34:30 +0200 Subject: [PATCH 3/3] variables --- app/Main.hs | 35 +++++++++++++++++---------------- src/Lib.hs | 56 ++++++++++++++++++++++++++++++++++------------------- 2 files changed, 54 insertions(+), 37 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 167abc2..669c576 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) +import Lib (exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions) import Data.Map (Map) import qualified Data.Map as Map @@ -10,8 +10,11 @@ import Data.Ratio import System.IO +initVars :: Map String Rational +initVars = Map.fromList [("pi", 245850922 % 78256779), ("e", 271801 % 99990)] + main :: IO () -main = ioLoop +main = ioLoop initVars precision = 5 :: Int @@ -19,21 +22,19 @@ showRatio :: Int -> Rational -> String showRatio p r = (if (r < 0) then "-" else "") ++ prepoint_digits ++ (if (length postpoint_digits > 0) then ("." ++ postpoint_digits) else "") 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 = reverse . dropWhile (=='0') . reverse .(take p) . (drop (length prepoint_digits)) . show . round . abs $ (r * 10^p) -useResult :: Either ParseError Expr -> String -useResult (Right expr) = either id ((showRatio precision) . evaluate) $ replaceVars expr vars -useResult (Left error) = show error +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 -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 +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 diff --git a/src/Lib.hs b/src/Lib.hs index b9c05aa..ceee931 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,5 +1,5 @@ module Lib - ( exprparser, evaluate, replaceVars, Expr + ( exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions ) 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 +data Expr = Variable String | Constant Rational | Binary BinaryOperator Expr Expr | VariableDefinition String Rational deriving Show data BinaryOperator = Plus | Minus | Multiply | Divide | Power deriving Show @@ -73,9 +73,42 @@ 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 + natural_length - 1) + let denominator = 10 ^ decimal_length 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) @@ -87,23 +120,6 @@ 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 -> 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 (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 - evaluate :: Expr -> Rational evaluate (Constant c) = c evaluate (Binary Plus a b) = evaluate a + evaluate b