diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -4,4 +4,4 @@ The above copyright notice and this permission notice shall be included in all copies of the Work. -THE WORK IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +THE WORK IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE WORK OR THE USE OR OTHER DEALINGS IN THE WORK. diff --git a/ParserFunction.cabal b/ParserFunction.cabal --- a/ParserFunction.cabal +++ b/ParserFunction.cabal @@ -1,19 +1,21 @@ Name: ParserFunction -Version: 0.0.1 +Version: 0.0.2 License: BSD3 License-file: LICENSE Author: Enzo Haussecker Maintainer: Enzo Haussecker -Description: Enzo Haussecker's algorithm for parsing functions. Synopsis: Enzo Haussecker's algorithm for parsing functions. -category: Parsing -Build-Depends: base, parsec -stability: provisional +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. +Build-Depends: base, parsec, containers +stability: Provisional +Category: Parsing build-type: Simple cabal-version: >= 1.2 tested-with: GHC ==6.8.2 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 new file mode 100644 --- /dev/null +++ b/Text/ParserCombinators/Parsec/EvaluateFunction.hs @@ -0,0 +1,71 @@ +-- 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 new file mode 100644 --- /dev/null +++ b/Text/ParserCombinators/Parsec/Functions.hs @@ -0,0 +1,14 @@ +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 @@ -7,32 +7,27 @@ -- -- > 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"))))) - - +-- module Text.ParserCombinators.Parsec.ParserFunction (functionParse) where import Data.Char (toLower) +import Data.List (isInfixOf) import Text.ParserCombinators.Parsec -import Text.ParserCombinators.Parsec.Expr - -data Expr = Num Double | Var String | Sub Expr Expr - | Div Expr Expr | Exp 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 deriving (Show, Eq, Ord) +import Text.ParserCombinators.Parsec.Expr +import Text.ParserCombinators.Parsec.Functions functionParse :: String -> Maybe Expr -functionParse xs = either (const Nothing) (Just) (parse getFunction "" handleString) +functionParse xs = if any (==True) (symbols failingSymbols xs) + then Nothing + else either (const Nothing) (Just) (parse getFunction "" handleString) where - handleString = "(" ++ (map toLower $ filter (/=' ') xs) ++ ")" + handleString = "(" ++ (map toLower $ filter (/=' ') xs) ++ ")" + symbols [] y = [] + symbols x y = [isInfixOf (head x) y] ++ (symbols (drop 1 x) y) + failingSymbols = ["^^","^*","^/","^+","^-","*^","**","*/","*+","*-", + "/^","/*","//","/+","/-","+^","+*","+/","++","+-", + "-^","-*","-/","-+","--"] getFunction :: Parser Expr getFunction = buildExpressionParser expressionTable factor @@ -44,9 +39,9 @@ [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 "log" Log, pr "abs" Abs,pr "exp" Exp], [pr "sqrt" Sqrt, pr "cbrt" Cbrt], - [op "^" Exp AssocLeft], + [op "^" Pow AssocLeft], [op "*" Mul AssocLeft, op "/" Div AssocLeft], [op "+" Add AssocLeft, op "-" Sub AssocLeft]] where @@ -63,11 +58,8 @@ variables :: Parser Expr variables = do - ds <- many1 letter - return $ - case ds of - ds | (length ds) == 1 -> Var ds - ds -> error $ "parser error on `" ++ ds ++ "'" + ds <- letter + return $ Var ds <|> number number :: Parser Expr