variables

This commit is contained in:
VegOwOtenks 2024-09-16 12:34:30 +02:00
parent 9e7ad28c5c
commit 3dc3e3b842
2 changed files with 54 additions and 37 deletions

View file

@ -2,7 +2,7 @@ module Main (main) where
import Text.Parsec import Text.Parsec
import Lib (exprparser, evaluate, replaceVars, Expr) import Lib (exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions)
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as Map import qualified Data.Map as Map
@ -10,8 +10,11 @@ import Data.Ratio
import System.IO import System.IO
initVars :: Map String Rational
initVars = Map.fromList [("pi", 245850922 % 78256779), ("e", 271801 % 99990)]
main :: IO () main :: IO ()
main = ioLoop main = ioLoop initVars
precision = 5 :: Int precision = 5 :: Int
@ -21,19 +24,17 @@ showRatio p r = (if (r < 0) then "-" else "") ++ prepoint_digits ++ (if (length
prepoint_digits = init . show . round . abs $ (r * 10) 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 :: Map String Rational -> Either ParseError Expr -> String
useResult (Right expr) = either id ((showRatio precision) . evaluate) $ replaceVars expr vars useResult vs (Right expr) = either id ((showRatio precision) . evaluate) $ replaceVars expr vs
useResult (Left error) = show error useResult vs (Left error) = show error
vars :: Map String Rational ioLoop :: Map String Rational -> IO ()
vars = Map.fromList [("pi", 245850922 % 78256779), ("e", 271801 % 99990)] ioLoop vs = do done <- isEOF
ioLoop :: IO ()
ioLoop = do done <- isEOF
if done if done
then putStrLn "Quit!" then putStrLn "Quit!"
else do inp <- getLine else do inp <- getLine
let expr = parse exprparser "<stdin>" inp let expr = parse exprparser "<stdin>" inp
putStrLn . useResult $ expr let uvs = either (const vs) (\e -> Map.unionWith (flip const) vs (extractVariableDefinitions e)) expr
ioLoop putStrLn $ useResult uvs expr
ioLoop uvs

View file

@ -1,5 +1,5 @@
module Lib module Lib
( exprparser, evaluate, replaceVars, Expr ( exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions
) where ) where
import Control.Applicative((<*)) import Control.Applicative((<*))
@ -14,7 +14,7 @@ import Text.Parsec.Expr
import Text.Parsec.Token import Text.Parsec.Token
import Text.Parsec.Language 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 deriving Show
data BinaryOperator = Plus | Minus | Multiply | Divide | Power data BinaryOperator = Plus | Minus | Multiply | Divide | Power
deriving Show deriving Show
@ -73,9 +73,42 @@ constantRational = do
let natural_length = length . show $ natural let natural_length = length . show $ natural
let decimal_length = length decimal_digits let decimal_length = length decimal_digits
let numerator = natural * (10 ^ decimal_length) + decimal let numerator = natural * (10 ^ decimal_length) + decimal
let denominator = 10 ^ (decimal_length + natural_length - 1) let denominator = 10 ^ decimal_length
return (numerator % denominator) 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/b ^ c/d
- (a ^ c/d) / 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' (a, b) (c, 1) = a ^ c % b ^ c
rationalPower' _ _ = error "Powers with unnatural numbers are not supported yet" 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 :: Expr -> Rational
evaluate (Constant c) = c evaluate (Constant c) = c
evaluate (Binary Plus a b) = evaluate a + evaluate b evaluate (Binary Plus a b) = evaluate a + evaluate b