ParserFunction 0.0.8 → 0.1.0
raw patch · 7 files changed
+220/−230 lines, 7 filesdep ~basesetup-changedPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
- Text.ParserCombinators.Parsec.ParserFunction: buildExpr :: Parser Expr
- Text.ParserCombinators.Parsec.ParserFunction: data Expr
- Text.ParserCombinators.Parsec.ParserFunction: eval :: Map Variable (Complex Double) -> Maybe Expr -> Maybe (Complex Double)
- Text.ParserCombinators.Parsec.ParserFunction: evalExpr :: Expr -> [(Variable, Complex Double)] -> Maybe (Complex Double)
- Text.ParserCombinators.Parsec.ParserFunction: evalString :: String -> [(Variable, Complex Double)] -> Maybe (Complex Double)
- Text.ParserCombinators.Parsec.ParserFunction: instance Eq Expr
- Text.ParserCombinators.Parsec.ParserFunction: instance Show Expr
- Text.ParserCombinators.Parsec.ParserFunction: stringToExpr :: String -> Maybe Expr
- Text.ParserCombinators.Parsec.ParserFunction: type Variable = String
+ Text.Parsec.Expr.Math: Abs :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Add :: (Expr a) -> (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: ArcCos :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: ArcCosh :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: ArcCot :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: ArcCoth :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: ArcCsc :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: ArcCsch :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: ArcSec :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: ArcSech :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: ArcSin :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: ArcSinh :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: ArcTan :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: ArcTanh :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Cos :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Cosh :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Cot :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Coth :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Csc :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Csch :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Div :: (Expr a) -> (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Exp :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Log :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Mul :: (Expr a) -> (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Neg :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Num :: a -> Expr a
+ Text.Parsec.Expr.Math: Pow :: (Expr a) -> (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Sec :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Sech :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Sin :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Sinh :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Sqrt :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Sub :: (Expr a) -> (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Tan :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Tanh :: (Expr a) -> Expr a
+ Text.Parsec.Expr.Math: Var :: String -> Expr a
+ Text.Parsec.Expr.Math: data Expr a
+ Text.Parsec.Expr.Math: data ParseError :: *
+ Text.Parsec.Expr.Math: evaluate :: Floating a => Map String a -> Maybe (Expr a) -> Maybe a
+ Text.Parsec.Expr.Math: instance Show a => Show (Expr a)
+ Text.Parsec.Expr.Math: parse :: Floating a => String -> Either ParseError (Expr a)
Files
- LICENSE +25/−7
- LICENSE~ +0/−7
- ParserFunction.cabal +19/−20
- ParserFunction.cabal~ +0/−22
- Setup.hs +1/−2
- Text/ParserCombinators/Parsec/ParserFunction.hs +0/−172
- src/Text/Parsec/Expr/Math.hs +175/−0
LICENSE view
@@ -1,7 +1,25 @@-Copyright (c) 2012 Enzo Haussecker--Permission is hereby granted, free of charge, to any person obtaining this work and associated documentation files (the "Work"), to deal in the Work without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Work, and to permit persons to whom the Work is furnished to do so, subject to the following conditions:--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 WORK OR THE USE OR OTHER DEALINGS IN THE WORK.+Copyright (c) 2014, Enzo Haussecker. All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +- Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +- Neither the names of the copyright owners nor the names of the + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
− LICENSE~
@@ -1,7 +0,0 @@-Copyright (c) 2011 Enzo Haussecker--Permission is hereby granted, free of charge, to any person obtaining this work and associated documentation files (the "Work"), to deal in the Work without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Work, and to permit persons to whom the Work is furnished to do so, subject to the following conditions:--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 WORK OR THE USE OR OTHER DEALINGS IN THE WORK.
ParserFunction.cabal view
@@ -1,22 +1,21 @@-name: ParserFunction-version: 0.0.8-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 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.+Name: ParserFunction+Version: 0.1.0+License: BSD3+License-File: LICENSE+Copyright: Copyright (c) 2014, Enzo Haussecker. All rights reserved.+Author: Enzo Haussecker <enzo@ucsd.edu>+Maintainer: Enzo Haussecker <enzo@ucsd.edu>+Stability: Experimental+Category: Math, Parsing+Synopsis: Parse and evaluate mathematical expressions.+Build-Type: Simple+Cabal-Version: >= 1.16.0+Description: Parse and evaluate mathematical expressions. Library- exposed-modules: Text.ParserCombinators.Parsec.ParserFunction- build-depends: base < 6, parsec, containers+ Default-Language: Haskell2010+ HS-Source-Dirs: src+ Exposed-Modules: Text.Parsec.Expr.Math+ Build-Depends: base >= 4 && < 5,+ containers,+ parsec
− ParserFunction.cabal~
@@ -1,22 +0,0 @@-name: ParserFunction-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 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
Setup.hs view
@@ -1,7 +1,6 @@ module Main (main) where -import Distribution.Simple+import Distribution.Simple (defaultMain) main :: IO () main = defaultMain-
− Text/ParserCombinators/Parsec/ParserFunction.hs
@@ -1,172 +0,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,Variable,evalString,evalExpr,stringToExpr,buildExpr,eval) where--import Control.Monad (liftM,liftM2)-import Text.ParserCombinators.Parsec.Expr -import Text.ParserCombinators.Parsec-import qualified Data.Map as M-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 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)---- |@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---- |@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 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 "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--variables :: Parser Expr-variables = do- ds <- many1 letter- return $ Var ds- <|> number--number :: Parser Expr-number = do- br <- many digit- let d :: Double- d = fromInteger (foldl ((. ch2num) . (+) . (*10)) 0 br)- option (Num (d)) (try (do- char '.'- ar <- many1 digit- return $ (Num (d + foldr (fd) 0 ar)) ))- where- fd a b = (fromInteger (ch2num a) + b) / 10- fe = toInteger . fromEnum- ch2num = (subtract $ fe '0') . fe---- |@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) -> liftM2 (+) (eval m $ Just e1) (eval m $ Just e2)- Just (Sub e1 e2) -> liftM2 (-) (eval m $ Just e1) (eval m $ Just e2)- Just (Mul e1 e2) -> liftM2 (*) (eval m $ Just e1) (eval m $ Just e2)- Just (Div e1 e2) -> liftM2 (/) (eval m $ Just e1) (eval m $ Just e2)- Just (Pow e1 e2) -> liftM2 (**) (eval m $ Just e1) (eval m $ Just e2)- Just (Exp e1) -> liftM (exp) (eval m $ Just e1)- Just (Sqrt e1) -> liftM (\x->x**(0.5)) (eval m $ Just e1)- Just (Cbrt e1) -> liftM (\x->x**(1/3)) (eval m $ Just e1)- Just (Log e1) -> liftM (log) (eval m $ Just e1)- Just (Abs e1) -> liftM (abs) (eval m $ Just e1)- Just (Sin e1) -> liftM (sin) (eval m $ Just e1)- Just (Cos e1) -> liftM (cos) (eval m $ Just e1)- Just (Tan e1) -> liftM (tan) (eval m $ Just e1)- Just (Sec e1) -> liftM (\x->1/sin x) (eval m $ Just e1)- Just (Csc e1) -> liftM (\x->1/cos x) (eval m $ Just e1)- Just (Cot e1) -> liftM (\x->1/tan x) (eval m $ Just e1)- Just (Sinh e1) -> liftM (sinh) (eval m $ Just e1)- Just (Cosh e1) -> liftM (cosh) (eval m $ Just e1)- Just (Tanh e1) -> liftM (tanh) (eval m $ Just e1)- Just (Sech e1) -> liftM (\x->1/sinh x) (eval m $ Just e1)- Just (Csch e1) -> liftM (\x->1/cosh x) (eval m $ Just e1)- Just (Coth e1) -> liftM (\x->1/tanh x) (eval m $ Just e1)- Just (ArcSin e1) -> liftM (asin) (eval m $ Just e1)- Just (ArcCos e1) -> liftM (acos) (eval m $ Just e1)- Just (ArcTan e1) -> liftM (atan) (eval m $ Just e1)- Just (ArcSec e1) -> liftM (\x->1/asin x) (eval m $ Just e1)- Just (ArcCsc e1) -> liftM (\x->1/acos x) (eval m $ Just e1)- Just (ArcCot e1) -> liftM (\x->1/atan x) (eval m $ Just e1)- Just (ArcSinh e1) -> liftM (asinh) (eval m $ Just e1)- Just (ArcCosh e1) -> liftM (acosh) (eval m $ Just e1)- Just (ArcTanh e1) -> liftM (atanh) (eval m $ Just e1)- Just (ArcSech e1) -> liftM (\x->1/asinh x) (eval m $ Just e1)- Just (ArcCsch e1) -> liftM (\x->1/acosh x) (eval m $ Just e1)- Just (ArcCoth e1) -> liftM (\x->1/atanh x) (eval m $ Just e1)- _ -> Nothing
+ src/Text/Parsec/Expr/Math.hs view
@@ -0,0 +1,175 @@+---------------------------------------------------------------+-- Copyright (c) 2014, Enzo Haussecker. All rights reserved. --+---------------------------------------------------------------++{-# LANGUAGE LambdaCase #-}+{-# OPTIONS -Wall #-}++-- | Parse and evaluate mathematical expressions.+module Text.Parsec.Expr.Math (++ -- ** Expressions+ Expr(..)++ -- ** Parsing+ , parse+ , P.ParseError++ -- ** Evaluation+ , evaluate++ ) where++import Control.Applicative ((<|>))+import Control.Monad (liftM, liftM2)++import qualified Data.Map as M+import qualified Text.ParserCombinators.Parsec.Expr as P+import qualified Text.ParserCombinators.Parsec as P++-- | Mathematical expressions.+data Expr a = Num a+ | Var String+ | Neg (Expr a)+ | Add (Expr a) (Expr a)+ | Sub (Expr a) (Expr a)+ | Mul (Expr a) (Expr a)+ | Div (Expr a) (Expr a)+ | Pow (Expr a) (Expr a)+ | Sqrt (Expr a)+ | Exp (Expr a)+ | Log (Expr a)+ | Abs (Expr a)+ | Sin (Expr a)+ | Cos (Expr a)+ | Tan (Expr a)+ | Sec (Expr a)+ | Csc (Expr a)+ | Cot (Expr a)+ | Sinh (Expr a)+ | Cosh (Expr a)+ | Tanh (Expr a)+ | Sech (Expr a)+ | Csch (Expr a)+ | Coth (Expr a)+ | ArcSin (Expr a)+ | ArcCos (Expr a)+ | ArcTan (Expr a)+ | ArcSec (Expr a)+ | ArcCsc (Expr a)+ | ArcCot (Expr a)+ | ArcSinh (Expr a)+ | ArcCosh (Expr a)+ | ArcTanh (Expr a)+ | ArcSech (Expr a)+ | ArcCsch (Expr a)+ | ArcCoth (Expr a) deriving Show++-- | Parse a mathematical expression.+--+-- > >>> parse "exp(-pi*i)+1"+-- > Right (Add (Exp (Mul (Neg (Var "pi")) (Var "i"))) (Num 1.0))+--+parse :: Floating a => String -> Either P.ParseError (Expr a)+parse = P.parse build "" . (:) '(' . flip (++) ")" . filter (/=' ')++build :: Floating a => P.Parser (Expr a)+build = P.buildExpressionParser table factor++table :: Floating a => [[P.Operator Char st (Expr a)]]+table =+ [ [ prefix "arcsinh" ArcSinh, prefix "arcsin" ArcSin, prefix "sinh" Sinh, prefix "sin" Sin ]+ , [ prefix "arccosh" ArcCosh, prefix "arccos" ArcCos, prefix "cosh" Cosh, prefix "cos" Cos ]+ , [ prefix "arctanh" ArcTanh, prefix "arctan" ArcTan, prefix "tanh" Tanh, prefix "tan" Tan ]+ , [ prefix "arcsech" ArcSech, prefix "arcsec" ArcSec, prefix "sech" Sech, prefix "sec" Sec ]+ , [ prefix "arccsch" ArcCsch, prefix "arccsc" ArcCsc, prefix "csch" Csch, prefix "csc" Csc ]+ , [ prefix "arccoth" ArcCoth, prefix "arccot" ArcCot, prefix "coth" Coth, prefix "cot" Cot ]+ , [ prefix "abs" Abs ]+ , [ prefix "exp" Exp ]+ , [ prefix "sqrt" Sqrt ]+ , [ prefix "log" Log ]+ , [ binary "^" Pow P.AssocRight ]+ , [ prefix "-" Neg ]+ , [ binary "*" Mul P.AssocLeft, binary "/" Div P.AssocLeft ]+ , [ binary "+" Add P.AssocLeft, binary "-" Sub P.AssocLeft ]+ ] where binary s f a = P.Infix ( P.string s >> return f) a+ prefix s f = P.Prefix (P.try (P.string s) >> return f)++factor :: Floating a => P.Parser (Expr a)+factor = do+ _ <- P.char '('+ expr <- build+ _ <- P.char ')'+ return $! expr+ <|> variable++variable :: Floating a => P.Parser (Expr a)+variable = do+ var <- P.many1 P.letter+ return $! Var var+ <|> number++number :: Floating a => P.Parser (Expr a)+number = do+ pr <- P.many1 P.digit+ let n = foldl stl 0 pr+ P.option (Num n) . P.try $ do+ _ <- P.char '.'+ su <- P.many1 P.digit+ return $! Num $ n + foldr str 0 su+ where stl a x = (ctn x - ctn '0') + a * 10+ str x a = (ctn x - ctn '0' + a) / 10+ ctn = realToFrac . fromEnum++-- | Evaluate a mathematical expression+-- using the supplied variable definitions.+--+-- > >>> :m + Data.Complex Data.Map+-- > >>> let def = fromList [("pi", pi), ("i", 0 :+ 1)]+-- > >>> evaluate def . Just $ Add (Exp (Mul (Neg (Var "pi")) (Var "i"))) (Num 1.0)+-- > Just (0.0 :+ (-1.2246467991473532e-16))+--+evaluate+ :: Floating a+ => M.Map String a -- ^ Variable definitions.+ -> Maybe (Expr a) -- ^ Mathematical expression.+ -> Maybe a+evaluate def = \ case+ Just (Num num) -> Just num+ Just (Var var) -> M.lookup var def+ Just (Neg e1) -> liftM (negate ) (evaluate def $ Just e1)+ Just (Add e1 e2) -> liftM2 (+ ) (evaluate def $ Just e1) (evaluate def $ Just e2)+ Just (Sub e1 e2) -> liftM2 (- ) (evaluate def $ Just e1) (evaluate def $ Just e2)+ Just (Mul e1 e2) -> liftM2 (* ) (evaluate def $ Just e1) (evaluate def $ Just e2)+ Just (Div e1 e2) -> liftM2 (/ ) (evaluate def $ Just e1) (evaluate def $ Just e2)+ Just (Pow e1 e2) -> liftM2 (** ) (evaluate def $ Just e1) (evaluate def $ Just e2)+ Just (Sqrt e1) -> liftM (** 0.5 ) (evaluate def $ Just e1)+ Just (Exp e1) -> liftM (exp ) (evaluate def $ Just e1)+ Just (Log e1) -> liftM (log ) (evaluate def $ Just e1)+ Just (Abs e1) -> liftM (abs ) (evaluate def $ Just e1)+ Just (Sin e1) -> liftM (sin ) (evaluate def $ Just e1)+ Just (Cos e1) -> liftM (cos ) (evaluate def $ Just e1)+ Just (Tan e1) -> liftM (tan ) (evaluate def $ Just e1)+ Just (Sec e1) -> liftM (inv . sin ) (evaluate def $ Just e1)+ Just (Csc e1) -> liftM (inv . cos ) (evaluate def $ Just e1)+ Just (Cot e1) -> liftM (inv . tan ) (evaluate def $ Just e1)+ Just (Sinh e1) -> liftM (sinh ) (evaluate def $ Just e1)+ Just (Cosh e1) -> liftM (cosh ) (evaluate def $ Just e1)+ Just (Tanh e1) -> liftM (tanh ) (evaluate def $ Just e1)+ Just (Sech e1) -> liftM (inv . sinh ) (evaluate def $ Just e1)+ Just (Csch e1) -> liftM (inv . cosh ) (evaluate def $ Just e1)+ Just (Coth e1) -> liftM (inv . tanh ) (evaluate def $ Just e1)+ Just (ArcSin e1) -> liftM (asin ) (evaluate def $ Just e1)+ Just (ArcCos e1) -> liftM (acos ) (evaluate def $ Just e1)+ Just (ArcTan e1) -> liftM (atan ) (evaluate def $ Just e1)+ Just (ArcSec e1) -> liftM (inv . asin ) (evaluate def $ Just e1)+ Just (ArcCsc e1) -> liftM (inv . acos ) (evaluate def $ Just e1)+ Just (ArcCot e1) -> liftM (inv . atan ) (evaluate def $ Just e1)+ Just (ArcSinh e1) -> liftM (asinh ) (evaluate def $ Just e1)+ Just (ArcCosh e1) -> liftM (acosh ) (evaluate def $ Just e1)+ Just (ArcTanh e1) -> liftM (atanh ) (evaluate def $ Just e1)+ Just (ArcSech e1) -> liftM (inv . asinh) (evaluate def $ Just e1)+ Just (ArcCsch e1) -> liftM (inv . acosh) (evaluate def $ Just e1)+ Just (ArcCoth e1) -> liftM (inv . atanh) (evaluate def $ Just e1)+ _ -> Nothing+ where inv = (/) 1