Mercurial > 12ws.info2

comparison exercises/src/Exercise_4.hs @ 9:f4d71c6df64c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
week 4 tutorial
author Markus Kaiser <markus.kaiser@in.tum.de>
date Fri, 09 Nov 2012 13:01:37 +0100
parents 8689a0a4b38e
children
comparison
equal deleted inserted replaced
8:8689a0a4b38e 9:f4d71c6df64c
3 import Data.List 3 import Data.List
4 4
5 {---------------------------------------------------------------------} 5 {---------------------------------------------------------------------}
6 {- Aufgabe G4.1 -} 6 {- Aufgabe G4.1 -}
7 7
8 {- allEqual ist nicht Teil des Übungsblattes, nur ein Beispiel. -}
9 allEqual :: [Integer] -> Bool
10 --allEqual [] = True
11 --allEqual [x] = True
12 allEqual (x : y : ys) = x == y && allEqual (y : ys)
13 allEqual _ = True
14
15
8 hasFibonacciProperty :: [Integer] -> Bool 16 hasFibonacciProperty :: [Integer] -> Bool
9 hasFibonacciProperty xs = undefined 17 hasFibonacciProperty (x : y : z : zs) = z == x + y && hasFibonacciProperty (y : z : zs)
18 hasFibonacciProperty _ = True
10 19
11 20
12 21
13 {---------------------------------------------------------------------} 22 {---------------------------------------------------------------------}
14 {- Aufgabe G4.2 -} 23 {- Aufgabe G4.2 -}
24
25 -- Beispielschlüssel vom Blatt
15 key = [('a','x'),('H','e'),('l','P'),('o','M')] 26 key = [('a','x'),('H','e'),('l','P'),('o','M')]
16 27
17 cryptChar :: [(Char,Char)] -> Char -> Char 28 cryptChar :: [(Char,Char)] -> Char -> Char
18 cryptChar [] c = '_' 29 cryptChar [] c = '_'
19 cryptChar ((k,v) : ks) c = undefined 30 cryptChar ((k,v) : ks) c = if c == k then v else cryptChar ks c
20 31
21 32
22 crypt :: [(Char,Char)] -> [Char] -> [Char] 33 crypt :: [(Char,Char)] -> [Char] -> [Char]
23 crypt key [] = [] 34 crypt key xs = [cryptChar key x | x <- xs]
24 crypt key (x : xs) = undefined 35
36 --Alternativ:
37 crypt' key [] = []
38 crypt' key (x : xs) = cryptChar key x : crypt' key xs
25 39
26 40
27 isKeyReversible :: [(Char,Char)] -> Bool 41 isKeyReversible :: [(Char,Char)] -> Bool
28 isKeyReversible [] = True 42 isKeyReversible [] = True
29 isKeyReversible ((k,v) : ks) = undefined 43 isKeyReversible ((k,v) : ks) = null [1 | (k', v') <- ks, v' == v] && isKeyReversible ks
44
45 --Alternativ (wird in den QuickCheck Tests verwendet):
46 isKeyReversible' ks = nub vs == vs
47 where vs = [v | (_, v) <- ks]
48
30 49
31 {- QuickCheck Tests -} 50 {- QuickCheck Tests -}
51 -- Wenn kein Value doppelt ist kommt True raus
52 prop_isKeyReversible_complete :: [(Char, Char)] -> Property
53 prop_isKeyReversible_complete ks = vs == nub vs ==> isKeyReversible ks
54 where vs = [v | (_, v) <- ks]
55
56 -- Wenn ein Value doppelt ist kommt False raus
57 prop_isKeyReversible_sound :: Char -> Char-> Char -> [(Char, Char)] -> [(Char, Char)] -> [(Char, Char)] -> Bool
58 prop_isKeyReversible_sound v k1 k2 ks1 ks2 ks3 =
59 not(isKeyReversible (ks1 ++ [(k1, v)] ++ ks2 ++ [(k2, v)] ++ ks3))
32 60
33 61
34 62
35 {---------------------------------------------------------------------} 63 {---------------------------------------------------------------------}
36 {- Aufgabe G4.3 -} 64 {- Aufgabe G4.3 -}
37 65
66
67 -- Englisch, da schamlos aus der Musterlösung geklaut.
38 {- 68 {-
39 - Proof me! 69 - Note: [x] is just a syntactic abbreviation for (x : [])
40 -} 70 -
71 - Lemma reverse (snoc xs x) = x : reverse xs
72 - Proof by structural induction on xs
73 -
74 - Base case:
75 - To show: reverse (snoc [] x) = x : reverse []
76 - reverse (snoc [] x)
77 - == reverse [x] (by snoc_Nil)
78 - == reverse [] ++ [x] (by reverse_Cons)
79 - == [] ++ [x] (by reverse_Nil)
80 - == [x] (by append_Nil)
81 -
82 - x : reverse []
83 - == [x] (by reverse_Nil)
84 -
85 - Induction step:
86 - IH: reverse (snoc ys x) = x : reverse ys
87 - To show: reverse (snoc (y : ys) x) = x : reverse (y : ys)
88 - reverse (snoc (y : ys) x)
89 - == reverse (y : snoc ys x) (by snoc_Cons)
90 - == reverse (snoc ys x) ++ [y] (by reverse_Cons)
91 - == (x : reverse ys) ++ [y] (by IH)
92 - == x : (reverse ys ++ [y]) (by append_Cons)
93 -
94 - x : reverse (y : ys)
95 - == x : (reverse ys ++ [y]) (by reverse_Cons)
96 -}
41 97
42 98
43 99
44 {---------------------------------------------------------------------} 100 {---------------------------------------------------------------------}
45 {- Aufgabe G4.4 -} 101 {- Aufgabe G4.4 -}
46 102
47 match :: [Char] -> [Char] -> Bool 103 match :: [Char] -> [Char] -> Bool
48 match xs ys = undefined 104 match [] ys = null ys
105 match ('?':ps) (y:ys) = match ps ys
106 match ('*':ps) [] = match ps []
107 match ('*':ps) (y:ys) = match ps (y:ys) || match ('*':ps) ys
108 match (p:ps) (y:ys) = p == y && match ps ys
109 match ps [] = False
49 110
50 111
51 112
52 {---------------------------------------------------------------------} 113 {---------------------------------------------------------------------}
53 {- Aufgabe H4.1 -} 114 {- Aufgabe H4.1 -}