diff --git a/ParserFunction.cabal b/ParserFunction.cabal --- a/ParserFunction.cabal +++ b/ParserFunction.cabal @@ -1,13 +1,12 @@ Name: ParserFunction -Version: 0.0.2 +Version: 0.0.3 License: BSD3 License-file: LICENSE Author: Enzo Haussecker -Maintainer: Enzo Haussecker -Synopsis: Enzo Haussecker's algorithm for parsing functions. -Description: The centerpiece of this package is a function called "evaluate" (exported from Text.ParserCombinators.Parsec.EvaluateFunction), which parses a function (in the form of a string) and evaluates it at a given point. Examples of this function can be found by viewing the source code for this module. +Synopsis: An algorithm for parsing Expressions. +Description: The centerpiece of this package is a function called "expressionToDouble", which parses an expression (in the form of a string) and returns a Double. Examples of this function can be found by viewing the source code for this module. Build-Depends: base, parsec, containers -stability: Provisional +stability: Stable Category: Parsing build-type: Simple cabal-version: >= 1.2 @@ -15,7 +14,5 @@ Exposed-modules: Text.ParserCombinators.Parsec.ParserFunction - Text.ParserCombinators.Parsec.EvaluateFunction - Text.ParserCombinators.Parsec.Functions diff --git a/Text/ParserCombinators/Parsec/EvaluateFunction.hs b/Text/ParserCombinators/Parsec/EvaluateFunction.hs deleted file mode 100644 --- a/Text/ParserCombinators/Parsec/EvaluateFunction.hs +++ /dev/null @@ -1,71 +0,0 @@ --- This module has been written by Enzo Haussecker --- --- Evaluating Expressions/Functions --- --- > evaluate "(abs (-1) + cos 0)^3" [] --- 8.0 --- --- > evaluate "x^2" [('x',3)] --- 9.0 --- --- > evaluate "x+y" [('x',1),('y',4)] --- 5.0 - -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) diff --git a/Text/ParserCombinators/Parsec/Functions.hs b/Text/ParserCombinators/Parsec/Functions.hs deleted file mode 100644 --- a/Text/ParserCombinators/Parsec/Functions.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Text.ParserCombinators.Parsec.Functions where - -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) 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,26 +1,56 @@ --- This module has been written by Enzo Haussecker --- --- Parsing Examples: --- --- > functionParse "(x+1)^2" --- Just (Exp (Add (Var "x") (Num 1.0)) (Num 2.0)) --- --- > functionParse "e^x*(cos(5*x) - 3*sin x)" --- Just (Mul (Exp (Var "e") (Var "x")) (Sub (Cos (Mul (Num 5.0) (Var "x"))) (Mul (Num 3.0) (Sin (Var "x"))))) --- +--- ParserFunction +--- by Enzo Haussecker + +--- The centerpiece of this module is a function called: expressionToDouble, +--- which parses an expression (in the form of a string) and returns a Double. + +--- You must declare all variables in the expression! + +--- Examples are as fallows. + +--- > expressionToDouble "5 - 2" [] +--- 3.0 + + +--- > expressionToDouble "x^2 + y" [('x',2),('y',3)] +--- 7.0 + +--- > expressionToDouble "cos(x)" [('x',pi)] +--- -1.0 + module Text.ParserCombinators.Parsec.ParserFunction - (functionParse) where + (expressionToDouble) where -import Data.Char (toLower) -import Data.List (isInfixOf) -import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Expr -import Text.ParserCombinators.Parsec.Functions +import Text.ParserCombinators.Parsec +import qualified Data.Map as M +import Data.Maybe (fromMaybe) +import Data.List (isInfixOf) +import Data.Char (toLower) -functionParse :: String -> Maybe Expr -functionParse xs = if any (==True) (symbols failingSymbols xs) - then Nothing - else either (const Nothing) (Just) (parse getFunction "" handleString) +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) + +expressionToDouble :: String -> [(Char,Double)] -> Double +expressionToDouble s m = eval (M.fromAscList $ caseMap m) (fromMaybe failing $ stringToExpr s) + where + caseMap x = fmap (\ (a, b) -> ([toLower a], b)) x + failing = error "Parser error in expression" + +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 = [] @@ -29,8 +59,8 @@ "/^","/*","//","/+","/-","+^","+*","+/","++","+-", "-^","-*","-/","-+","--"] -getFunction :: Parser Expr -getFunction = buildExpressionParser expressionTable factor +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], @@ -39,7 +69,7 @@ [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 "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], @@ -51,7 +81,7 @@ factor :: Parser Expr factor = do char '(' - e <- getFunction + e <- buildExpr char ')' return e <|> variables @@ -75,3 +105,45 @@ fd a b = (fromInteger (ch2num a) + b) / 10 fe = toInteger . fromEnum ch2num = (subtract $ fe '0') . fe + +eval :: M.Map String Double -> Expr -> Double +eval m expr = + case expr of + (Num d) -> d + (Var c) -> fromMaybe (failing c) (M.lookup [c] m) + (Add expr1 expr2) -> (eval m expr1) + (eval m expr2) + (Sub expr1 expr2) -> (eval m expr1) - (eval m expr2) + (Mul expr1 expr2) -> (eval m expr1) * (eval m expr2) + (Div expr1 expr2) -> (eval m expr1) / (eval m expr2) + (Pow expr1 expr2) -> (eval m expr1) ** (eval m expr2) + (Exp expr1) -> exp (eval m expr1) + (Sqrt expr1) -> (eval m expr1) ** (0.5) + (Cbrt expr1) -> (eval m expr1) ** (1/3) + (Log expr1) -> log (eval m expr1) + (Abs expr1) -> abs (eval m expr1) + (Sin expr1) -> sin (eval m expr1) + (Cos expr1) -> cos (eval m expr1) + (Tan expr1) -> tan (eval m expr1) + (Sec expr1) -> 1/sin (eval m expr1) + (Csc expr1) -> 1/cos (eval m expr1) + (Cot expr1) -> 1/tan (eval m expr1) + (Sinh expr1) -> sinh (eval m expr1) + (Cosh expr1) -> cosh (eval m expr1) + (Tanh expr1) -> tanh (eval m expr1) + (Sech expr1) -> 1/sinh (eval m expr1) + (Csch expr1) -> 1/cosh (eval m expr1) + (Coth expr1) -> 1/tanh (eval m expr1) + (ArcSin expr1) -> asin (eval m expr1) + (ArcCos expr1) -> acos (eval m expr1) + (ArcTan expr1) -> atan (eval m expr1) + (ArcSec expr1) -> 1/asin (eval m expr1) + (ArcCsc expr1) -> 1/acos (eval m expr1) + (ArcCot expr1) -> 1/atan (eval m expr1) + (ArcSinh expr1) -> asinh (eval m expr1) + (ArcCosh expr1) -> acosh (eval m expr1) + (ArcTanh expr1) -> atanh (eval m expr1) + (ArcSech expr1) -> 1/asinh (eval m expr1) + (ArcCsch expr1) -> 1/acosh (eval m expr1) + (ArcCoth expr1) -> 1/atanh (eval m expr1) + where + failing x = error $ "M.lookup error in value for variable `" ++ [x] ++ "'"