FFP - 06 (partially) & 06b

2 files changed, 449 insertions, 0 deletions

diff --git a/ws2015/ffp/blaetter/06/FFP_U06_Monaden.hs b/ws2015/ffp/blaetter/06/FFP_U06_Monaden.hs
new file mode 100644
index 0000000..f444ad0
--- /dev/null
+++ b/ws2015/ffp/blaetter/06/FFP_U06_Monaden.hs
@@ -0,0 +1,193 @@
+-- Fortgeschrittene Funktionale Programmierung, 
+--   LMU, TCS, Wintersemester 2015/16
+--   Steffen Jost, Alexander Isenko
+--
+-- Übungsblatt 06a. 25.11.2015
+--
+-- Thema: Monaden-Gesetze, Erste Schritte mit Monaden und Do-Notation
+--
+-- Hier machen wir ein paar erste Schritte mit Monaden.
+-- Wer das alles schon kennt und bereits von woanders her 
+-- mit der Do-Notation vertraut ist, sollte stattessen 
+-- die B-Version dieses Übungsblattes machen: 
+-- einen applikativen Parser bauen.
+-- 
+-- Gehen Sie diese Datei durch und bearbeiten Sie 
+-- alle Vorkommen von undefined bzw. die mit -- !!! TODO !!!
+-- markierten Stellen. Testen Sie Ihre Lösungen mit GHCi!
+
+
+---- A6-1 Monaden Gesetze nachweisen
+-- 
+--
+-- a)
+-- Auf Folie 04-42 fehlt der Beweis für die Assoziativität
+-- Maybe-Instanz für die Typklasse Monad. 
+-- Führen Sie den Beweis aus!
+-- (Geht ganz analog zu den anderen beiden Beweisen, d.h.
+--  Definitionen ausfalten und umformen.
+--  Bei Abgabe: Bitte zusätzlich kurze Begründung für jeden Schritt angeben!)
+{-
+Zu Zeigen: 
+  Ausdruck
+    m >>= (\x-> ((f x) >>= g))
+  ist gleich zu
+    (m >>= f) >>= g
+-}  
+
+-- !!! TODO !!!
+
+
+-- b)
+{- Beweisen Sie, dass folgende Definition 
+  
+    instance Monad [] where
+      return x = [x]                   -- (Mo1)
+      xs >>= f = concat (map f xs)     -- (Mo2)
+  
+  das Monaden-Gesetz "Links-Identität" einhält!  
+ 
+  Folgende Definition sind dabei eventuell nützlich:
+
+    concat :: [[a]] -> [a]
+    concat []       = []               -- (CcN)
+    concat (xs:xss) = xs ++ concat xss -- (CcC)
+
+    (++) :: [a] -> [a] -> [a]
+    (++) xs     [] = xs                -- (ANr)
+    (++) []     ys = ys                -- (ANl)
+    (++) (x:xs) ys = x : (xs ++ ys)    -- (ACl)
+
+    map :: (a -> b) -> [a] -> [b]
+    map _   []   =                     -- (MpN)
+    map f (x:xs) = (f x) : (map f xs)  -- (MpC)
+-}
+
+-- !!! TODO !!!
+
+
+
+
+---- A6-2 Either-Monade und Do-Notation
+--
+-- In der vorletzten Vorlesung am 12.11. haben wir gesehen
+-- wie der Datentyp Either der Standardbibliothek zum 
+-- Funktor gemacht werden kann. 
+--
+-- Machen Sie diesen Datentyp nun zu einer Monade!
+-- Um Namenskonflikten aus dem Weg zu gehen,
+-- definieren wir Either einfach noch mal neu:
+
+data Entweder a b = Eines a | Anderes b
+  deriving (Show, Eq)
+
+-- Die Idee ist dabei die gleiche wie bei Maybe,
+-- nur das "Nothing" hier noch einen Wert tragen kann.
+
+instance Functor (Entweder a) where
+  fmap f (Anderes x) = Anderes $ f x
+  fmap _ (Eines x) = Eines x -- Because x@(Either a b) is not (Either a c), even if we can prove that x is Left.
+
+instance Applicative (Entweder a) where
+  pure = Anderes
+  (Anderes f) <*> (Anderes x) = Anderes $ f x
+  (Eines x) <*> _ = Eines x -- ditto
+  _ <*> (Eines x) = Eines x
+
+instance Monad (Entweder a) where
+  (Anderes a) >>= f = f a
+  (Eines x) >>= _ = Eines x -- ditto
+
+-- Applicative Tests:
+-- (*) <$> (Anderes 3) <*> (Anderes 4)
+-- (*) <$> (Eines   3) <*> (Anderes 4)
+-- (*) <$> (Anderes 3) <*> (Eines 4)
+
+  
+-- b)
+-- Verallgemeinern Sie folgende gewöhnlichen Funktionsdefinition,
+-- welche Kenntnis des Typs Entweder voraussetzen.
+-- Schreiben Sie jeweils eine generische Fassung,
+-- welche nur die Monaden-Instanz oder, wenn möglich, 
+-- nur Applicative voraussetzt:
+
+-- b1) Beispiel:
+multEnt :: (Num b) => (Entweder a b) -> (Entweder a b) -> (Entweder a b)
+multEnt (Anderes x) (Anderes y) = Anderes (x * y)
+multEnt (Anderes _) other       = other
+multEnt other       _           = other
+
+
+multEnt_M :: (Num b, Monad m) => m b -> m b -> m b
+multEnt_M = multEnt_A -- The monad-applicative proposal was implemented ;-)
+
+multEnt_A :: (Num b, Applicative f) => f b -> f b -> f b
+multEnt_A a b = (*) <$> a <*> b
+
+
+-- b2)
+foo :: (Entweder a (b->c)) -> (Entweder a b) -> (Entweder a c)
+foo (Anderes f) (Anderes x) = Anderes $ f x
+foo (Eines a) _ = Eines a
+foo _ (Eines a) = Eines a
+
+foo_M :: (Monad m) => (m (b->c)) -> (m b) -> (m c)
+foo_M = foo_A
+
+foo_A :: (Applicative m) => (m (b->c)) -> (m b) -> (m c)
+foo_A f x = ($) <$> f <*> x
+
+
+-- b3)
+ifM :: (Entweder a Bool) -> (Entweder a b) -> (Entweder a b) -> (Entweder a b)
+ifM (Anderes True)  x _ = x
+ifM (Anderes False) _ y = y
+ifM (Eines a)       _ _ = Eines a
+
+ifM_M :: (Monad m) => m Bool -> m b -> m b -> m b
+ifM_M = ifM_A
+ifM_A :: (Applicative f) => f Bool -> f b -> f b -> f b
+ifM_A b x y = bool <$> x <*> y <*> b
+
+
+
+bool :: a -> a -> Bool -> a
+-- ^ This should really be in Prelude (Data.Bool at least)
+bool x _ True = x
+bool _ x False = x
+
+
+
+---- A6-3 Do - Notation
+--
+-- Implementieren Sie folgende Funktion unter Verwendung der Do-Notation:
+-- Hinweis: Einfach den Typen folgen, alles andere kommt von allein!
+  
+filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]
+filterM p = foldr trav (return [])
+  where
+    trav x xs = bool (x :) id <$> p x <*> xs -- Applicative is cooler than do notation ;-)
+
+    trav' x xs = do -- But if I must …
+      include <- p x
+      xs' <- xs
+      return $ case include of
+        True -> x : xs'
+        False -> xs'
+
+-- Beispiele zum Testen:
+silly1 :: Int -> Maybe Bool
+silly1 0 = Nothing
+silly1 x = Just $ even x
+
+silly2 :: Int -> [Bool]
+silly2 0 = []
+silly2 x | even x    = [False,True,True,False]
+         | otherwise = [False,False]
+
+-- > filterM silly [1..10]
+-- Just [2,4,6,8,10]
+  
+-- > filterM silly $ [1..10]++[1,0,1]
+-- Nothing
+ 
diff --git a/ws2015/ffp/blaetter/06/FFP_U06b_ApplParse.hs b/ws2015/ffp/blaetter/06/FFP_U06b_ApplParse.hs
new file mode 100644
index 0000000..b63e800
--- /dev/null
+++ b/ws2015/ffp/blaetter/06/FFP_U06b_ApplParse.hs
@@ -0,0 +1,256 @@
+-- Fortgeschrittene Funktionale Programmierung,
+--   LMU, TCS, Wintersemester 2015/16
+--   Steffen Jost, Alexander Isenko
+--
+-- Übungsblatt 06b. 25.11.2015
+--
+-- Thema: Applikativer Parser
+--
+-- Als Beispiel betrachten wir hier einen primitiven applikativen Parser.
+-- Alles wesentliche liegt in dieser Datei vor. 
+-- Dies hat den Nachteil, dass es die Datei aufbläht;
+-- aber auch den Vorteil, dass man genau sehen kann wie alles funktioniert.
+-- Also nicht abschrecken lassen, Ihr müsst hier nicht alle Details verstehen!
+--
+-- Die Funktionen orientieren sich an den Modulen Text.Parsec 
+-- und Text.ParserCombinators.ReadP welche zwei verschiedene 
+-- monadische Parser zur Verfügung stellen, d.h. dieses Beispiel
+-- könnte man auch tatsächlich nutzen, um einen richtigen Parser zu schreiben.
+-- Beide Module setzen jedoch entgegen der vereinfachten Version hier
+-- eine volle Monade ein, anstatt lediglich einen applikativen 
+-- Funktor zu verwenden, welcher auch ausreicht!
+--
+-- Aufgabenstellung folgt in Zeile 169
+-- 
+
+import Data.Maybe
+import Data.Char as Char
+import Data.Functor
+import Control.Applicative
+import Data.Traversable
+
+-- newtype eines Parser wird für Instanzdeklarationen benötigt
+newtype Parser a = Parser (String -> [(a,String)])
+
+runParser :: Parser a -> String -> [(a,String)]
+runParser (Parser p) s = p s
+
+runParserComplete :: Parser a -> String -> [a]
+runParserComplete (Parser p) s = [ r |(r,"") <- p s]
+
+parse :: Parser a -> String -> Maybe a -- returns first complete parse
+parse p s = listToMaybe $ runParserComplete p s
+
+-- Die Instanzdeklarationen
+instance Functor Parser where
+  fmap f (Parser p) = Parser $ \s -> map (\(a,b) -> (f a, b)) $ p s
+  
+instance Applicative Parser where
+  -- pure :: a -> Parser a -- konsumiert keine Eingabe und liefer immer ein Ergebnis
+  pure x = Parser $ \s -> [(x,s)]
+  
+  -- <*> :: Parser (a -> b) -> Parser a -> Parser b -- parsed eine Funktion und aus dem Rest der Eingabe ein Argument für diese Funktion und liefert das Ergebnis
+  (Parser p1) <*> (Parser p2) = Parser $ \inp ->
+    [(r1 r2, rem2) | (r1,rem1) <- p1 inp, (r2,rem2) <- p2 rem1]
+
+-- Ebenfalls in Modul Control.Applicative definiert:
+-- Typklasse Alternative ist eine Unterklasse für Applikative Funktoren 
+-- mit Monoid-Strultur, d.h.: es gibt eine binäre Verküpfung mit neutralem Element!
+instance Alternative Parser where
+  -- empty :: Parser a -- neutrales Element, ein Parser der immer fehlschlägt
+  empty = Parser $ \s -> []
+  
+  -- <|> :: Parser a -> Parser a -> Parser a -- verknüpft zwei Parser zu einem Parser, welcher beides alternativ parsen kann
+  (Parser p1) <|> (Parser p2) = Parser pbranches
+    where
+      pbranches s 
+        | null r1   = r2
+        | null r2   = r1
+        | otherwise = r1 ++ r2        
+        where
+          r1 = p1 s
+          r2 = p2 s
+
+-- Basic Parsers          
+satisfy :: (Char -> Bool) -> Parser Char -- parse a desired character
+satisfy p = Parser check
+  where 
+    check (c:s) | p c = [(c,s)] -- successful
+    check   _         = [     ] -- no parse
+
+char :: Char -> Parser Char -- parse a certain character
+char c = satisfy (c ==)
+
+space :: Parser Char -- exactly one space character
+space = satisfy isSpace  
+
+alpha :: Parser Char -- any alpha chars (no numbers or special symbols)
+alpha = satisfy isAlpha
+
+upper :: Parser Char
+upper = satisfy isUpper
+
+lower :: Parser Char
+lower = satisfy isLower
+
+digit :: Parser Int
+digit = n2n <$> satisfy isDigit
+  where 
+    n2n '0' = 0
+    n2n '1' = 1
+    n2n '2' = 2
+    n2n '3' = 3
+    n2n '4' = 4
+    n2n '5' = 5
+    n2n '6' = 6
+    n2n '7' = 7
+    n2n '8' = 8
+    n2n '9' = 9
+
+-- Zusammengesetze Parser
+string :: Parser String -- acccepts any string
+string = some (satisfy $ (\_ -> True)) 
+    
+keyword :: String -> Parser String -- accepts only a certain string
+keyword = traverse char 
+
+name :: Parser String -- akzeptiert alle Strings aus Buchstaben
+name = some $ satisfy isAlpha
+
+name1 :: Parser String -- akzeptiert alle Strings aus Buchstaben mit großen Anfangsbuchstaben
+name1 = (:) <$> (satisfy isUpper) <*> (many $ satisfy isAlpha)
+
+skipSpaces  :: Parser ()  -- zero or more spaces skipped
+skipSpaces  = (\_ -> ()) <$> many space
+
+skipSpaces1 :: Parser () -- one or more spaces skipped
+skipSpaces1 = (\_ -> ()) <$> some space
+
+natural :: Parser Int -- parse natural number
+natural = accum <$> some digit
+  where 
+    accum = foldl (\a n -> n + a*10)  0
+    
+ptwo  :: Parser a -> Parser b -> Parser (a,b) -- parse 2-tupel
+ptwo p1 p2 = (,) <$> p1 <*> p2
+
+pPair :: Parser a -> Parser b -> Parser (a,b) -- parse (,)-encased pair
+pPair p1 p2 = (,) <$> (char '(' *> p1 <* char ',') <*> p2 <* char ')'
+    
+
+{- instance Functor ((,) a) is defined in `GHC.Base'
+mapSnd :: (b -> c) -> (a,b) -> (a,c)
+mapSnd f (x,y) = (x,(f y))
+-}
+
+
+-- Beispiele:
+--
+-- > parse upper "A"
+-- Just 'A'
+--
+-- > parse upper "AB"
+-- Nothing
+--
+-- > runParser upper "AB"
+-- [('A',"B")]
+--
+-- > runParser natural "12a"
+-- [(12,"a"),(1,"2a")]
+--
+-- > runParser (ptwo natural string) "12a"
+-- [((12,"a"),""),((1,"2a"),""),((1,"2"),"a")]
+
+
+
+-- AUFGABE 6-4
+-- 
+-- Die geforderten Lösungen sind alles Einzeiler,
+-- welche im wesentlichen <$> und <*> einsetzen.
+-- Als Muster sollten Sie sich die Funktionen ptwo, name1 und später evtl. pPair anschauen!
+-- 
+-- a)
+-- Schreiben Sie einen Parser für den Typ Person:
+data Person = Person String                     deriving (Eq, Show)
+
+-- Namen dürfen nur aus Buchstaben bestehen und müssen mit Großbuchstaben beginnen.
+--
+-- Hinweis: schauen Sie sich die Funktionen name und name1 an.
+-- Diese können Sie nicht nur verwenden, sondern dienen auch als Beispiel.
+--
+-- Zusatz: Ihr Parser verlangt zuerst das Schlüsselwort "Person" vor dem eigentlichen Namen
+--         Schlagen Sie dazu die Funktion *> im Modul Control.Applicative nach!
+
+-- Beispiele:
+--   > parse pPerson "Fred"
+--   Just (Person "Fred")
+--
+--   > runParser pPerson "Fred"
+--   [(Person "Fred",""),(Person "Fre","d"),(Person "Fr","ed"),(Person "F","red")]
+--
+--   > parse pPerson2 "Person Fred"
+--   Just (Person "Fred")
+-- 
+--   > parse pPerson2 "Fred"
+--   Nothing
+
+pPerson1 :: Parser Person
+pPerson1 = Person <$> name1
+
+pPerson2 :: Parser Person
+pPerson2 = keyword "Person" *> skipSpaces *> pPerson1
+
+
+-- b) Parsen Sie einen Student mit Matrikelnummer:
+data Student    = Student String Int                deriving (Eq, Show)
+
+-- Zusatz: Ihr Parser verlangt zuerst das Schlüsselwort "Student" vor dem eigentlichen Namen
+--         und erlaubt (oder fordert) Leerzeichen zwischen Student, Namen und Nummer!
+--         skipSpaces und skipSpaces1 helfen hier weiter!
+
+pStudent1 :: Parser Student
+pStudent1 = Student <$> name1 <* skipSpaces <*> natural
+
+pStudent2 :: Parser Student
+pStudent2 = keyword "Student" *> skipSpaces *> pStudent1
+
+-- Beispiele:
+--   > parse pStudent1 "Fred0123"
+--   Just (Student "Fred012" 3)
+-- 
+--   > parse pStudent2 "Student Fred 0123"
+--   Just (Student "Fred" 123)
+-- 
+--   > parse pStudent2 "StudentFred0123"
+--   Nothing
+
+
+-- c) Parsen Sie einen (Hochschul-)Lehrer:
+data Lehrer     = Prof String | Dozent Titel String deriving (Eq, Show)
+data Titel      = Dr | Herr                         deriving (Eq, Show)
+-- Verwenden Sie dazu die Funktion <|>, welche Sie ebenfalls in Modul Control.Applicative nachschlagen können!
+-- Es ist dazu hilfreich, mehrere einzelne Funktionen zu schreiben, 
+-- wie hier im Gerüst vorgegeben. (Das ist aber kein Zwang!)
+
+prof :: Parser Lehrer
+prof = Prof <$ keyword "Prof" <* skipSpaces <*> name1
+
+dozent :: Parser Lehrer
+dozent = Dozent <$> titel <* skipSpaces <*> name1
+
+titel :: Parser Titel
+titel = (Dr <$ keyword "Dr") <|> (Herr <$ keyword "Herr")
+
+lehrer :: Parser Lehrer
+lehrer = prof <|> dozent
+
+-- Beispiele:
+--
+--  > parse lehrer "Prof Martin"
+--  Just (Prof "Martin")
+--
+--  > parse lehrer "Dr Jost"
+--  Just (Dozent Dr "Jost")
+--
+--  > parse prof "Dr Jost"
+--  Nothing