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

week 4 tutorial
author Markus Kaiser <markus.kaiser@in.tum.de>
date Fri, 09 Nov 2012 13:01:37 +0100
parents 8689a0a4b38e
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
7
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
1 module Exercise_4 where
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
2 import Test.QuickCheck
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
3 import Data.List
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
4
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
5 {---------------------------------------------------------------------}
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
6 {- Aufgabe G4.1 -}
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
7
9
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
8 {- allEqual ist nicht Teil des Übungsblattes, nur ein Beispiel. -}
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
9 allEqual :: [Integer] -> Bool
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
10 --allEqual [] = True
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
11 --allEqual [x] = True
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
12 allEqual (x : y : ys) = x == y && allEqual (y : ys)
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
13 allEqual _ = True
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
14
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
15
7
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
16 hasFibonacciProperty :: [Integer] -> Bool
9
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
17 hasFibonacciProperty (x : y : z : zs) = z == x + y && hasFibonacciProperty (y : z : zs)
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
18 hasFibonacciProperty _ = True
7
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
19
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
20
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
21
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
22 {---------------------------------------------------------------------}
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
23 {- Aufgabe G4.2 -}
9
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
24
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
25 -- Beispielschlüssel vom Blatt
8
8689a0a4b38e add example key
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 7
diff changeset
26 key = [('a','x'),('H','e'),('l','P'),('o','M')]
7
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
27
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
28 cryptChar :: [(Char,Char)] -> Char -> Char
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
29 cryptChar [] c = '_'
9
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
30 cryptChar ((k,v) : ks) c = if c == k then v else cryptChar ks c
7
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
31
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
32
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
33 crypt :: [(Char,Char)] -> [Char] -> [Char]
9
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
34 crypt key xs = [cryptChar key x | x <- xs]
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
35
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
36 --Alternativ:
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
37 crypt' key [] = []
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
38 crypt' key (x : xs) = cryptChar key x : crypt' key xs
7
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
39
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
40
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
41 isKeyReversible :: [(Char,Char)] -> Bool
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
42 isKeyReversible [] = True
9
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
43 isKeyReversible ((k,v) : ks) = null [1 | (k', v') <- ks, v' == v] && isKeyReversible ks
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
44
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
45 --Alternativ (wird in den QuickCheck Tests verwendet):
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
46 isKeyReversible' ks = nub vs == vs
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
47 where vs = [v | (_, v) <- ks]
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
48
7
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
49
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
50 {- QuickCheck Tests -}
9
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
51 -- Wenn kein Value doppelt ist kommt True raus
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
52 prop_isKeyReversible_complete :: [(Char, Char)] -> Property
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
53 prop_isKeyReversible_complete ks = vs == nub vs ==> isKeyReversible ks
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
54 where vs = [v | (_, v) <- ks]
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
55
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
56 -- Wenn ein Value doppelt ist kommt False raus
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
57 prop_isKeyReversible_sound :: Char -> Char-> Char -> [(Char, Char)] -> [(Char, Char)] -> [(Char, Char)] -> Bool
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
58 prop_isKeyReversible_sound v k1 k2 ks1 ks2 ks3 =
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
59 not(isKeyReversible (ks1 ++ [(k1, v)] ++ ks2 ++ [(k2, v)] ++ ks3))
7
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
60
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
61
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
62
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
63 {---------------------------------------------------------------------}
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
64 {- Aufgabe G4.3 -}
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
65
9
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
66
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
67 -- Englisch, da schamlos aus der Musterlösung geklaut.
7
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
68 {-
9
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
69 - Note: [x] is just a syntactic abbreviation for (x : [])
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
70 -
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
71 - Lemma reverse (snoc xs x) = x : reverse xs
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
72 - Proof by structural induction on xs
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
73 -
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
74 - Base case:
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
75 - To show: reverse (snoc [] x) = x : reverse []
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
76 - reverse (snoc [] x)
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
77 - == reverse [x] (by snoc_Nil)
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
78 - == reverse [] ++ [x] (by reverse_Cons)
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
79 - == [] ++ [x] (by reverse_Nil)
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
80 - == [x] (by append_Nil)
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
81 -
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
82 - x : reverse []
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
83 - == [x] (by reverse_Nil)
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
84 -
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
85 - Induction step:
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
86 - IH: reverse (snoc ys x) = x : reverse ys
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
87 - To show: reverse (snoc (y : ys) x) = x : reverse (y : ys)
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
88 - reverse (snoc (y : ys) x)
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
89 - == reverse (y : snoc ys x) (by snoc_Cons)
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
90 - == reverse (snoc ys x) ++ [y] (by reverse_Cons)
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
91 - == (x : reverse ys) ++ [y] (by IH)
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
92 - == x : (reverse ys ++ [y]) (by append_Cons)
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
93 -
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
94 - x : reverse (y : ys)
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
95 - == x : (reverse ys ++ [y]) (by reverse_Cons)
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
96 -}
7
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
97
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
98
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
99
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
100 {---------------------------------------------------------------------}
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
101 {- Aufgabe G4.4 -}
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
102
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
103 match :: [Char] -> [Char] -> Bool
9
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
104 match [] ys = null ys
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
105 match ('?':ps) (y:ys) = match ps ys
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
106 match ('*':ps) [] = match ps []
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
107 match ('*':ps) (y:ys) = match ps (y:ys) || match ('*':ps) ys
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
108 match (p:ps) (y:ys) = p == y && match ps ys
f4d71c6df64c week 4 tutorial
Markus Kaiser <markus.kaiser@in.tum.de>
parents: 8
diff changeset
109 match ps [] = False
7
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
110
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
111
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
112
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
113 {---------------------------------------------------------------------}
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
114 {- Aufgabe H4.1 -}
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
115
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
116 strictlyDescending :: [Integer] -> Bool
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
117 strictlyDescending = undefined
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
118
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
119
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
120
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
121 {---------------------------------------------------------------------}
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
122 {- Aufgabe H4.2 -}
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
123
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
124 chunks :: Int -> [a] -> [[a]]
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
125 chunks = undefined
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
126
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
127 irregularChunks :: [Int] -> [a] -> [[a]]
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
128 irregularChunks = undefined
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
129
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
130
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
131
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
132 {---------------------------------------------------------------------}
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
133 {- Aufgabe H4.3 -}
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
134
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
135 {-WETT-}
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
136 upsAndDowns :: Ord a => [a] -> [[a]]
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
137 upsAndDowns = undefined
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
138 {-TTEW-}
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
139
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
140
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
141
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
142 {---------------------------------------------------------------------}
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
143 {- Aufgabe H4.4 -}
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
144
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
145 {-
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
146 - <Hier Induktionsbeweis einfügen>
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
147 -}