module Text.ParserCombinators.Parsec.EvaluateFunction
(evaluate) where
import Text.ParserCombinators.Parsec.ParserFunction (functionParse)
import Text.ParserCombinators.Parsec.Functions
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Char (toLower)
type Expression = String
type Variable = Char
type Value = Double
evaluate :: Expression -> [(Variable,Value)] -> Double
evaluate str map = eval (M.fromAscList $ casing map) (fromMaybe failing1 $ functionParse str)
where
casing x = fmap (\ (a, b) -> ([toLower a], b)) x
failing1 = error "Parser error in expression"
failing2 x = error $ "M.lookup error in value for variable `" ++ [x] ++ "'"
eval :: M.Map String Double -> Expr -> Double
eval map expression =
case expression of
(Num d) -> d
(Var c) -> fromMaybe (failing2 c) (M.lookup [c] map)
(Add expr1 expr2) -> (eval map expr1) + (eval map expr2)
(Sub expr1 expr2) -> (eval map expr1) (eval map expr2)
(Mul expr1 expr2) -> (eval map expr1) * (eval map expr2)
(Div expr1 expr2) -> (eval map expr1) / (eval map expr2)
(Pow expr1 expr2) -> (eval map expr1) ** (eval map expr2)
(Exp expr1) -> exp (eval map expr1)
(Sqrt expr1) -> (eval map expr1) ** (0.5)
(Cbrt expr1) -> (eval map expr1) ** (1/3)
(Log expr1) -> log (eval map expr1)
(Abs expr1) -> abs (eval map expr1)
(Sin expr1) -> sin (eval map expr1)
(Cos expr1) -> cos (eval map expr1)
(Tan expr1) -> tan (eval map expr1)
(Sec expr1) -> 1/sin (eval map expr1)
(Csc expr1) -> 1/cos (eval map expr1)
(Cot expr1) -> 1/tan (eval map expr1)
(Sinh expr1) -> sinh (eval map expr1)
(Cosh expr1) -> cosh (eval map expr1)
(Tanh expr1) -> tanh (eval map expr1)
(Sech expr1) -> 1/sinh (eval map expr1)
(Csch expr1) -> 1/cosh (eval map expr1)
(Coth expr1) -> 1/tanh (eval map expr1)
(ArcSin expr1) -> asin (eval map expr1)
(ArcCos expr1) -> acos (eval map expr1)
(ArcTan expr1) -> atan (eval map expr1)
(ArcSec expr1) -> 1/asin (eval map expr1)
(ArcCsc expr1) -> 1/acos (eval map expr1)
(ArcCot expr1) -> 1/atan (eval map expr1)
(ArcSinh expr1) -> asinh (eval map expr1)
(ArcCosh expr1) -> acosh (eval map expr1)
(ArcTanh expr1) -> atanh (eval map expr1)
(ArcSech expr1) -> 1/asinh (eval map expr1)
(ArcCsch expr1) -> 1/acosh (eval map expr1)
(ArcCoth expr1) -> 1/atanh (eval map expr1)