prop_readShow does not work

Author: matteB10

Labb4MB.hs

@@ -1,101 +1,222 @@
+module GraphCalc where 
+
 import Test.QuickCheck
 import Parsing
 import Data.Maybe
 import Data.Char
 import Data.List
 import Control.Monad
 
+  
+data Expr = Num Double 
+  | MonoOp MonoFunc Expr 
+  | BinOp BinFunc Expr Expr
+  | Var
+  deriving (Eq, Show)
+
+data MonoFunc = Sin | Cos
+ deriving (Eq, Show)
 
-data Expr = Num Double                              
-            | Var Char                                   
-            | BinOp String (Double -> Double -> Double) Expr Expr 
-            | MonoOp String (Double -> Double) Expr   
+data BinFunc = Add | Mul
+ deriving (Eq, Show) 
 
 
-instance Show Expr
-    where show = showExpr
+--instance Show Expr
+  --  where show = showExpr
+
+instance Arbitrary Expr where
+   arbitrary = sized arbExpr
 
 showExpr :: Expr -> String
-showExpr (Num n)                     = show n 
-showExpr (Var _)                     = "x"
-showExpr (MonoOp name _ expr)        = name ++ " " ++ case expr of
-                        (Num n) -> showExpr expr
-                        (Var _) -> showExpr expr
-                        _       -> " (" ++ showExpr expr ++ ") " 
-showExpr (BinOp name _ expr1 expr2)  = case name of
-    "*" -> showFactor expr1 ++ " " ++ name ++ " " ++ showFactor expr2
-    "+" -> showExpr expr1 ++ " " ++ name ++ " " ++ showExpr expr2
-    where 
-      showFactor (BinOp "+" _ expr1 expr2) = "(" ++ showExpr (add expr1 expr2) ++ ")"
-      showFactor expr                      = showExpr expr
+showExpr (Num n)                 = show n 
+showExpr Var                     = "x"
+showExpr (BinOp Mul e1 e2)       = showFactor e1 ++ " * " ++ showFactor e2
+showExpr (BinOp Add e1 e2)       = showExpr e1 ++ " + " ++ showExpr e2
+showExpr (MonoOp Sin e)          = "sin "  ++ showArg e
+showExpr (MonoOp Cos e)          = "cos " ++ showArg e
+
+showFactor (BinOp Add e1 e2)     = "(" ++ showExpr (add e1 e2) ++ ")"
+showFactor e                     = showExpr e                  
+showArg (BinOp op e1 e2)         = "(" ++ showExpr (BinOp op e1 e2) ++ ")"
+showArg e                        = showExpr e 
+
 
 --------------------------------------------------------
 
 x :: Expr
-x = Var 'x'
+x = Var
 
 num :: Double -> Expr
 num d = Num d
 
 add,mul :: Expr -> Expr -> Expr
-add x y = BinOp "+" (+) x y
-mul x y = BinOp "*" (*) x y
+add x y = BinOp Add x y
+mul x y = BinOp Mul x y
 
 sin,cos :: Expr -> Expr 
-sin x = MonoOp "sin" Prelude.sin x
-cos x = MonoOp "cos" Prelude.cos x 
+sin x = MonoOp Sin x
+cos x = MonoOp Cos x 
 
 ----------- TEST DATA ---------------------------
 
-test = BinOp "+" (+) (Num 1) (Num 2)     -- = 3
-testf = MonoOp "sin" Prelude.sin (Num 0) -- = 0
-test2 = MonoOp "sin" Prelude.sin test    -- = sin(3) ca 0.14
+test = BinOp Add (Num 1) (Num 2)  -- = 3
+testf = MonoOp Sin (Num 0)        -- = 0
+test2 = MonoOp Sin test           -- = sin(3) ca 0.14
+
+test3 = mul (add (Num 1) (Num 2)) (add (Num 3) (Num 5))  -- = 3 * 8 = 24
+test4 = add (add (Num 1) (Num 2)) (add (Num 3) (Num 5))  -- = 3 + 8 = 11
+test5 = mul (mul (Num 1) (Num 2)) (mul (Num 3) (Num 5))  -- = 1*2 * 3*5 = 2 * 15 = 30
 
-test3 = mul (add (Num 1) (Num 2)) (add (Num 3) (Num 5)) -- = 3 * 8 = 24
-test4 = add (add (Num 1) (Num 2)) (add (Num 3) (Num 5)) -- = 3 + 8 = 11
-test5 = mul (mul (Num 1) (Num 2)) (mul (Num 3) (Num 5)) -- = 1*2 * 3*5 = 2 * 15 = 30
+test6 = mul (mul (Var) (Num 2)) (mul (Num 3) (Num 5)) -- = 1*2 * 3*5 = 2 * 15 = 30
 
-test6 = mul (mul (Var 'x') (Num 2)) (mul (Num 3) (Num 5)) -- = 1*2 * 3*5 = 2 * 15 = 30
+qFail = MonoOp Cos (MonoOp Cos (BinOp Mul Var (Num (-4.087662660418292))))
+failt  = BinOp Mul (MonoOp Cos (BinOp Mul Var (Num 1))) (Num 2)
 
 --------------------------------------------------
 
 -- | Evaluates a given expression, where the second argument is the value of x
 eval :: Expr -> Double -> Double
-eval (Var _) x          = x
+eval  Var x             = x
 eval (Num n) _          = n
-eval (BinOp _ op i j) x = (eval i x) `op` (eval j x) 
-eval (MonoOp _ op i) x  = op (eval i x)
+eval (BinOp Add i j) x  = (eval i x) + (eval j x) 
+eval (BinOp Mul i j) x  = (eval i x) * (eval j x)
+eval (MonoOp Cos i) x   = Prelude.cos (eval i x)
+eval (MonoOp Sin i) x   = Prelude.sin (eval i x)
 
 -- | Tries to read a expression from a string
 readExpr :: String -> Maybe Expr
-readExpr s = undefined
-
-{-}
-            do  
-              let s' = filter (not . isSpace) s
-             
-              -}
-
+readExpr s = case parse expr s' of
+                    Just(ex,"") -> return ex
+                    _           -> Nothing
+          where s' =  filter(not . isSpace) s
+
+
+assoc :: Expr -> Expr
+assoc (BinOp Add e1 (BinOp Add e2 e3)) = assoc (add (add (assoc e1) (assoc e2)) (assoc e3))
+assoc (BinOp Add e1 e2)                = add (assoc e1) (assoc e2)  
+assoc (BinOp Mul (BinOp Mul e1 e2) e3) = assoc (mul (mul (assoc e1) (assoc e2)) (assoc e3))
+assoc (BinOp Mul e1 e2)                = mul (assoc e1) (assoc e2)
+assoc (MonoOp op e)                    = MonoOp op (assoc e)
+assoc (Num n)                          = Num n
+assoc Var                              = Var 
+            
+-------------PARSERS------------------------
  -- | Parse a number
-number :: Parser Double
-number =  read <$> oneOrMore digit
+number :: Parser Expr
+number = Num <$> readsP 
 
 -- | Parse an x-variable
-xparse :: Parser Char
-xparse =  char 'x'
-
+variable :: Parser Expr
+variable = char 'x' *> return Var
+
+-- | Parse the sin function
+sinparse :: Parser Expr
+sinparse = do f <- funcparse 's' 'i' 'n' Sin
+              e <- factor
+              return (MonoOp f e)
+-- | Parse the cos function
+cosparse :: Parser Expr
+cosparse = do f <- funcparse 'c' 'o' 's' Cos
+              e <- factor
+              return (MonoOp f e)
+
+-- | Simple parser for a three letter function
+funcparse a b c f = do c1 <- char a  
+                       c2 <- char b 
+                       c3 <- char c
+                       return f
+cosine :: Parser Expr
+cosine = ((MonoOp Cos) <$> k)
+ where k = (char 'c') *> (char 'o') *> (char 's') *> factor
+                        
+sine :: Parser Expr
+sine = ((MonoOp Sin) <$> k)
+  where k = char 's' *> char 'i' *> char 'n' *> factor
+  
+-- | Parses expressions
 expr, term, factor :: Parser Expr
 expr   = foldl1 add <$> chain term (char '+')
-term   = foldl1 mul <$> chain factor (char '*')
-factor = Num <$> number <|> (Var <$> xparse <|> char '(' *> expr <* char ')')
-
-
-
+term   = foldl1 mul <$> chain factor (char '*') 
+factor = number <|> variable  <|> char '(' *> expr <* char ')' <|> sinparse <|> cosparse
+
+-- | Test that showExpr and readExpr produces the same result
+prop_ShowReadExpr :: Expr -> Bool
+prop_ShowReadExpr e = (assoc $ fromJust $ readExpr (showExpr e)) == assoc e 
+
+-- | Generator for arbitrary expressions
+arbExpr :: Int -> Gen Expr
+arbExpr n = frequency [(1,rNum),(1,rVar),(n,rBin),(n,rMon)]
+    where
+      range = 5
+      rVar  = return Var
+      rNum  =  Num <$> choose (-range,range)
+      rBin = do
+          let n' = n `div` 2
+          op <- oneof [return add, return mul]
+          e1 <- arbExpr n'
+          e2 <- arbExpr n'
+          return $ op e1 e2
+      rMon = do
+        op <- oneof [return GraphCalc.sin, return GraphCalc.cos]
+        e <- arbExpr (n-1)
+        return $ op e
+
+-- | Simplifies expressions
+simplify :: Expr -> Expr
+simplify (Num n)         = Num n
+simplify (Var)           = Var
+simplify (BinOp Add x y) = simplifyAdd (simplify x) (simplify y)
+simplify (BinOp Mul x y) = simplifyMul (simplify x) (simplify y)
+simplify (MonoOp f x)    = simplifyFunc f (simplify x) 
+
+-- | Simplifies multiplication expressions
+simplifyMul :: Expr -> Expr -> Expr
+simplifyMul (Num 0) e = Num 0
+simplifyMul e (Num 0) = Num 0
+simplifyMul e (Num 1) = e
+simplifyMul (Num 1) e = e
+simplifyMul x      y  = mul (simplify x) (simplify y)
+
+-- | Simplifies add expressions
+simplifyAdd :: Expr -> Expr -> Expr
+simplifyAdd e (Num 0) = simplify e
+simplifyAdd (Num 0) e = simplify e
+simplifyAdd x       y = add (simplify x) (simplify y)
+
+-- | Simplifies sin and cos expressions
+simplifyFunc :: MonoFunc -> Expr -> Expr
+simplifyFunc Sin (Num x) | x == 0 ||  x == pi = Num 0
+                         | x == (pi/2)        = Num 1
+simplifyFunc Sin e                            = MonoOp Sin (simplify e) 
+simplifyFunc Cos (Num x) | x == 0 || x == pi  = Num 1
+                         | x == (pi/2)        = Num 0
+simplifyFunc Cos e                            = MonoOp Cos (simplify e) 
+
+-- | Test that a simplified expression returns correct result
+prop_Simplify :: Expr -> Bool
+prop_Simplify e = (eval e 0) == (eval (simplify e) 0)
+
+-- | Differentiates an expression with regard to x
+differentiate :: Expr -> Expr
+differentiate (Num _)                 = Num 0
+differentiate (Var)                   = Num 1
+differentiate (BinOp Mul Var Var)     = simplify $ mul (Num 2) Var
+differentiate (BinOp Mul e1 e2)       = simplify $ add (mul (differentiate e1) e2) (mul e1 (differentiate e2))
+differentiate (BinOp Add e1 e2)       = simplify $ add (differentiate e1) (differentiate e2)
+differentiate (MonoOp Sin e)          = simplify $ mul (differentiate e) (MonoOp Cos e)
+differentiate (MonoOp Cos e)          = simplify $ mul (Num (-1)) (mul (differentiate e) (MonoOp Sin e))
+
+
+
+
+
+-----------MAIN-----------------------------
 main = do putStrLn "Welcome to the simple calculator!"
-readEvalPrint = do
-    putStr "What would you like to calculate?"
-    s <- getLine
-    let s' = filter (not . isSpace) s
-    case parse expr s' of
-       Just (e, "") -> print $ eval e 1
-       Nothing      -> putStrLn "Invalid Expression!"
+          forever readEvalPrint
+    
+readEvalPrint = do putStr "Expression? "
+                   s <- getLine
+                   case parse expr s of
+                     Just (e,"") -> do putStr "Value: "
+                                       print (eval e 0)
+                     _ -> putStrLn "Syntax error!"

ParsingMB.hs renamed to Parsing.hs

@@ -16,7 +16,7 @@ module Parsing
   ,parse
   -- * Basic parsers
   ,sat,item,digit
-  ,readsP -- behaves as reads :: Read a => [(a,String)]
+  ,readsP -- behaves as reads :: Read => [(a,String)]
   , char, failure
   -- * Combining parsers
   ,oneOrMore,zeroOrMore,chain,(<:>)
@@ -33,37 +33,7 @@ module Parsing
   , return
  ) 
 
-<<<<<<< HEAD:ParsingMB.hs
-{----------------------
-
-Aim: reusable Parser combinators including 
- a new type for the Parser, 
- but no export of the constructor
-
-Changes (v3 2016) Thomas Hallgren
-Export <* and *> from class Applicative instead of the combinators <-< and >->
-Export <|> from class Alternative instead of +++
-
-Changes (v2 2015)
-For compatibility with GHC>=7.10 Parser 
-is now also instance Applicative
-
-Removal: Class Functor, Applicative and Monad provide a number of 
-functions that were previously exported explicitly, in particular
-(>*>) is available as the bind operation (>>=),
-success is return, pmap is fmap.
-
-Additional function:
-readsP :: Read a => Parser a  
--- satisfies 
--- parse readsP s == listToMaybe (reads s)
-
-----------------------}
-=======
-
->>>>>>> 0d3b2453122b330de7594a8a1c229e5b55a35fb9:Parsing.hs
 where
-
 import Data.Char
 import Data.Maybe(listToMaybe)
 -- boilerplate for GHC 10.7 compatibility:

ParsingExamples.hs

@@ -165,7 +165,7 @@ module ParsingExamples where
     expr, term, factor :: Parser Expr
     expr = leftAssoc Add term (char '+')
     term = leftAssoc Mul factor (char '*')
-    factor = (Num <$> number) <|> (char '(' *> expr <* char ')')
+    factor = (Num <$> number) <|>  <|> (char '(' *> expr <* char ')')