|
16
|
1 {-# LANGUAGE DeriveGeneric #-} |
|
|
2 module Exercise_7 where |
|
|
3 import Data.List hiding (insert) |
|
|
4 import Data.Char |
|
|
5 import Test.QuickCheck |
|
|
6 |
|
|
7 {- Library DO NOT CHANGE -} |
|
|
8 data Tree a = |
|
|
9 Empty | |
|
|
10 Node a (Tree a) (Tree a) |
|
|
11 deriving (Eq, Show) |
|
|
12 |
|
17
|
13 tree = (Node 4 |
|
|
14 (Node 2 (Node 1 Empty Empty) (Node 3 Empty Empty)) |
|
|
15 (Node 6 (Node 5 Empty Empty) (Node 7 Empty Empty))) |
|
|
16 |
|
|
17 insert :: Ord a => a -> Tree a -> Tree a |
|
|
18 insert x Empty = Node x Empty Empty |
|
|
19 insert x (Node a l r) |
|
|
20 | x < a = Node a (insert x l) r |
|
|
21 | a < x = Node a l (insert x r) |
|
|
22 | otherwise = Node a l r |
|
|
23 |
|
16
|
24 data Html = |
|
|
25 Text String | |
|
|
26 Block String [Html] |
|
|
27 |
|
|
28 grueezi = |
|
|
29 Block "html" |
|
|
30 [Block "head" |
|
|
31 [Block "author" [Text "der MC"], |
|
|
32 Block "date" [Text "27.11.2012"], |
|
|
33 Block "topsecret" []], |
|
|
34 Block "body" |
|
|
35 [Block "h1" [Text "Gr\252ezi!"], |
|
|
36 Block "p" [Text "\196b\228, genau. Sal\252. Bis sp\246ter!"]]] |
|
|
37 |
|
17
|
38 kleiner = |
|
|
39 Block "html" |
|
|
40 [Block "a" |
|
|
41 [Text "Hallo"], |
|
|
42 Block "b" |
|
|
43 [Text "du da!"] |
|
|
44 ] |
|
|
45 |
|
|
46 swissLetters :: [(Int, String)] |
|
|
47 swissLetters = |
|
|
48 [(196, "Auml"), (214, "Ouml"), (220, "Uuml"), |
|
|
49 (228, "auml"), (246, "ouml"), (252, "uuml")] |
|
|
50 |
|
16
|
51 data DirTree a = |
|
|
52 File a | |
|
|
53 Dir a [DirTree a] |
|
|
54 deriving (Eq, Show) |
|
|
55 |
|
|
56 exDir :: DirTree String |
|
|
57 exDir = |
|
|
58 Dir "" [Dir "usr" [Dir "lib" [File "vim"], Dir "include" [File "string.h"]], |
|
|
59 Dir "bin" $ [File "ls", File "cat"]] |
|
|
60 {- End Library -} |
|
|
61 |
|
|
62 |
|
|
63 {---------------------------------------------------------------------} |
|
|
64 {- Aufgabe G7.1 -} |
|
|
65 |
|
|
66 {- 1. -} |
|
|
67 data WildChar = |
|
17
|
68 AnyChar | |
|
|
69 AnyString | |
|
|
70 RawChar Char | |
|
|
71 AnyCharIn [Char] |
|
16
|
72 |
|
|
73 |
|
|
74 data WildPat = |
|
|
75 WildPat [WildChar] |
|
|
76 |
|
|
77 |
|
|
78 {- 2. -} |
|
|
79 stringFromWildChar :: WildChar -> String |
|
17
|
80 stringFromWildChar AnyChar = "?" |
|
|
81 stringFromWildChar AnyString = "*" |
|
|
82 stringFromWildChar (RawChar c) = [c] |
|
|
83 stringFromWildChar (AnyCharIn cs) = "[" ++ cs ++ "]" |
|
16
|
84 |
|
|
85 |
|
|
86 stringFromWildPat :: WildPat -> String |
|
17
|
87 stringFromWildPat (WildPat ws) = concatMap stringFromWildChar ws |
|
16
|
88 |
|
|
89 |
|
|
90 {- 3. -} |
|
|
91 instance Show WildChar where |
|
|
92 show = stringFromWildChar |
|
|
93 |
|
|
94 instance Show WildPat where |
|
|
95 show = stringFromWildPat |
|
|
96 |
|
|
97 |
|
|
98 {- 4. -} |
|
|
99 wildCharsFromString :: String -> [WildChar] |
|
17
|
100 wildCharsFromString [] = [] |
|
|
101 wildCharsFromString (c : cs) |
|
|
102 | c == '?' = AnyChar : ps |
|
|
103 | c == '*' = AnyString : ps |
|
|
104 | c == '[' = |
|
|
105 case dropWhile (/= ']') cs of |
|
|
106 [] -> RawChar '[' : ps |
|
|
107 _ : rest -> AnyCharIn (takeWhile (/= ']') cs) : |
|
|
108 wildCharsFromString rest |
|
|
109 | otherwise = RawChar c : ps |
|
|
110 where ps = wildCharsFromString cs |
|
16
|
111 |
|
|
112 wildPatFromString :: String -> WildPat |
|
|
113 wildPatFromString cs = WildPat (wildCharsFromString cs) |
|
|
114 |
|
|
115 |
|
|
116 {- 5. -} |
|
17
|
117 -- WildChar und WildPat QuickCheckkompatibel machen |
|
|
118 instance Eq WildChar where |
|
|
119 RawChar c == RawChar c' = c == c' |
|
|
120 AnyChar == AnyChar = True |
|
|
121 AnyString == AnyString = True |
|
|
122 AnyCharIn cs == AnyCharIn cs' = cs == cs' |
|
|
123 _ == _ = False |
|
|
124 |
|
|
125 instance Eq WildPat where |
|
|
126 WildPat p == WildPat p' = p == p' |
|
|
127 |
|
|
128 instance Arbitrary WildChar where |
|
|
129 arbitrary = |
|
|
130 oneof (map return |
|
|
131 (map RawChar "abc?*[]" ++ |
|
|
132 [AnyChar, AnyString] ++ |
|
|
133 map AnyCharIn ["", "a", "bc", "bbc", "[]", "*?"])) |
|
16
|
134 |
|
17
|
135 instance Arbitrary WildPat where |
|
|
136 arbitrary = |
|
|
137 do ws <- arbitrary |
|
|
138 return $ WildPat ws |
|
|
139 |
|
|
140 metas = "?*[]" |
|
|
141 |
|
|
142 isWildCharSafe (RawChar c) = c `notElem` metas |
|
|
143 isWildCharSafe (AnyCharIn cs) = all (`notElem` metas) cs |
|
|
144 isWildCharSafe _ = True |
|
|
145 |
|
|
146 isWildPatSafe (WildPat ws) = all isWildCharSafe ws |
|
|
147 |
|
|
148 -- Properties |
|
|
149 |
|
|
150 prop_stringFromWildPatFromString s = |
|
|
151 stringFromWildPat (wildPatFromString s) == s |
|
|
152 |
|
|
153 prop_wildPatFromStringFromWildPat p = |
|
|
154 isWildPatSafe p ==> wildPatFromString (stringFromWildPat p) == p |
|
16
|
155 |
|
|
156 |
|
|
157 {- 6. -} |
|
|
158 {- |
|
|
159 G4.4 |
|
|
160 |
|
|
161 match [] ys = null ys |
|
|
162 match ('?':ps) (y:ys) = match ps ys |
|
|
163 match ('*':ps) [] = match ps [] |
|
|
164 match ('*':ps) (y:ys) = match ps (y:ys) || match ('*':ps) ys |
|
|
165 match (p:ps) (y:ys) = p == y && match ps ys |
|
|
166 match ps [] = False |
|
|
167 -} |
|
|
168 |
|
|
169 matchWildChars :: [WildChar] -> String -> Bool |
|
17
|
170 matchWildChars [] ys = null ys |
|
|
171 matchWildChars (AnyChar:ps) (y:ys) = matchWildChars ps ys |
|
|
172 matchWildChars (AnyString:ps) [] = matchWildChars ps [] |
|
|
173 matchWildChars (AnyString:ps) (y:ys) = matchWildChars ps (y:ys) |
|
|
174 || matchWildChars (AnyString:ps) ys |
|
|
175 matchWildChars ((AnyCharIn cs):ps) (y:ys) = elem y cs && matchWildChars ps ys |
|
|
176 matchWildChars ((RawChar c):ps) (y:ys) = c == y && matchWildChars ps ys |
|
|
177 matchWildChars ps [] = False |
|
16
|
178 |
|
|
179 |
|
|
180 matchWildPat :: WildPat -> String -> Bool |
|
|
181 matchWildPat (WildPat ws) = matchWildChars ws |
|
|
182 |
|
17
|
183 match ps ms = matchWildPat (wildPatFromString ps) ms |
|
16
|
184 |
|
|
185 |
|
|
186 |
|
|
187 {---------------------------------------------------------------------} |
|
|
188 {- Aufgabe G7.2 -} |
|
|
189 |
|
17
|
190 -- Beispiel für Rekursion über einen binären Suchbaum |
|
|
191 smallest :: Ord a => Tree a -> Maybe a |
|
|
192 smallest Empty = Nothing |
|
|
193 smallest (Node v Empty _) = Just v |
|
|
194 smallest (Node _ l _) = smallest l |
|
|
195 |
|
|
196 --- |
|
|
197 |
|
|
198 listToSortedTree :: Ord a => [a] -> Tree a |
|
|
199 --listToSortedTree xs = foldl (\tree x -> insert x tree) Empty xs |
|
|
200 listToSortedTree xs = foldl (flip insert) Empty xs |
|
|
201 |
|
|
202 |
|
|
203 inorder :: Ord a => Tree a -> [a] |
|
|
204 inorder Empty = [] |
|
|
205 inorder (Node v l r) = inorder l ++ [v] ++ inorder r |
|
16
|
206 |
|
|
207 |
|
|
208 treeSort :: Ord a => [a] -> [a] |
|
17
|
209 treeSort = inorder . listToSortedTree |
|
|
210 |
|
|
211 --- |
|
16
|
212 |
|
17
|
213 -- Properties |
|
|
214 -- treeSort sortiert |
|
|
215 prop_treeSort_isSorted ps = |
|
|
216 let ts = treeSort ps in ts == sort ts |
|
|
217 |
|
|
218 -- treeSort entfernt keine Elemente |
|
|
219 prop_treeSort_isComplete ps = |
|
|
220 eqSet (nub ps) (treeSort ps) |
|
|
221 where |
|
|
222 eqSet xs ys = null (xs \\ ys) && null (ys \\ xs) |
|
16
|
223 |
|
|
224 |
|
|
225 {---------------------------------------------------------------------} |
|
|
226 {- Aufgabe G7.3 -} |
|
|
227 |
|
17
|
228 htmlChar :: Char -> String |
|
|
229 htmlChar c |
|
|
230 | o < 128 = [c] |
|
|
231 | otherwise = "&" ++ entity ++ ";" |
|
|
232 where |
|
|
233 o = ord c |
|
|
234 entity = |
|
|
235 case lookup o swissLetters of |
|
|
236 Nothing -> show o |
|
|
237 Just name -> name |
|
|
238 |
|
|
239 |
|
16
|
240 plainHtml :: Html -> String |
|
17
|
241 plainHtml (Text cs) = concatMap htmlChar cs |
|
|
242 plainHtml (Block name bs) = "<" ++ name ++ ">" ++ concatMap plainHtml bs ++ "</" ++ name ++ ">" |
|
16
|
243 |
|
|
244 |
|
|
245 |
|
|
246 {---------------------------------------------------------------------} |
|
|
247 {- Aufgabe H7.1 -} |
|
|
248 |
|
|
249 prettyHtml :: Int -> Html -> String |
|
|
250 prettyHtml = undefined |
|
|
251 |
|
|
252 |
|
|
253 |
|
|
254 {---------------------------------------------------------------------} |
|
|
255 {- Aufgabe H7.2 -} |
|
|
256 |
|
|
257 plainDirTree :: Show a => DirTree a -> String |
|
|
258 plainDirTree = undefined |
|
|
259 |
|
|
260 |
|
|
261 prettyDirTree :: Show a => DirTree a -> String |
|
|
262 prettyDirTree = undefined |
|
|
263 |
|
|
264 |
|
|
265 |
|
|
266 {---------------------------------------------------------------------} |
|
|
267 {- Aufgabe H7.3 -} |
|
|
268 |
|
|
269 {-WETT-} |
|
|
270 unscrambleWords :: [String] -> [String] -> [String] |
|
|
271 unscrambleWords = undefined |
|
|
272 {-TTEW-} |
