diff --git a/ParserFunction.cabal b/ParserFunction.cabal --- a/ParserFunction.cabal +++ b/ParserFunction.cabal @@ -1,25 +1,22 @@ name: ParserFunction -version: 0.0.6 +version: 0.0.7 cabal-version: >= 1.6 license: BSD3 license-file: LICENSE author: Enzo Haussecker maintainer: ehaussecker@gmail.com category: Parsing +build-type: Simple + synopsis: Utilities for parsing and evaluating mathematical expressions. -description: - ParserFunction provides utilities for parsing and evaluating mathematical expressions. - The central parsing function in this package is @stringToExpr@, which parses a string-expression - (e.g. \"3*x+2\") and returns a Maybe expression tree of type Expr (e.g. Just (Add (Mul (Num 3.0) (Var \'x\')) (Num 2.0))). - This type is suitable for performing symbolic logic. Expressions can then be evaluated using the function @evaluate@ - (e.g. @evaluate@ (fromAscList [(\"x\",2)]) (Add (Mul (Num 3.0) (Var \'x\'))) (Num 2.0) would give 8.0). - If you wish to evaluate a string-expression without any intermediate symbolic logic operations, simply use the function - @evaluateExpression@ (e.g. @evaluateExpression@ \"3*x+2\" [(\'x\',4)] gives 14.0). More examples of these functions can be found - by viewing the source code for this package. -build-type: Simple +description: + ParserFunction provides utilities for parsing and evaluating mathematical expressions. The central parsing + function in this package is @stringToExpr@, which parses a string-expression and returns a maybe expression tree. + This tree is suitable for performing symbolic manipulation. Expressions can then be evaluated using the function + @evalExpr@. If you wish to evaluate a string-expression without any intermediate operations, simply use the function + @evalString@. Examples of these functions can be seen by viewing the source code of this module. Library - exposed-modules: - Text.ParserCombinators.Parsec.ParserFunction - build-depends: base < 6, parsec, containers + exposed-modules: Text.ParserCombinators.Parsec.ParserFunction + build-depends: base < 6, parsec, containers diff --git a/Text/ParserCombinators/Parsec/ParserFunction.hs b/Text/ParserCombinators/Parsec/ParserFunction.hs --- a/Text/ParserCombinators/Parsec/ParserFunction.hs +++ b/Text/ParserCombinators/Parsec/ParserFunction.hs @@ -1,28 +1,31 @@ ---- ParserFunction ---- by Enzo Haussecker - ---- ParserFunction provides utilities for parsing and evaluating mathematical expressions. ---- The central parsing function in this package is stringToExpr, which parses an expression ---- (as a string) and returns an expression tree of type Expr (or nothing if the string is malformed). - ---- Examples of stringToExpr are as fallows. - ---- > stringToExpr "cos(x^2)+4*(1+y)" ---- Just (Add (Cos (Pow (Var 'x') (Num 2.0))) (Mul (Num 4.0) (Add (Num 1.0) (Var 'y')))) - ---- Expressions can be evaluated using the function evaluateExpression. Example: - ---- Examples of evaluateExpression are as fallows. - ---- > evaluateExpression "5 - 2" [] ---- 3.0 ---- > evaluateExpression "x^2 + y" [('x',2),('y',3)] ---- 7.0 ---- > evaluateExpression "cos(x)" [('x',pi)] ---- -1.0 +-- ParserFunction provides utilities for parsing and evaluating mathematical expressions. The central parsing +-- function in this package is stringToExpr, which parses a string-expression and returns a maybe expression tree. +-- +-- EXAMPLE: +-- > stringToExpr "e^(1-x)*cos(pi*y)" +-- > Just (Mul (Pow (Var "e") (Sub (Num 1.0) (Var "x"))) (Cos (Mul (Var "pi") (Var "y")))) +-- +-- This type is suitable for performing symbolic manipulation. +-- +-- Expressions can then be evaluated using the function evalExpr. +-- +-- EXAMPLE: +-- > evalExpr ((Mul (Pow (Var "e") (Sub (Num 1.0) (Var "x"))) (Cos (Mul (Var "pi") (Var "y"))))) [("x",1),("y",0)] +-- > Just (1.0 :+ 0.0) +-- +-- If you wish to evaluate a string-expression without any intermediate operations, simply use the function evalString. +-- +-- EXAMPLE: +-- > evalString "e^(1-x)*cos(pi*y)" [("x",1),("y",0)] +-- > Just (1.0 :+ 0.0) +-- +-- EXAMPLE: +-- > evalString "e^(-pi*i)+1" [] +-- > Just (0.0 :+ (-1.2246467991473532e-16)) +-- module Text.ParserCombinators.Parsec.ParserFunction - (Expr,evaluateExpression,stringToExpr,buildExpr,expressionTable,factor,variables,number,evaluate) where + (Expr,evalString,evalExpr,stringToExpr,buildExpr,eval) where import Text.ParserCombinators.Parsec.Expr import Text.ParserCombinators.Parsec @@ -30,73 +33,83 @@ import Data.Maybe (fromMaybe) import Data.List (isInfixOf) import Data.Char (toLower) +import Data.Complex +type Variable = String + -- |The Expr data type provides a basis for ordering mathematical operations. -data Expr = Num Double | Var Char | Sub Expr Expr - | Div Expr Expr | Pow Expr Expr | Log Expr - | Abs Expr | Sqrt Expr | Cbrt Expr - | ArcSinh Expr | ArcCosh Expr | ArcTanh Expr - | ArcSin Expr | ArcCos Expr | ArcTan Expr - | Sinh Expr | Cosh Expr | Tanh Expr - | Sin Expr | Cos Expr | Tan Expr - | ArcSech Expr | ArcCsch Expr | ArcCoth Expr - | ArcSec Expr | ArcCsc Expr | ArcCot Expr - | Sech Expr | Csch Expr | Coth Expr - | Sec Expr | Csc Expr | Cot Expr - | Mul Expr Expr | Add Expr Expr | Exp Expr deriving (Show, Eq, Ord) +data Expr = + Num Double | Var String | Sub Expr Expr | + Div Expr Expr | Pow Expr Expr | Log Expr | + Abs Expr | Sqrt Expr | Cbrt Expr | + ArcSinh Expr | ArcCosh Expr | ArcTanh Expr | + ArcSin Expr | ArcCos Expr | ArcTan Expr | + Sinh Expr | Cosh Expr | Tanh Expr | + Sin Expr | Cos Expr | Tan Expr | + ArcSech Expr | ArcCsch Expr | ArcCoth Expr | + ArcSec Expr | ArcCsc Expr | ArcCot Expr | + Sech Expr | Csch Expr | Coth Expr | + Sec Expr | Csc Expr | Cot Expr | + Mul Expr Expr | Add Expr Expr | Exp Expr deriving (Show, Eq) --- |@evaluateExpression@ evaluates a mathematical expression s using the variable map m. -evaluateExpression :: String -> [(Char,Double)] -> Double -evaluateExpression s m = evaluate (M.fromAscList $ caseMap m) (fromMaybe failing $ stringToExpr s) - where - caseMap x = fmap (\ (a, b) -> ([toLower a], b)) x - failing = error "Parser error in expression" +-- |@evalExpr@ evaluates an expression tree using a list of variable definitions with values. +evalExpr :: Expr -> [(Variable,Complex Double)] -> Maybe (Complex Double) +evalExpr e m = eval (M.fromAscList $ caseMap m) (Just e) + where caseMap x = fmap (\(a,b)->(map toLower a, b)) x --- |@stringToExpr@ parses an expression and returns an expression tree of type Expr. +-- |@evalString@ evaluates a string-expression using a list of variable definitions with values. +evalString :: String -> [(Variable,Complex Double)] -> Maybe (Complex Double) +evalString s m = eval (M.fromAscList $ caseMap m) (stringToExpr s) + where caseMap x = fmap (\(a,b)->(map toLower a, b)) x + +-- |@stringToExpr@ parses a string-expression and returns a maybe expression tree. stringToExpr :: String -> Maybe Expr -stringToExpr xs = if any (==True) (symbols failingSymbols xs) - then Nothing - else either (const Nothing) (Just) (parse buildExpr "" handleString) - where - handleString = "(" ++ (map toLower $ filter (/=' ') xs) ++ ")" - symbols [] y = [] - symbols x y = [isInfixOf (head x) y] ++ (symbols (drop 1 x) y) - failingSymbols = ["^^","^*","^/","^+","^-","*^","**","*/","*+","*-", - "/^","/*","//","/+","/-","+^","+*","+/","++","+-", - "-^","-*","-/","-+","--"] +stringToExpr xs = + if null xs || any (==True) (symbols failingSymbols xs) + then Nothing + else either (const Nothing) (Just) (parse buildExpr "" handleString) + where + handleString = "(" ++ (map toLower $ filter (/=' ') xs) ++ ")" + symbols [] y = [] + symbols x y = [isInfixOf (head x) y] ++ (symbols (drop 1 x) y) + failingSymbols = [ + "^^","^*","^/","^+","^-","*^","**","*/","*+","*-", + "/^","/*","//","/+","/-","+^","+*","+/","++","+-", + "-^","-*","-/","-+","--","()"] buildExpr :: Parser Expr buildExpr = buildExpressionParser expressionTable factor expressionTable :: [[Operator Char st Expr]] -expressionTable = [[pr "arcsinh" ArcSinh, pr "arcsin" ArcSin, pr "sinh" Sinh, pr "sin" Sin], - [pr "arccosh" ArcCosh, pr "arccos" ArcCos, pr "cosh" Cosh, pr "cos" Cos], - [pr "arctanh" ArcTanh, pr "arctan" ArcTan, pr "tanh" Tanh, pr "tan" Tan], - [pr "arcsech" ArcSech, pr "arcsec" ArcSec, pr "sech" Sech, pr "sec" Sec], - [pr "arccsch" ArcCsch, pr "arccsc" ArcCsc, pr "csch" Csch, pr "csc" Csc], - [pr "arccoth" ArcCoth, pr "arccot" ArcCot, pr "coth" Coth, pr "cot" Cot], - [pr "log" Log, pr "abs" Abs,pr "exp" Exp,pr "e^" Exp], - [pr "sqrt" Sqrt, pr "cbrt" Cbrt], - [op "^" Pow AssocLeft], - [op "*" Mul AssocLeft, op "/" Div AssocLeft], - [op "+" Add AssocLeft, op "-" Sub AssocLeft]] - where - op s f assoc = Infix (do{ string s; return f}) assoc - pr s f = Prefix (try (string s) >> return f) +expressionTable = [ + [pr "arcsinh" ArcSinh, pr "arcsin" ArcSin, pr "sinh" Sinh, pr "sin" Sin], + [pr "arccosh" ArcCosh, pr "arccos" ArcCos, pr "cosh" Cosh, pr "cos" Cos], + [pr "arctanh" ArcTanh, pr "arctan" ArcTan, pr "tanh" Tanh, pr "tan" Tan], + [pr "arcsech" ArcSech, pr "arcsec" ArcSec, pr "sech" Sech, pr "sec" Sec], + [pr "arccsch" ArcCsch, pr "arccsc" ArcCsc, pr "csch" Csch, pr "csc" Csc], + [pr "arccoth" ArcCoth, pr "arccot" ArcCot, pr "coth" Coth, pr "cot" Cot], + [pr "log" Log, pr "abs" Abs,pr "exp" Exp], + [pr "sqrt" Sqrt, pr "cbrt" Cbrt], + [op "^" Pow AssocRight], + [op "*" Mul AssocLeft, op "/" Div AssocLeft], + [op "+" Add AssocLeft, op "-" Sub AssocLeft]] + where + op s f assoc = Infix (do{ string s; return f}) assoc + pr s f = Prefix (try (string s) >> return f) factor :: Parser Expr factor = do - char '(' - e <- buildExpr - char ')' - return e - <|> variables + char '(' + e <- buildExpr + char ')' + return e + <|> variables variables :: Parser Expr variables = do - ds <- letter - return $ Var ds - <|> number + ds <- many1 letter + return $ Var ds + <|> number number :: Parser Expr number = do @@ -112,45 +125,54 @@ fe = toInteger . fromEnum ch2num = (subtract $ fe '0') . fe --- |@evaluate@ takes a map and expression tree to produce a numerical value. -evaluate :: M.Map String Double -> Expr -> Double -evaluate m expr = - case expr of - (Num d) -> d - (Var c) -> fromMaybe (failing c) (M.lookup [c] m) - (Add expr1 expr2) -> (evaluate m expr1) + (evaluate m expr2) - (Sub expr1 expr2) -> (evaluate m expr1) - (evaluate m expr2) - (Mul expr1 expr2) -> (evaluate m expr1) * (evaluate m expr2) - (Div expr1 expr2) -> (evaluate m expr1) / (evaluate m expr2) - (Pow expr1 expr2) -> (evaluate m expr1) ** (evaluate m expr2) - (Exp expr1) -> exp (evaluate m expr1) - (Sqrt expr1) -> (evaluate m expr1) ** (0.5) - (Cbrt expr1) -> (evaluate m expr1) ** (1/3) - (Log expr1) -> log (evaluate m expr1) - (Abs expr1) -> abs (evaluate m expr1) - (Sin expr1) -> sin (evaluate m expr1) - (Cos expr1) -> cos (evaluate m expr1) - (Tan expr1) -> tan (evaluate m expr1) - (Sec expr1) -> 1/sin (evaluate m expr1) - (Csc expr1) -> 1/cos (evaluate m expr1) - (Cot expr1) -> 1/tan (evaluate m expr1) - (Sinh expr1) -> sinh (evaluate m expr1) - (Cosh expr1) -> cosh (evaluate m expr1) - (Tanh expr1) -> tanh (evaluate m expr1) - (Sech expr1) -> 1/sinh (evaluate m expr1) - (Csch expr1) -> 1/cosh (evaluate m expr1) - (Coth expr1) -> 1/tanh (evaluate m expr1) - (ArcSin expr1) -> asin (evaluate m expr1) - (ArcCos expr1) -> acos (evaluate m expr1) - (ArcTan expr1) -> atan (evaluate m expr1) - (ArcSec expr1) -> 1/asin (evaluate m expr1) - (ArcCsc expr1) -> 1/acos (evaluate m expr1) - (ArcCot expr1) -> 1/atan (evaluate m expr1) - (ArcSinh expr1) -> asinh (evaluate m expr1) - (ArcCosh expr1) -> acosh (evaluate m expr1) - (ArcTanh expr1) -> atanh (evaluate m expr1) - (ArcSech expr1) -> 1/asinh (evaluate m expr1) - (ArcCsch expr1) -> 1/acosh (evaluate m expr1) - (ArcCoth expr1) -> 1/atanh (evaluate m expr1) +-- |@eval@ takes a map of variable definitions and values, and a maybe expression tree, to produce maybe a numerical value. +eval :: M.Map Variable (Complex Double) -> Maybe Expr -> Maybe (Complex Double) +eval m expr = + case expr of + Just (Num d) -> Just $ d :+ 0 + Just (Var "pi") -> Just $ pi + Just (Var "i") -> Just $ 0 :+ 1 + Just (Var "e") -> Just $ exp 1 + Just (Var c) -> M.lookup c m + Just (Add e1 e2) -> factorMaybe2 (eval m $ Just e1) (eval m $ Just e2) (+) + Just (Sub e1 e2) -> factorMaybe2 (eval m $ Just e1) (eval m $ Just e2) (-) + Just (Mul e1 e2) -> factorMaybe2 (eval m $ Just e1) (eval m $ Just e2) (*) + Just (Div e1 e2) -> factorMaybe2 (eval m $ Just e1) (eval m $ Just e2) (/) + Just (Pow e1 e2) -> factorMaybe2 (eval m $ Just e1) (eval m $ Just e2) (**) + Just (Exp e1) -> factorMaybe1 (eval m $ Just e1) (exp) + Just (Sqrt e1) -> factorMaybe1 (eval m $ Just e1) (\x->x**(0.5)) + Just (Cbrt e1) -> factorMaybe1 (eval m $ Just e1) (\x->x**(1/3)) + Just (Log e1) -> factorMaybe1 (eval m $ Just e1) (log) + Just (Abs e1) -> factorMaybe1 (eval m $ Just e1) (abs) + Just (Sin e1) -> factorMaybe1 (eval m $ Just e1) (sin) + Just (Cos e1) -> factorMaybe1 (eval m $ Just e1) (cos) + Just (Tan e1) -> factorMaybe1 (eval m $ Just e1) (tan) + Just (Sec e1) -> factorMaybe1 (eval m $ Just e1) (\x->1/sin x) + Just (Csc e1) -> factorMaybe1 (eval m $ Just e1) (\x->1/cos x) + Just (Cot e1) -> factorMaybe1 (eval m $ Just e1) (\x->1/tan x) + Just (Sinh e1) -> factorMaybe1 (eval m $ Just e1) (sinh) + Just (Cosh e1) -> factorMaybe1 (eval m $ Just e1) (cosh) + Just (Tanh e1) -> factorMaybe1 (eval m $ Just e1) (tanh) + Just (Sech e1) -> factorMaybe1 (eval m $ Just e1) (\x->1/sinh x) + Just (Csch e1) -> factorMaybe1 (eval m $ Just e1) (\x->1/cosh x) + Just (Coth e1) -> factorMaybe1 (eval m $ Just e1) (\x->1/tanh x) + Just (ArcSin e1) -> factorMaybe1 (eval m $ Just e1) (asin) + Just (ArcCos e1) -> factorMaybe1 (eval m $ Just e1) (acos) + Just (ArcTan e1) -> factorMaybe1 (eval m $ Just e1) (atan) + Just (ArcSec e1) -> factorMaybe1 (eval m $ Just e1) (\x->1/asin x) + Just (ArcCsc e1) -> factorMaybe1 (eval m $ Just e1) (\x->1/acos x) + Just (ArcCot e1) -> factorMaybe1 (eval m $ Just e1) (\x->1/atan x) + Just (ArcSinh e1) -> factorMaybe1 (eval m $ Just e1) (asinh) + Just (ArcCosh e1) -> factorMaybe1 (eval m $ Just e1) (acosh) + Just (ArcTanh e1) -> factorMaybe1 (eval m $ Just e1) (atanh) + Just (ArcSech e1) -> factorMaybe1 (eval m $ Just e1) (\x->1/asinh x) + Just (ArcCsch e1) -> factorMaybe1 (eval m $ Just e1) (\x->1/acosh x) + Just (ArcCoth e1) -> factorMaybe1 (eval m $ Just e1) (\x->1/atanh x) + _ -> Nothing where - failing x = error $ "M.lookup error in value for variable `" ++ [x] ++ "'" + factorMaybe1 :: Maybe a -> (a -> a) -> Maybe a + factorMaybe1 (Just x) f = Just $ f x + factorMaybe1 _ _ = Nothing + factorMaybe2 :: Maybe a -> Maybe a -> (a -> a -> a) -> Maybe a + factorMaybe2 (Just x) (Just y) f = Just $ f x y + factorMaybe2 _ _ _ = Nothing