# HG changeset patch
# User Markus Kaiser <markus.kaiser@in.tum.de>
# Date 1354285113 -3600
# Node ID 73170284e0092fe91f127904bd3081b947c71f85
# Parent  7acf82c8fb3a3b88ce83ab5fcb739238b6e496cb
week 7 tutorial

diff -r 7acf82c8fb3a -r 73170284e009 exercises/src/Exercise_7.hs
--- a/exercises/src/Exercise_7.hs	Wed Nov 28 22:42:29 2012 +0100
+++ b/exercises/src/Exercise_7.hs	Fri Nov 30 15:18:33 2012 +0100
@@ -10,15 +10,21 @@
   Node a (Tree a) (Tree a)
     deriving (Eq, Show)
 
+tree =  (Node 4
+         (Node 2 (Node 1 Empty Empty) (Node 3 Empty Empty))
+         (Node 6 (Node 5 Empty Empty) (Node 7 Empty Empty)))
+
+insert :: Ord a => a -> Tree a -> Tree a
+insert x Empty = Node x Empty Empty
+insert x (Node a l r)
+        | x < a = Node a (insert x l) r
+        | a < x = Node a l (insert x r)
+        | otherwise = Node a l r
+
 data Html =
   Text String |
   Block String [Html]
 
-swissLetters :: [(Int, String)]
-swissLetters =
-  [(196, "Auml"), (214, "Ouml"), (220, "Uuml"),
-   (228, "auml"), (246, "ouml"), (252, "uuml")]
-
 grueezi =
   Block "html"
     [Block "head"
@@ -29,6 +35,19 @@
        [Block "h1" [Text "Gr\252ezi!"],
         Block "p" [Text "\196b\228, genau. Sal\252. Bis sp\246ter!"]]]
 
+kleiner =
+  Block "html"
+    [Block "a"
+        [Text "Hallo"],
+     Block "b"
+        [Text "du da!"]
+    ]
+
+swissLetters :: [(Int, String)]
+swissLetters =
+  [(196, "Auml"), (214, "Ouml"), (220, "Uuml"),
+   (228, "auml"), (246, "ouml"), (252, "uuml")]
+
 data DirTree a =
   File a |
   Dir a [DirTree a]
@@ -46,7 +65,10 @@
 
 {- 1. -}
 data WildChar =
-  Missing
+  AnyChar |
+  AnyString |
+  RawChar Char |
+  AnyCharIn [Char]
 
 
 data WildPat =
@@ -55,11 +77,14 @@
 
 {- 2. -}
 stringFromWildChar :: WildChar -> String
-stringFromWildChar = undefined
+stringFromWildChar AnyChar        = "?"
+stringFromWildChar AnyString      = "*"
+stringFromWildChar (RawChar c)    = [c]
+stringFromWildChar (AnyCharIn cs) = "[" ++ cs ++ "]"
 
 
 stringFromWildPat :: WildPat -> String
-stringFromWildPat (WildPat ws) = undefined
+stringFromWildPat (WildPat ws) = concatMap stringFromWildChar ws
 
 
 {- 3. -}
@@ -72,16 +97,61 @@
 
 {- 4. -}
 wildCharsFromString :: String -> [WildChar]
-wildCharsFromString = undefined
+wildCharsFromString [] = []
+wildCharsFromString (c : cs)
+        | c == '?' = AnyChar : ps
+        | c == '*' = AnyString : ps
+        | c == '[' =
+                case dropWhile (/= ']') cs of
+                []       -> RawChar '[' : ps
+                _ : rest -> AnyCharIn (takeWhile (/= ']') cs) :
+                                wildCharsFromString rest
+        | otherwise = RawChar c : ps
+        where ps = wildCharsFromString cs
 
 wildPatFromString :: String -> WildPat
 wildPatFromString cs = WildPat (wildCharsFromString cs)
 
 
 {- 5. -}
-prop_stringFromWildPatFromString s = undefined
+-- WildChar und WildPat QuickCheckkompatibel machen
+instance Eq WildChar where
+  RawChar c == RawChar c' = c == c'
+  AnyChar == AnyChar = True
+  AnyString == AnyString = True
+  AnyCharIn cs == AnyCharIn cs' = cs == cs'
+  _ == _ = False
+
+instance Eq WildPat where
+  WildPat p == WildPat p' = p == p'
+
+instance Arbitrary WildChar where
+  arbitrary =
+    oneof (map return
+      (map RawChar "abc?*[]" ++
+       [AnyChar, AnyString] ++
+       map AnyCharIn ["", "a", "bc", "bbc", "[]", "*?"]))
 
-prop_wildPatFromStringFromWildPat p = undefined
+instance Arbitrary WildPat where
+  arbitrary =
+    do ws <- arbitrary
+       return $ WildPat ws
+
+metas = "?*[]"
+
+isWildCharSafe (RawChar c) = c `notElem` metas
+isWildCharSafe (AnyCharIn cs) = all (`notElem` metas) cs
+isWildCharSafe _ = True
+
+isWildPatSafe (WildPat ws) = all isWildCharSafe ws
+
+-- Properties
+
+prop_stringFromWildPatFromString s =
+  stringFromWildPat (wildPatFromString s) == s
+
+prop_wildPatFromStringFromWildPat p =
+  isWildPatSafe p ==> wildPatFromString (stringFromWildPat p) == p
 
 
 {- 6. -}
@@ -97,37 +167,79 @@
 -}
 
 matchWildChars :: [WildChar] -> String -> Bool
-matchWildChars = undefined
+matchWildChars [] ys                      = null ys
+matchWildChars (AnyChar:ps) (y:ys)        = matchWildChars ps ys
+matchWildChars (AnyString:ps) []          = matchWildChars ps []
+matchWildChars (AnyString:ps) (y:ys)      = matchWildChars ps (y:ys)
+                                             || matchWildChars (AnyString:ps) ys
+matchWildChars ((AnyCharIn cs):ps) (y:ys) = elem y cs && matchWildChars ps ys
+matchWildChars ((RawChar c):ps) (y:ys)    = c == y && matchWildChars ps ys
+matchWildChars ps []                      = False
 
 
 matchWildPat :: WildPat -> String -> Bool
 matchWildPat (WildPat ws) = matchWildChars ws
 
-match = matchWildPat . wildPatFromString
+match ps ms = matchWildPat (wildPatFromString ps) ms
 
 
 
 {---------------------------------------------------------------------}
 {- Aufgabe G7.2 -}
 
-insert :: Ord a => a -> Tree a -> Tree a
-insert x Empty = Node x Empty Empty
-insert x (Node a l r)
-        | x < a = Node a (insert x l) r
-        | a < x = Node a l (insert x r)
-        | otherwise = Node a l r
+-- Beispiel für Rekursion über einen binären Suchbaum
+smallest :: Ord a => Tree a -> Maybe a
+smallest Empty            = Nothing
+smallest (Node v Empty _) = Just v
+smallest (Node _ l _)     = smallest l
+
+---
+
+listToSortedTree :: Ord a => [a] -> Tree a
+--listToSortedTree xs = foldl (\tree x -> insert x tree) Empty xs
+listToSortedTree xs = foldl (flip insert) Empty xs
+
+
+inorder :: Ord a => Tree a -> [a]
+inorder Empty        = []
+inorder (Node v l r) = inorder l ++ [v] ++ inorder r
 
 
 treeSort :: Ord a => [a] -> [a]
-treeSort = undefined
+treeSort = inorder . listToSortedTree
+
+---
 
+-- Properties
+-- treeSort sortiert
+prop_treeSort_isSorted ps =
+        let ts = treeSort ps in ts == sort ts
+
+-- treeSort entfernt keine Elemente
+prop_treeSort_isComplete ps =
+        eqSet (nub ps) (treeSort ps)
+        where
+        eqSet xs ys = null (xs \\ ys) && null (ys \\ xs)
 
 
 {---------------------------------------------------------------------}
 {- Aufgabe G7.3 -}
 
+htmlChar :: Char -> String
+htmlChar c
+        | o < 128 = [c]
+        | otherwise = "&" ++ entity ++ ";"
+        where
+        o = ord c
+        entity =
+                case lookup o swissLetters of
+                        Nothing ->   show o
+                        Just name -> name
+
+
 plainHtml :: Html -> String
-plainHtml = undefined
+plainHtml (Text cs)       = concatMap htmlChar cs
+plainHtml (Block name bs) = "<" ++ name ++ ">" ++ concatMap plainHtml bs ++ "</" ++ name ++ ">"