Mercurial > 12ws.info2

comparison exercises/src/Exercise_7.hs @ 17:73170284e009

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
week 7 tutorial
author Markus Kaiser <markus.kaiser@in.tum.de>
date Fri, 30 Nov 2012 15:18:33 +0100
parents 7acf82c8fb3a
children
comparison
equal deleted inserted replaced
16:7acf82c8fb3a 17:73170284e009
8 data Tree a = 8 data Tree a =
9 Empty | 9 Empty |
10 Node a (Tree a) (Tree a) 10 Node a (Tree a) (Tree a)
11 deriving (Eq, Show) 11 deriving (Eq, Show)
12 12
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
13 data Html = 24 data Html =
14 Text String | 25 Text String |
15 Block String [Html] 26 Block String [Html]
16
17 swissLetters :: [(Int, String)]
18 swissLetters =
19 [(196, "Auml"), (214, "Ouml"), (220, "Uuml"),
20 (228, "auml"), (246, "ouml"), (252, "uuml")]
21 27
22 grueezi = 28 grueezi =
23 Block "html" 29 Block "html"
24 [Block "head" 30 [Block "head"
25 [Block "author" [Text "der MC"], 31 [Block "author" [Text "der MC"],
27 Block "topsecret" []], 33 Block "topsecret" []],
28 Block "body" 34 Block "body"
29 [Block "h1" [Text "Gr\252ezi!"], 35 [Block "h1" [Text "Gr\252ezi!"],
30 Block "p" [Text "\196b\228, genau. Sal\252. Bis sp\246ter!"]]] 36 Block "p" [Text "\196b\228, genau. Sal\252. Bis sp\246ter!"]]]
31 37
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
32 data DirTree a = 51 data DirTree a =
33 File a | 52 File a |
34 Dir a [DirTree a] 53 Dir a [DirTree a]
35 deriving (Eq, Show) 54 deriving (Eq, Show)
36 55
44 {---------------------------------------------------------------------} 63 {---------------------------------------------------------------------}
45 {- Aufgabe G7.1 -} 64 {- Aufgabe G7.1 -}
46 65
47 {- 1. -} 66 {- 1. -}
48 data WildChar = 67 data WildChar =
49 Missing 68 AnyChar |
69 AnyString |
70 RawChar Char |
71 AnyCharIn [Char]
50 72
51 73
52 data WildPat = 74 data WildPat =
53 WildPat [WildChar] 75 WildPat [WildChar]
54 76
55 77
56 {- 2. -} 78 {- 2. -}
57 stringFromWildChar :: WildChar -> String 79 stringFromWildChar :: WildChar -> String
58 stringFromWildChar = undefined 80 stringFromWildChar AnyChar = "?"
81 stringFromWildChar AnyString = "*"
82 stringFromWildChar (RawChar c) = [c]
83 stringFromWildChar (AnyCharIn cs) = "[" ++ cs ++ "]"
59 84
60 85
61 stringFromWildPat :: WildPat -> String 86 stringFromWildPat :: WildPat -> String
62 stringFromWildPat (WildPat ws) = undefined 87 stringFromWildPat (WildPat ws) = concatMap stringFromWildChar ws
63 88
64 89
65 {- 3. -} 90 {- 3. -}
66 instance Show WildChar where 91 instance Show WildChar where
67 show = stringFromWildChar 92 show = stringFromWildChar
70 show = stringFromWildPat 95 show = stringFromWildPat
71 96
72 97
73 {- 4. -} 98 {- 4. -}
74 wildCharsFromString :: String -> [WildChar] 99 wildCharsFromString :: String -> [WildChar]
75 wildCharsFromString = undefined 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
76 111
77 wildPatFromString :: String -> WildPat 112 wildPatFromString :: String -> WildPat
78 wildPatFromString cs = WildPat (wildCharsFromString cs) 113 wildPatFromString cs = WildPat (wildCharsFromString cs)
79 114
80 115
81 {- 5. -} 116 {- 5. -}
82 prop_stringFromWildPatFromString s = undefined 117 -- WildChar und WildPat QuickCheckkompatibel machen
83 118 instance Eq WildChar where
84 prop_wildPatFromStringFromWildPat p = undefined 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", "[]", "*?"]))
134
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
85 155
86 156
87 {- 6. -} 157 {- 6. -}
88 {- 158 {-
89 G4.4 159 G4.4
95 match (p:ps) (y:ys) = p == y && match ps ys 165 match (p:ps) (y:ys) = p == y && match ps ys
96 match ps [] = False 166 match ps [] = False
97 -} 167 -}
98 168
99 matchWildChars :: [WildChar] -> String -> Bool 169 matchWildChars :: [WildChar] -> String -> Bool
100 matchWildChars = undefined 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
101 178
102 179
103 matchWildPat :: WildPat -> String -> Bool 180 matchWildPat :: WildPat -> String -> Bool
104 matchWildPat (WildPat ws) = matchWildChars ws 181 matchWildPat (WildPat ws) = matchWildChars ws
105 182
106 match = matchWildPat . wildPatFromString 183 match ps ms = matchWildPat (wildPatFromString ps) ms
107 184
108 185
109 186
110 {---------------------------------------------------------------------} 187 {---------------------------------------------------------------------}
111 {- Aufgabe G7.2 -} 188 {- Aufgabe G7.2 -}
112 189
113 insert :: Ord a => a -> Tree a -> Tree a 190 -- Beispiel für Rekursion über einen binären Suchbaum
114 insert x Empty = Node x Empty Empty 191 smallest :: Ord a => Tree a -> Maybe a
115 insert x (Node a l r) 192 smallest Empty = Nothing
116 | x < a = Node a (insert x l) r 193 smallest (Node v Empty _) = Just v
117 | a < x = Node a l (insert x r) 194 smallest (Node _ l _) = smallest l
118 | otherwise = Node a l r 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
119 206
120 207
121 treeSort :: Ord a => [a] -> [a] 208 treeSort :: Ord a => [a] -> [a]
122 treeSort = undefined 209 treeSort = inorder . listToSortedTree
123 210
211 ---
212
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)
124 223
125 224
126 {---------------------------------------------------------------------} 225 {---------------------------------------------------------------------}
127 {- Aufgabe G7.3 -} 226 {- Aufgabe G7.3 -}
128 227
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
129 plainHtml :: Html -> String 240 plainHtml :: Html -> String
130 plainHtml = undefined 241 plainHtml (Text cs) = concatMap htmlChar cs
242 plainHtml (Block name bs) = "<" ++ name ++ ">" ++ concatMap plainHtml bs ++ "</" ++ name ++ ">"
131 243
132 244
133 245
134 {---------------------------------------------------------------------} 246 {---------------------------------------------------------------------}
135 {- Aufgabe H7.1 -} 247 {- Aufgabe H7.1 -}