Mercurial > 12ws.info2

comparison exercises/src/Exercise_8.hs @ 20:6d43207984ec

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
week 8 tutorial
author Markus Kaiser <markus.kaiser@in.tum.de>
date Wed, 12 Dec 2012 20:10:02 +0100
parents 6688bf4a5836
children
comparison
equal deleted inserted replaced
19:6688bf4a5836 20:6d43207984ec
4 import Test.QuickCheck 4 import Test.QuickCheck
5 5
6 {---------------------------------------------------------------------} 6 {---------------------------------------------------------------------}
7 {- Aufgabe G8.1 -} 7 {- Aufgabe G8.1 -}
8 8
9 f0 :: Fraction 9 data Fraction = Over Integer Integer deriving Show
10 f0 = Over 1 2
11
12 f1 :: Fraction
13 f1 = Over 7 5
14 10
15 11
16 norm :: Fraction -> Fraction 12 norm :: Fraction -> Fraction
17 norm = undefined 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
19 30
20 31
21 {---------------------------------------------------------------------} 32 {---------------------------------------------------------------------}
22 {- Aufgabe G8.2 -} 33 {- Aufgabe G8.2 -}
23 -- siehe Exercise_8_Form.hs 34 -- siehe Exercise_8_Form.hs
24 35
25 p0 :: Form 36 --p0 :: Form
26 p0 = (Var "a" :&: Var "b") :|: (Not (Var "a") :&: Not (Var "b")) 37 --p0 = (Var "a" :&: Var "b") :|: (Not (Var "a") :&: Not (Var "b"))
27 38
28 p1 :: Form 39 --p1 :: Form
29 p1 = ((Not $ Not $ Var "a") :|: (Not ((Var "b") :->: (Not (Var "c"))))) 40 --p1 = ((Not $ Not $ Var "a") :|: (Not ((Var "b") :->: (Not (Var "c")))))
30 41
31 42
32 43
33 {---------------------------------------------------------------------} 44 {---------------------------------------------------------------------}
34 {- Aufgabe G8.3 -} 45 {- Aufgabe G8.3 -}
40 51
41 data Arith = Add Arith Arith | Mul Arith Arith | Const Integer | IVar String deriving Show 52 data Arith = Add Arith Arith | Mul Arith Arith | Const Integer | IVar String deriving Show
42 53
43 54
44 evalArith :: [(String,Integer)] -> Arith -> Integer 55 evalArith :: [(String,Integer)] -> Arith -> Integer
45 evalArith = undefined 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
46 61
47 62
48 63
49 {---------------------------------------------------------------------} 64 {---------------------------------------------------------------------}
50 {- Aufgabe G8.4 -} 65 {- Aufgabe G8.4 -}
51 66
52 mkTable :: Form -> [[String]] 67 mkTable :: Form -> [[String]]
53 mkTable = undefined 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
54 73
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) ' ')
55 82
56 showTable :: Form -> String 83 showTable :: Form -> String
57 showTable = unlines . map unwords . mkTable 84 showTable = unlines . map unwords . mkTable
58 85
59
60 printTable :: Form -> IO () 86 printTable :: Form -> IO ()
61 printTable = putStrLn . showTable 87 printTable = putStrLn . showTable