ParserFunction 0.0.6 → 0.0.7

raw patch · 2 files changed

+148/−129 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ParserFunction.cabal +11/−14
• Text/ParserCombinators/Parsec/ParserFunction.hs +137/−115

@@ -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

@@ -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