7
|
1 module Exercise_4 where |
|
2 import Test.QuickCheck |
|
3 import Data.List |
|
4 |
|
5 {---------------------------------------------------------------------} |
|
6 {- Aufgabe G4.1 -} |
|
7 |
9
|
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 |
7
|
16 hasFibonacciProperty :: [Integer] -> Bool |
9
|
17 hasFibonacciProperty (x : y : z : zs) = z == x + y && hasFibonacciProperty (y : z : zs) |
|
18 hasFibonacciProperty _ = True |
7
|
19 |
|
20 |
|
21 |
|
22 {---------------------------------------------------------------------} |
|
23 {- Aufgabe G4.2 -} |
9
|
24 |
|
25 -- Beispielschlüssel vom Blatt |
8
|
26 key = [('a','x'),('H','e'),('l','P'),('o','M')] |
7
|
27 |
|
28 cryptChar :: [(Char,Char)] -> Char -> Char |
|
29 cryptChar [] c = '_' |
9
|
30 cryptChar ((k,v) : ks) c = if c == k then v else cryptChar ks c |
7
|
31 |
|
32 |
|
33 crypt :: [(Char,Char)] -> [Char] -> [Char] |
9
|
34 crypt key xs = [cryptChar key x | x <- xs] |
|
35 |
|
36 --Alternativ: |
|
37 crypt' key [] = [] |
|
38 crypt' key (x : xs) = cryptChar key x : crypt' key xs |
7
|
39 |
|
40 |
|
41 isKeyReversible :: [(Char,Char)] -> Bool |
|
42 isKeyReversible [] = True |
9
|
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 |
7
|
49 |
|
50 {- QuickCheck Tests -} |
9
|
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)) |
7
|
60 |
|
61 |
|
62 |
|
63 {---------------------------------------------------------------------} |
|
64 {- Aufgabe G4.3 -} |
|
65 |
9
|
66 |
|
67 -- Englisch, da schamlos aus der Musterlösung geklaut. |
7
|
68 {- |
9
|
69 - Note: [x] is just a syntactic abbreviation for (x : []) |
|
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 -} |
7
|
97 |
|
98 |
|
99 |
|
100 {---------------------------------------------------------------------} |
|
101 {- Aufgabe G4.4 -} |
|
102 |
|
103 match :: [Char] -> [Char] -> Bool |
9
|
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 |
7
|
110 |
|
111 |
|
112 |
|
113 {---------------------------------------------------------------------} |
|
114 {- Aufgabe H4.1 -} |
|
115 |
|
116 strictlyDescending :: [Integer] -> Bool |
|
117 strictlyDescending = undefined |
|
118 |
|
119 |
|
120 |
|
121 {---------------------------------------------------------------------} |
|
122 {- Aufgabe H4.2 -} |
|
123 |
|
124 chunks :: Int -> [a] -> [[a]] |
|
125 chunks = undefined |
|
126 |
|
127 irregularChunks :: [Int] -> [a] -> [[a]] |
|
128 irregularChunks = undefined |
|
129 |
|
130 |
|
131 |
|
132 {---------------------------------------------------------------------} |
|
133 {- Aufgabe H4.3 -} |
|
134 |
|
135 {-WETT-} |
|
136 upsAndDowns :: Ord a => [a] -> [[a]] |
|
137 upsAndDowns = undefined |
|
138 {-TTEW-} |
|
139 |
|
140 |
|
141 |
|
142 {---------------------------------------------------------------------} |
|
143 {- Aufgabe H4.4 -} |
|
144 |
|
145 {- |
|
146 - <Hier Induktionsbeweis einfügen> |
|
147 -} |