I've made a data structure for mathematical expressions. I want to parse mathematical expressions like:
- \$x = 3\$
- \$y = 4\$
- \$z = x + y :\$
into an evaluated document like:
- \$x = 3\$
- \$y = 4\$
- \$z = x + y : 7\$
where \$=\$ is assignment and \$:\$ is evaluation.
The data structure must handle errors:
- Invalid input like multiple equals signs
- Invalid expressions like referencing an undefined variable
Smells and comments
Haskell is fantastic for this, but I'm still struggling with algebraic data structures; I'm used to object-oriented design. Because of this, I'd like some feedback!
Smells:
- Structure for output document relates arbitrarily on structure for input documents
- Picking
typevsdataseems random - Should I be using records?
- I struggle with finding good names
evalExpcontains much repetition- Comments on my style in general?
- I suspect that I'm evaluating nested expressions multiple times. Thoughts on how to fix this?
Data structure
The data structure itself is most important. I've included code for serialization and evaluation for reference. These are less important, but I'm thankful for comments on those as well!
module Document where
import Text.Printf(printf)
import Data.List(intercalate)
import qualified Data.Map.Strict as M
-- Source data
data Exp = Num Double
| Add Exp Exp
| Sub Exp Exp
| Mult Exp Exp
| Div Exp Exp
| Neg Exp
| Ref Name
| Call Name [Exp]
deriving (Show)
type Name = String
type Evaluation = Bool
data Statement = Statement (Maybe Name) Exp Evaluation | Informative String
deriving (Show)
data Document = Document [Statement]
deriving (Show)
instance Monoid Document where
mempty = Document []
(Document a) `mappend` (Document b) = Document (a `mappend` b)
-- Result data
type EvalError = String
type EvalRes = Either EvalError Double
data StatementResult = StatementResult Statement EvalRes | JustInformative String
deriving (Show)
type DocumentResult = [StatementResult]
data EvalState = Success Double -- Value found
| InProgress -- For terminating cyclic dependencies
| Error EvalError -- Unable to evaluate
type NameExpressions = M.Map Name Exp
type NameValues = M.Map Name EvalState
-- Serialization
class Serialize a where
serialize :: a -> String
instance Serialize Exp where
serialize (Num d) = show d
serialize (Add x y) = printf "(%s + %s)" (serialize x) (serialize y)
serialize (Sub x y) = printf "(%s - %s)" (serialize x) (serialize y)
serialize (Neg x) = "-" ++ serialize x
serialize (Mult x y) = printf "%s * %s" (serialize x) (serialize y)
serialize (Div x y) = printf "%s / %s" (serialize x) (serialize y)
serialize (Ref name) = name
serialize (Call name exps) = printf "%s(%s)" name (intercalate ", " $ map serialize exps)
instance Serialize Statement where
serialize (Statement mn exp eval) = prefix mn ++ serialize exp ++ postfix eval
where prefix (Just n) = n ++ " = "
prefix Nothing = ""
postfix True = ":"
postfix False = ""
serialize (Informative s) = s
instance Serialize Document where
serialize (Document ls) = unlines . map serialize $ ls
instance Serialize StatementResult where
serialize (StatementResult statement evalRes) = serialize statement ++ " = " ++ serializedEval evalRes
where serializedEval (Left err) = err
serializedEval (Right d) = show d
serialize (JustInformative s) = s
serializeResult :: DocumentResult -> String
serializeResult = unlines . map serialize
Evaluation
module Evaluator where
import Document
import qualified Data.Map.Strict as M
import Control.Monad(liftM2, liftM)
getNameExpressions :: Document -> NameExpressions
getNameExpressions (Document statements) =
let toKVPair (Statement (Just n) exp _) = [(n, exp)]
toKVPair _ = []
in M.fromList $ statements >>= toKVPair
evalDocument :: Document -> DocumentResult
evalDocument doc@(Document statements) = map (evalStatement nameMap) statements
where nameMap = getNameExpressions doc
evalStatement :: NameExpressions -> Statement -> StatementResult
evalStatement nameMap s@(Statement _ exp _) = StatementResult s $ evalExp nameMap exp
evalStatement _ (Informative s) = JustInformative s
-- Expression interpretation without caching
evalExp :: NameExpressions -> Exp -> EvalRes
evalExp d (Num n) = Right n
evalExp d (Add x y) = liftM2 (+) (evalExp d x) (evalExp d y)
evalExp d (Sub x y) = liftM2 (-) (evalExp d x) (evalExp d y)
evalExp d (Mult x y) = liftM2 (*) (evalExp d x) (evalExp d y)
evalExp d (Div x y) = liftM2 (/) (evalExp d x) (evalExp d y)
evalExp d (Call "sin" (arg1:_)) = liftM sin (evalExp d arg1)
evalExp d (Call "cos" (arg1:_)) = liftM cos (evalExp d arg1)
evalExp d (Call "tan" (arg1:_)) = liftM tan (evalExp d arg1)
evalExp d (Call "asin" (arg1:_)) = liftM asin (evalExp d arg1)
evalExp d (Call "acos" (arg1:_)) = liftM acos (evalExp d arg1)
evalExp d (Call "atan" (arg1:_)) = liftM atan (evalExp d arg1)
evalExp d (Call "sinh" (arg1:_)) = liftM sinh (evalExp d arg1)
evalExp d (Call "cosh" (arg1:_)) = liftM cosh (evalExp d arg1)
evalExp d (Call "tanh" (arg1:_)) = liftM tanh (evalExp d arg1)
evalExp d (Call "asinh" (arg1:_)) = liftM asinh (evalExp d arg1)
evalExp d (Call "acosh" (arg1:_)) = liftM acosh (evalExp d arg1)
evalExp d (Call "atanh" (arg1:_)) = liftM atanh (evalExp d arg1)
evalExp d (Call "log" (arg1:_)) = liftM log (evalExp d arg1)
evalExp d (Call "exp" (arg1:_)) = liftM exp (evalExp d arg1)
evalExp d (Call "abs" (arg1:_)) = liftM abs (evalExp d arg1)
evalExp d (Call "sqrt" (arg1:_)) = liftM sqrt (evalExp d arg1)
evalExp d (Call "pow" (arg1:arg2:_)) = liftM2 (**) (evalExp d arg1) (evalExp d arg2)
evalExp d (Neg x) = liftM negate (evalExp d x)
evalExp d (Ref name) = case M.lookup name d of
Just exp -> evalExp d exp
Nothing -> Left $ "No match for name: " ++ name
evalExp _ _ = Left "Not implemented"
