-- IB015 2020 homework 10post04 -- v v v -- Do not change these types -- v v v -- data PropFormula = Const Bool | Var String | Bin BinOp PropFormula PropFormula | Not PropFormula deriving (Show, Eq) data BinOp = And | Or | Implies deriving (Show, Eq) -- ^ ^ ^ -- Do not change these types -- ^ ^ ^ -- -- ------------------------------------------------------------------------- -- -- YOUR SOLUTION -- -- ------------------------------------------------------------------------- -- isLit :: PropFormula -> Bool isLit = undefined isConst :: PropFormula -> Bool isConst = undefined evalConsts :: PropFormula -> PropFormula evalConsts = undefined removeConsts :: PropFormula -> PropFormula removeConsts = undefined toNNF :: PropFormula -> PropFormula toNNF = undefined toIF :: PropFormula -> PropFormula toIF = undefined isCNF :: PropFormula -> Bool isCNF = undefined isDNF :: PropFormula -> Bool isDNF = undefined renameVars :: PropFormula -> PropFormula renameVars = undefined -- ------------------------------------------------------------------------- -- -- TESTS -- -- ------------------------------------------------------------------------- -- -- Set to False if you are experiencing problems with unicode terminal output. -- But it's 2020, so really the answer is to just fix your terminal. prettyUnicode :: Bool prettyUnicode = True -- Set the boolean to False to skip testing that function (for example, because -- you left it undefined). It's better than commenting it out, because the test -- runner will remind you that you have skipped the test, so that you don't -- forget to re-enable it once you've implemented the function. t_enabledTests :: [TGroup] t_enabledTests = [ (t_isLit True) , (t_isConst True) , (t_evalConsts True) , (t_removeConsts True) , (t_toNNF True) , (t_toIF True) , (t_isCNF True) , (t_isDNF True) , (t_renameVars True) ] t_isLit, t_isConst, t_evalConsts, t_removeConsts, t_toNNF, t_toIF, t_isCNF, t_isDNF, t_renameVars :: Bool -> TGroup -- Test cases are a list of pairs (input value, expected result). Do add your -- own! It is much more comfortable than putting it in the interpreter all over -- again and checking whether the result is alright. t_isLit = t_unary "isLit" isLit [ (cF, False) , (vA, True) , (Not notA, False) ] t_isConst = t_unary "isConst" isConst [ (cT ∧ cF, False) , (vA, False) , (Not cT, False) , (cF, True) ] t_evalConsts = t_unary "evalConsts" evalConsts [ (cT ∧ cF, cF) , (vA ∧ cF, vA ∧ cF) , (vA ∨ (cF → cF), vA ∨ cT) ] t_removeConsts = t_unary "removeConsts" removeConsts [ (cT ∧ cF, cF) , (vA ∧ cF, cF) , ((vA ∧ cF) → vB, cT) , ((vA ∨ cF) → (cT ∧ vB), vA → vB) , ((vA ∨ cF) → (cT ∧ vB), vA → vB) , (notA → cF, Not notA) ] t_toNNF = t_unary "toNNF" toNNF [ (notA → Not (notB ∨ vC), vA ∨ (vB ∧ notC)) , (Not (vA ∨ (notD ∨ Not (notA ∨ Not notB))), notA ∧ (vD ∧ (notA ∨ vB))) , ((notA ∨ vB) → Not (vB ∧ notC), (vA ∧ notB) ∨ (notB ∨ vC)) ] t_toIF = t_unary "toIF" toIF [ (vA ∧ Not (vB → notC), (vA → (((vB → (vC → cF)) → cF) → cF)) → cF) , (notA ∨ (notB ∧ vC), (((vA → cF) → cF) → (((vB → cF) → (vC → cF)) → cF))) ] t_isCNF = t_unary "isCNF" isCNF $ t_bothNF ++ t_onlyCNF True t_isDNF = t_unary "isDNF" isDNF $ t_bothNF ++ t_onlyCNF False t_renameVars = t_unary "renameVars" renameVars [ (cF, cF) , (vB ∧ vA, vA ∧ vB ) , ((Var "fear" → Var "anger") ∧ ((Var "anger" → Var "hate") ∧ (Var "hate" → Var "suffering")), (vA → vB) ∧ ((vB → vC) ∧ (vC → vD))) ] t_bothNF :: [(PropFormula, Bool)] t_bothNF = [ (cT, False) , (vB, True) , (vC ∧ notA, True) , ((vC ∨ vB) ∨ (notA ∨ notB), True) , ((vC ∨ vB) → (notA ∨ notB), False) , (Not (vC ∧ notA), False) ] t_onlyCNF :: Bool -> [(PropFormula, Bool)] t_onlyCNF cnf = [ ((vA ∨ notB) ∧ vC, cnf) , (vA ∨ (notB ∧ vC), not cnf) ] -- Some shortcuts to make the tests look better (∨) :: PropFormula -> PropFormula -> PropFormula a ∨ b = Bin Or a b (∧) :: PropFormula -> PropFormula -> PropFormula a ∧ b = Bin And a b (→) :: PropFormula -> PropFormula -> PropFormula a → b = Bin Implies a b cT, cF, vA, vB, vC, vD, notA, notB, notC, notD :: PropFormula cT = Const True cF = Const False vA = Var "A" vB = Var "B" vC = Var "C" vD = Var "D" notA = Not vA notB = Not vB notC = Not vC notD = Not vD -- Select how you want to show the test inputs and expected/obtained results: printer :: Pretty a => a -> String printer = pretty -- pretty formulae with infix unicode operators -- printer = show -- ugly, prefix, without unicode -- Print prettily pprint :: Pretty a => a -> IO () pprint = putStrLn . pretty -- ------------------------------------------------------------------------- -- -- MAGIC -- -- ------------------------------------------------------------------------- -- -- You can safely ignore the rest of the file. orIfUgly :: a -> a -> a orIfUgly p u = if prettyUnicode then p else u class Show a => Pretty a where pretty :: a -> String pretty = show instance Pretty BinOp where pretty op = concat ["(", prettyOp op, ")"] prettyOp :: BinOp -> String prettyOp And = "∧" `orIfUgly` "&" prettyOp Or = "∨" `orIfUgly` "|" prettyOp Implies = "→" `orIfUgly` "->" instance Pretty PropFormula where pretty (Const c) = if c then "𝗧" `orIfUgly` "1" else "𝗙" `orIfUgly` "0" pretty (Var v) = v pretty (Bin o l r) = concat ["(", pretty l, " ", prettyOp o, " ", pretty r, ")"] pretty (Not x) = ('¬' `orIfUgly` '!') : pretty x instance Pretty Bool where type TGroup = IO () t_unary :: (Pretty a, Pretty b, Eq b) => String -> (a -> b) -> [(a, b)] -> Bool -> IO () t_unary name f cases enabled = putStr (name ++ ": ") >> go' where go' = if enabled then go 0 cases else putStrLn "SKIPPED!" go n [] = putStrLn . unwords $ ["all", show n, "tests passed."] go n ((c,e):cs) = let r = f c in if r == e then go (n + 1) cs else putStrLn . unlines $ ["FAILED!" ,"Input: " ++ printer c ,"Expected: " ++ printer e ,"But got: " ++ printer r ] main :: IO () main = sequence_ t_enabledTests