Mercurial > 12ws.info2
annotate exercises/src/Exercise_8.hs @ 20:6d43207984ec
week 8 tutorial
| author | Markus Kaiser <markus.kaiser@in.tum.de> |
|---|---|
| date | Wed, 12 Dec 2012 20:10:02 +0100 |
| parents | 6688bf4a5836 |
| children |
| rev | line source |
|---|---|
| 18 | 1 module Exercise_8 where |
| 2 import Form | |
| 3 import Data.Ratio | |
| 4 import Test.QuickCheck | |
| 5 | |
| 6 {---------------------------------------------------------------------} | |
| 7 {- Aufgabe G8.1 -} | |
| 8 | |
| 20 | 9 data Fraction = Over Integer Integer deriving Show |
| 18 | 10 |
|
19
6688bf4a5836
Rename Form-File to match module name
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
18
diff
changeset
|
11 |
| 18 | 12 norm :: Fraction -> Fraction |
| 20 | 13 norm (Over a b) = (a `div` c) `Over` (b `div` c) |
| 14 where c = gcd a b * (if b < 0 then -1 else 1) | |
| 15 | |
| 16 instance Num Fraction where | |
| 17 (a1 `Over` b1) + (a2 `Over` b2) = norm $ (a1*b2 + a2*b1) `Over` (b1 * b2) | |
| 18 (a1 `Over` b1) * (a2 `Over` b2) = norm $ (a1 * a2) `Over` (b1 * b2) | |
| 19 abs (a `Over` b) = abs a `Over` abs b | |
| 20 signum (a `Over` b) = (signum a * signum b) `Over` 1 | |
| 21 fromInteger n = n `Over` 1 | |
| 22 | |
| 23 instance Eq Fraction where | |
| 24 (a1 `Over` b1) == (a2 `Over` b2) = a1*b2 == a2*b1 | |
| 25 | |
| 26 instance Fractional Fraction where | |
| 27 recip (a `Over` b) = (b `Over` a) | |
| 28 fromRational r = numerator r `Over` denominator r | |
| 18 | 29 |
| 30 | |
| 31 | |
| 32 {---------------------------------------------------------------------} | |
| 33 {- Aufgabe G8.2 -} | |
| 34 -- siehe Exercise_8_Form.hs | |
| 35 | |
| 20 | 36 --p0 :: Form |
| 37 --p0 = (Var "a" :&: Var "b") :|: (Not (Var "a") :&: Not (Var "b")) | |
| 18 | 38 |
| 20 | 39 --p1 :: Form |
| 40 --p1 = ((Not $ Not $ Var "a") :|: (Not ((Var "b") :->: (Not (Var "c"))))) | |
| 18 | 41 |
| 42 | |
| 43 | |
| 44 {---------------------------------------------------------------------} | |
| 45 {- Aufgabe G8.3 -} | |
| 46 | |
| 47 v0 = [("pizza", 7), ("cola", 2), ("apfel", 1)] | |
| 48 | |
| 49 a0 :: Arith | |
| 50 a0 = Add (Add (Mul (Const 3) (IVar "pizza")) (IVar "cola")) (IVar "apfel") | |
| 51 | |
| 52 data Arith = Add Arith Arith | Mul Arith Arith | Const Integer | IVar String deriving Show | |
| 53 | |
| 54 | |
| 55 evalArith :: [(String,Integer)] -> Arith -> Integer | |
| 20 | 56 evalArith val (Add x y) = evalArith val x + evalArith val y |
| 57 evalArith val (Mul x y) = evalArith val x * evalArith val y | |
| 58 evalArith _ (Const x) = x | |
| 59 evalArith val (IVar s) = the (lookup s val) | |
| 60 where the (Just x) = x | |
| 18 | 61 |
| 62 | |
| 63 | |
| 64 {---------------------------------------------------------------------} | |
| 65 {- Aufgabe G8.4 -} | |
| 66 | |
| 67 mkTable :: Form -> [[String]] | |
| 20 | 68 mkTable phi = firstRow : secondRow : map (zipWith align lengths . mkRow) (vals $ vars phi) |
| 69 where | |
| 70 firstRow = vars phi ++ ["|", show phi] | |
| 71 secondRow = map (map (const '-')) firstRow | |
| 72 lengths = map length firstRow | |
| 18 | 73 |
| 20 | 74 mkRow val = map (stringOfBool . snd) val ++ ["|", stringOfBool $ eval val phi] |
| 75 | |
| 76 stringOfBool True = "T" | |
| 77 stringOfBool False = "F" | |
| 78 | |
| 79 align n xs = lpad ++ xs ++ rpad | |
| 80 where | |
| 81 (lpad, rpad) = splitAt ((n - length xs) `div` 2) (replicate (n - length xs) ' ') | |
| 18 | 82 |
| 83 showTable :: Form -> String | |
| 84 showTable = unlines . map unwords . mkTable | |
| 85 | |
| 86 printTable :: Form -> IO () | |
| 87 printTable = putStrLn . showTable |