From 76b9e428426e2afeb67f48c094bbc0225563dd3d Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 24 Nov 2015 14:29:20 +0100 Subject: FFP - 06 (partially) & 06b --- ws2015/ffp/blaetter/06/FFP_U06_Monaden.hs | 193 ++++++++++++++++++++ ws2015/ffp/blaetter/06/FFP_U06b_ApplParse.hs | 256 +++++++++++++++++++++++++++ 2 files changed, 449 insertions(+) create mode 100644 ws2015/ffp/blaetter/06/FFP_U06_Monaden.hs create mode 100644 ws2015/ffp/blaetter/06/FFP_U06b_ApplParse.hs (limited to 'ws2015') 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 -- cgit v1.2.3