From ab9484b343abd995cba915bb0ba4be8907dfa6ec Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 13 Nov 2015 23:45:26 +0000 Subject: Shorter lecture names --- ws2015/FFP/blaetter/02/FFP_U02_Typklassen.hs | 206 ---------- ws2015/FFP/blaetter/03/FFP_U03_Funktoren.hs | 191 ---------- ws2015/FFP/blaetter/04/FFP_U04_Lazy.hs | 543 --------------------------- 3 files changed, 940 deletions(-) delete mode 100644 ws2015/FFP/blaetter/02/FFP_U02_Typklassen.hs delete mode 100644 ws2015/FFP/blaetter/03/FFP_U03_Funktoren.hs delete mode 100644 ws2015/FFP/blaetter/04/FFP_U04_Lazy.hs (limited to 'ws2015/FFP/blaetter') diff --git a/ws2015/FFP/blaetter/02/FFP_U02_Typklassen.hs b/ws2015/FFP/blaetter/02/FFP_U02_Typklassen.hs deleted file mode 100644 index 5f2d936..0000000 --- a/ws2015/FFP/blaetter/02/FFP_U02_Typklassen.hs +++ /dev/null @@ -1,206 +0,0 @@ --- Fortgeschrittene Funktionale Programmierung, --- LMU, TCS, Wintersemester 2015/16 --- Steffen Jost, Alexander Isenko --- --- Übungsblatt 02. 28.10.2015 --- --- Thema: --- --- Anweisung: --- 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! - - --- | A2-1 Funktionsdefinitionen --- --- Implementieren Sie folgende grundlegenden, --- bekannten Funktionen in Haskell. --- Selbst wenn Sie die Funktion nicht kennen, --- sollte Ihnen der Typ die korrekte Lösung ermöglichen! --- - -import Prelude hiding (uncurry,flip,(.),map,zip,zipWith,zip,foldl) - -import qualified Data.Map as P - --- Hinweis: Das import-Statement müssen Sie jetzt noch nicht verstehen, --- es ist nur notwendig zur Vermeidung von Namenskonflikten mit der --- Standardbibliothek, welche die meisten dieser Funktionen bereits enthält. - --- a) Uncurrying --- > uncurry (/) (1,2) == 0.5 -uncurry :: (a -> b -> c) -> ((a,b) -> c) -uncurry f (a,b) = f a b - --- b) Anwendung einer Funktion mit zwei Argumenten auf ein Paar --- > (1,2) ||> (/) == 0.5 -(||>) :: (a,b) -> (a -> b -> c) -> c -p ||> f = uncurry f p - - --- c) Vertauschung der Reihenfolge der Funktionsargumente --- > flip (/) 2 1 == 0.5 -flip :: (a -> b -> c) -> (b -> a -> c) -flip f b a = f a b - - --- d) Funktionskomposition --- > ((\x->x+3) . (\y->y*2)) 1 == 5 -(.) :: (b -> c) -> (a -> b) -> a -> c -(.) f g x = f $ g x - - --- e) Map (im Gegensatz zu A1-3 dieses Mal ohne List-Comprehension) --- > map (+10) [1,2,3,4] == [11,12,13,14] -map :: (a -> b) -> [a] -> [b] -map _ [] = [] -map f (x:xs) = f x : map f xs - - --- f) zip: --- > zip ['a','b','c'] [1,2,3,4,5] = [('a',1),('b',2),('c',3)] -zip :: [a] -> [b] -> [(a,b)] -zip [] _ = [] -zip _ [] = [] -zip (x:xs) (y:ys) = (x, y) : zip xs ys - - --- g) Zippen mit Funktionsanwendung: --- > zipWith (+) [1..] [1..3] == [2,4,6] -zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] -zipWith f xs ys = map (uncurry f) $ zip xs ys - - --- h) Falten nach links: --- > foldl (flip (:) ) [] [1..3] == [3,2,1] --- > foldl (\acc x -> x : acc)) [] [1..3] == [3,2,1] -foldl :: (b -> a -> b) -> b -> [a] -> b -foldl _ x [] = x -foldl f x (y:ys) = foldl f (f x y) ys - - - --- | A2-2 LambdaTerme --- --- Betrachten Sie die Lösung zur A1-1 g): - -data LambdaTerm = LVar Char - | LAbs Char LambdaTerm - | LApp LambdaTerm LambdaTerm - --- Ein paar Lambda Terme zum Testen: -lTerm_x = LVar 'x' -lTerm_y = LVar 'y' -lTerm_id = LAbs 'x' lTerm_x -lTerm_xx = LApp lTerm_x lTerm_x -lTerm_t = LAbs 'x' $ LApp lTerm_y lTerm_xx -lTerm_yk = LAbs 'y' $ LApp lTerm_t lTerm_t - --- a) Implementieren Sie eine Eq-Instanz für den Datentyp LambdaTerm! --- --- (Wer Lambda-Kalkül kennt: Zur Vereinfachung der Aufgabe --- ignorieren wir die übliche alpha-Äquivalenz, d.h. --- (LAbs 'x' $ LVar 'x') und (LAbs 'y' $ LVar 'y') --- dürfen als verschieden betrachtet werden) - -instance Eq LambdaTerm where - (LVar a) == (LVar b) = a == b - (LVar _) == _ = False - (LAbs a t_a) == (LAbs b t_b) = a == b && t_a == t_b - (LAbs _ _) == _ = False - (LApp t_a t'_a) == (LApp t_b t'_b) = t_a == t_b && t'_a == t'_b - (LApp _ _) == _ = False - --- b) Implementieren Sie die eine Show-Instanz für LambdaTerm. --- Achten Sie dabei auf eine korrekte Klammerung, aber --- verschwenden Sie erst einmal keine Zeit darauf, --- überflüssige Klammern zu vermeiden. - -instance Show LambdaTerm where - show (LVar a) = "LVar '" ++ pure a ++ "'" - show (LAbs a t) = "LAbs '" ++ pure a ++ "' (" ++ show t ++ ")" - show (LApp t t') = "LApp (" ++ show t ++ ") (" ++ show t' ++ ")" - - --- | A2-3 Klassendeklaration --- --- a) Deklarieren Sie eine Klasse "FinMap" für endliche partielle Abbildungen, welche folgende Operationen bereitsstellt: --- 1) "emptyM" liefert eine leere Abbildung --- 2) "insertM x a m" fügt die Abbildung [x->a] in die Abbildung m ein. --- Falls x schon enthalten war, dann wird es überschrieben. --- 3) "lookupM x m" liefert Nothing zurück, falls x nicht in m enthalten ist; --- ansonsten wird der für x gespeicherte Wert z zurückgeliefert (in Just verpackt) --- Die Funktion "lookupM" darf dabei annehmen, dass für x eine Vergleichsoperation vorliegt!?! - -class FinMap m where - emptyM :: m k v - insertM :: Ord k => k -> v -> m k v -> m k v - lookupM :: Ord k => k -> m k v -> Maybe v - -- Can we get around using constraints here without using the MultiParamTypeClasses language extension? - --- b) Machen Sie folgenden Datentyp zu einer Instanz der Typklasse Map: - --- data AL a b = AL [(a,b)] -newtype AL a b = AL [(a,b)] -- Äquivalent zur vorherigen Zeile. - -- newtype kann und darf verwenden werden, - -- wenn man nur einen Konstruktor mit nur einem Argument hat. - -- Dies erlaubt GHC eine Optimierung durchzuführen. - deriving (Show, Read, Eq) - -instance FinMap AL where - emptyM = AL $ [] - insertM x a (AL m) = AL $ (x, a) : [p | p@(x', _) <- m, x' /= x] - lookupM x (AL m) = listToMaybe [y | (x', y) <- m, x' == x] -- Due to lazyness this is no slower than explicitly short-circuiting the search - where - -- This is part of Data.Maybe - listToMaybe [] = Nothing - listToMaybe (x:_) = Just x - - ----- Werte zum anschließendem Testen, auskommentieren, ----- sobald Klasse und Instanz definiert wurden: -testMap0 :: AL Int Bool -testMap0 = emptyM -testMap1 = insertM 1 False testMap0 -testMap2 = insertM 3 False testMap1 -testMap3 = insertM 4 True testMap2 -testMap4 = insertM 2 True testMap3 - - --- Hinweis: --- Partielle Abbildungen wie hier durch Assoziationslisten zu implementieren, --- ist nicht bensonders effizient, da der Zugriff auf ein Element im Allgemeinen --- den Aufwand O(n) hat (man muss die ganze Liste abklappern - es könnte sich ja --- um das letzte Element der Liste handeln). --- Mit Suchbäumen läßt sich der Aufwand bekanntermaßen auf O(log n) reduzieren. --- Wer noch Lust & Zeit hat, kann versuchen, dies selbst zu implementieren --- und zur einer weiteren Instanz von FinMap machen. --- --- Die Standardbibliothek sieht zur Abstraktion hier keine solche Klasse vor, --- sondern bietet lediglich eine konkrete, effiziente Implementierung von --- endlichen Abbildungen an: Data.Map, welche wir in der kommenden Vorlesung --- betrachten werden. --- --- Dies kann man natürlich ganz schnell zu einer Instanz von FinMap machen. Wie? - -data Map k v = Tip - | Branch k v (Map k v) (Map k v) - -instance FinMap Map where - emptyM = Tip - insertM k v Tip = Branch k v Tip Tip - insertM k v (Branch k' v' lt gt) - | k == k' = Branch k v lt gt - | k < k' = Branch k' v' (insertM k v lt) gt - | otherwise = Branch k' v' lt (insertM k v gt) - lookupM _ Tip = Nothing - lookupM k (Branch k' v' lt gt) - | k == k' = Just v' - | k < k' = lookupM k lt - | otherwise = lookupM k gt - -instance FinMap P.Map where - emptyM = P.empty - insertM = P.insert - lookupM = P.lookup diff --git a/ws2015/FFP/blaetter/03/FFP_U03_Funktoren.hs b/ws2015/FFP/blaetter/03/FFP_U03_Funktoren.hs deleted file mode 100644 index 88ee00f..0000000 --- a/ws2015/FFP/blaetter/03/FFP_U03_Funktoren.hs +++ /dev/null @@ -1,191 +0,0 @@ --- Fortgeschrittene Funktionale Programmierung, --- LMU, TCS, Wintersemester 2015/16 --- Steffen Jost, Alexander Isenko --- --- Übungsblatt 03 am 3.11.2015 --- --- Thema: --- --- Anweisung: --- 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! --- --- - -import Data.List (groupBy) -import Data.Function (on) - --- Bearbeiten Sie zuerst Übungsblatt 02 vollständig! - - ----- A3-1 Funktoren --- --- Machen Sie folgende Datentypen zur einer Instanz der Klasse Functor. --- Versuchen Sie dabei, möglichst nicht in die Folien zu schauen! --- (Falls Sie doch in die Folien schauen, dann möglichst nur 2-25 und 2-31ff.; --- da die Beispiele 2-28 und 2-29 nahezu die komplette Lösung verraten.) - - --- a) -data Options a = None | One a | Two a a | Three a a a - deriving (Ord, Show) - --- Wenn wir nur die ersten beiden Konstuktoren von "Options" betrachten, --- dann haben wir genau den Datentyp "Maybe" aus der Standardbibliothek. - -instance Functor Options where - fmap _ None = None - fmap f (One a) = One (f a) - fmap f (Two a b) = Two (f a) (f b) - fmap f (Three a b c) = Three (f a) (f b) (f c) - --- Zum Testen: -testO0 = None -testO1 = One 4.2 -testO2 = Two 4.2 6.9 --- Tests auskommentierbar, sobald Functor Instanz definiert: -testa1 = None == fmap (+2) testO0 -testa2 = Two 8.4 13.8 == fmap (*2) testO2 - - --- b) -data Tree a = Node a [Tree a] - deriving (Eq, Show) - ---Hilfsfunktion -leaf :: a -> Tree a -leaf x = Node x [] - -instance Functor Tree where - fmap f (Node a xs) = Node (f a) $ map (fmap f) xs - --- Zum Testen: -testT1 = Node 1 [Node 2 [Node 3 [], leaf 4, Node 5 [leaf 6, leaf 7, leaf 8]], leaf 9, Node 10 [leaf 11]] -testT2 = Node False [Node True [Node False [],leaf True,Node False [leaf True,leaf False,leaf True]],leaf False,Node True [leaf False]] --- Test auskommentierbar, sobald Functor Instanz definiert: -testb1 = testT2 == (fmap even testT1) - - - - ----- A3-2 Funktor (->) a --- --- Die Standardbibliothek definiert eine Funktor-Instanz für den Typ "(->) a". --- Wir wollen hier herausfinden, was dies bedeutet: --- --- Der Typ "(->) a" ist ein Typ mit einem ``Loch'', --- so wie die Typen "Tree" oder "[ ]" auch. --- Die runde Klammer bedeutet lediglich Präfix-Notation anstatt Infix-Notation. --- Wenn wir also einen Typ "b" hineingeben wird daraus der Typ (im vertrauten Infix) --- a -> b --- ganz analog wird aus "Tree" oder "[ ]" zu "Tree b" oder "[b]". --- - --- a) Welchen konkreten Typ bekommt die Funktion "fmap" --- für die Funktor-Instanz von "(->) a"? --- --- Hinweis: Ein Beispiel findet sich auf Folie 2-26. --- Oben ist der allgemeine Typ von fmap angegeben. --- Unten dann nochmal konkreter für die Listen-Instanz. - -{- - fmap :: Functor f => (a -> b) -> f a -> f b - fmap :: (a -> b) -> (x -> a) -> (x -> b) --} - --- b) Die Standardbibliothek enthält bereits eine Funktion des in a) gefundenen Typs! --- Wie heisst diese Funktion und was macht sie? --- Testen Sie anschließend in GHCI, ob sie die Funktion --- tatsächlich mit fmap vertauschen können! --- --- Hinweis: Diese Funktion wird Ihnen in einer Vorlesung über --- funktionaler Programmierung mit Sicherheit begegnet sein, --- da sie von fundamentaler Bedeutung ist. --- (Jedoch sicherlich nicht als Funktor behandelt... ;) ) - -{- - fmap ist hier identisch zu (.) - λ ((\a -> (a, a)) `fmap` (+ 2)) 2 - (4,4) --} - - - - ----- A3-3 Unendliche Listen --- --- a) Definieren Sie die unendliche Liste alle Zweierpotenzen: [1,2,4,8,16,32,64,128,256,..] - -quadrate :: [Integer] -quadrate = map (2^) [0..] - -quadrate' :: [Integer] -- More efficient (probably) -quadrate' = 1 : [2 * x | x <- quadrate'] - --- Zum Testen: -q1 = take 5 quadrate --- > q1 --- [1,2,4,8,16] -q2 = quadrate !! 10 --- > q2 --- 1024 - - --- b) Definieren Sie eine unendliche Liste, welche alle --- erdenklichen Strings aus den Buchstaben ['a','b','c','d']. --- Die Reihenfolge ist relativ egal, aber kürzere Strings sollen vor längeren Erscheinen; --- d.h. "dd" kommt nach "b", aber vor "abc" - -alleVariablen :: [String] -alleVariablen = seed : alleVariablen' [seed] - where - seed = "" - vars = ['a','b','c','d'] - alleVariablen' prevs = now ++ alleVariablen' now - where - now = [v : p | v <- vars, p <- prevs] - -alleVariablen' :: [String] -- Preferred. -alleVariablen' = "" : [v : p | p <- alleVariablen', v <- vars] - where - vars = ['a', 'b', 'c', 'd'] - --- Zum Testen: -check l x = (map length . groupBy ((==) `on` length)) (take x l) - --- Beispielimplementierung (muss nicht identisch sein): --- > take 30 alleVariablen --- ["" --- ,"a" ,"b" ,"c" ,"d" --- ,"aa" ,"ab" ,"ac" ,"ad" ,"ba" ,"bb" ,"bc" ,"bd" ,"ca" ,"cb","cc","cd","da","db","dc","dd" --- ,"aaa","aab","aac","aad","aba","abb","abc","abd","aca"] --- --- Prüfe Längen: --- > check alleVariablen 30 --- [1,4,16,9] - - - - --- A3-4 Instanzen --- Wer sich mit Klassen und Instanzen noch nicht so sicher fühlt, --- sollte zur Übung die automatisch abgeleiteten Instanzdeklaration --- für die Datentypdeklarationen in A3-1 von Hand deklarieren; --- also z.B. --- von "Options" zur Typklassen "Eq" --- von "Tree a" zur Typklasse "Ord" --- --- sie müssen oben in den Datentypdeklarationen dann natürlich --- die entsprechenden Klassen aus Zeile mit "deriving" herauslöschen --- da es ja immer nur _eine_ Instanzdeklaration pro Typ/Klassen-Paar geben darf - -instance Eq a => Eq (Options a) where - None == None = True - One a == One a' = a == a' - Two a b == Two a' b' = a == a' && b == b' - Three a b c == Three a' b' c' = a == a' && b == b' && c == c' - _ == _ = False - -instance Ord a => Ord (Tree a) where - compare (Node x xs) (Node x' xs') = compare x x' `mappend` compare xs xs' diff --git a/ws2015/FFP/blaetter/04/FFP_U04_Lazy.hs b/ws2015/FFP/blaetter/04/FFP_U04_Lazy.hs deleted file mode 100644 index 36c0578..0000000 --- a/ws2015/FFP/blaetter/04/FFP_U04_Lazy.hs +++ /dev/null @@ -1,543 +0,0 @@ --- Fortgeschrittene Funktionale Programmierung, --- LMU, TCS, Wintersemester 2015/16 --- Steffen Jost, Alexander Isenko --- --- Übungsblatt 04. 11.11.2015 --- --- Thema: --- --- Anweisung: --- 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! --- --- - -import qualified Data.Map as Map -import Data.Map (Map) -import qualified Data.Set as Set -import Data.Set (Set) -import qualified Data.List as List ((\\)) - -import Data.Maybe (fromMaybe) -import Data.Tuple (swap) - -import Control.Applicative (Applicative(..), (<$>)) - ----- A4-1 Verzögerte Auswertung --- Gegeben ist folgendes Programm: -xs = [1..] -foo x = 2 * x -ys = foo <$> xs -rs = take 1 $ drop 1 ys - -{-Skizzieren Sie mit Papier und Bleistift, - wie am Ende der Speicher aussieht, wenn lediglich - rs - ausgewertet wurde (z.B. durch Anzeige am Bildschirm). - - Welche Strukturen gibt es im Speicher? - Wie viele Thunks befinden sich noch im Speicher? - Auf welche Adressen zeigen xs, ys, rs in den von Ihnen skizzierten Speicher? - - Hinweise: - - An jeder Speicheraddresse sollte sich entweder ein Thunk (also ein Programmausdruck) - oder ein Wert befinden. - - Für Datentypen wird der Wert dargestellt als Tupel aus Konstruktor - und den Speicheraddressen seiner Argumente. - - Funktionsdefinitonen lassen wir zur Vereinfachung aus dem Speicher heraus. - - Speicheraddressen dürfen Sie völlig willkürlich wählen - - BEISPIEL: - - -- Programm: - zs = [27..] - ts = take 1 $ drop 2 zs - x = head ts - - -- Nach Auswertung von x haben wir den Zustand: - - [ <01>,(:),<11>,<02> | <02>,(:),<12>,<03> | <03>,(:),<13>,<04> | <04>,"[30..]" - | <11>,Int,27 | <12>,Int,27+1 | <13>,Int,29 - | <21>,(:),<13>,<22> | <22>,[] - ] - - Thunks: <04>,<12> - - zs -> <01> - ts -> <21> - x -> <13> - -} - -{- - -| 10 | (:) 1 <30> | -| 20 | [3..] | -| 30 | (:) 2 <20> | -| 40 | (:) <50> <60> | -| 50 | (*) 2 <20> | -| 60 | 4 | -| 61 | (<$>) ((*) 2) <20> | -| 70 | (:) <60> <71> | -| 71 | [] | - -Thunks: 20, 50, 61 - -xs = <10> -ys = <40> -rs = <70> - --} - - ----- A4-2 Zirkularität --- a) --- Schreiben Sie ein zirkuläres Programm transcl, --- welches zu einer gegebenen Relation r :: a -> [a] --- und einer als Liste gegebenen Menge, --- die transitive Hülle dieser Menge zu der Relation berechnet. --- --- Eine Relation r :: a -> [a] ist dabei so kodiert, --- das r x die Menge aller Elemente ist, welche zu x in Relation stehen. --- --- HINWEIS: --- Das Ergebnis soll eine Menge modellieren, es darf also kein Element --- doppelt vorkommen. Die Reigenfolge der Elemente in der Liste ist aber egal. --- --- BEISPIELE: --- --- > transCl rel1 [22] --- [33,44] --- > transCl rel1 [2,5] --- [2,5,4,6,8,1,3,7,9] --- --- > sort $ transCl rel2 [42,8,9] --- [1,2,4,5,7,8,9,10,11,13,14,16,17,20,21,22,26,28,32,34,40,42,52,64] --- --- HINWEIS: Folgen Sie dem nub2 Beispiel aus Folie 3-30 - - -transCl :: Eq a => (a -> [a]) -> [a] -> [a] -transCl r xs = res - where - res = build xs 0 - - build [] _ = [] - build xs n = xs' ++ build xs' (n + length xs') - where - xs' = strikeKnown n $ concatMap r xs - - strikeKnown _ [] = [] - strikeKnown 0 xs = xs - strikeKnown n (x:xs) - | x `elem` take n res = strikeKnown n xs - | otherwise = x : strikeKnown n xs - --- Zum Testen: -rel1 :: Integer -> [Integer] -rel1 11 = [22] -rel1 22 = [33] -rel1 33 = [44] -rel1 n - | even n, n>=1, n<=9 = [2,4,6,8] - | odd n, n>=1, n<=9 = [1,3,5,7,9] - | otherwise = [n] - -rel1S :: Integer -> Set Integer -rel1S = Set.fromList . rel1 - -rel2 :: Integer -> [Integer] -rel2 n - | even n = [n,n `div` 2] - | otherwise = [3*n+1,n] - -rel2S :: Integer -> Set Integer -rel2S = Set.fromList . rel2 - - --- b) --- Implementieren Sie die Aufgabe noch mal ganz schnell --- ohne Rücksicht auf Zirkularität oder Effizienz, --- sondern ganz bequem mit der Standardbibliothek für Data.Set - --- The implementation below seems to me no nicer than a :( - -transClS :: (Ord a) => (a -> Set a) -> Set a -> Set a -transClS rel xs = build xs Set.empty - where - res = build xs Set.empty - - build xs known - | Set.null xs = Set.empty - | otherwise = xs' `Set.union` build xs' (xs' `Set.union` known) - where - xs' = Set.foldr Set.union Set.empty (Set.map rel xs) Set.\\ known - - - - ----- A4-3 Verzögerte Auswertung -{-Ein Kollege von Dr Jost meinte einmal, dass man Dinge am Besten durch Implementation erlernt. - Also wollen wir in dieser Aufgabe verzögerte Auswertung für einen Fragment von Haskell Implementieren. - Wir machen uns das Leben einfach und nehemen nur folgendes, minimales Fragment her: - * Variablen z.B. "y" - * Anonyme Funktionen z.B. "\x->x" - * Funktionsanwendung z.B. "(\x->x) y" evaluiert zu "y" - Wir verzichten also auf sehr viel: keine Pattern-Matching, kein if-then-else,... - ...sogar auf Basisdatentypen wie Int oder Bool verzichten wir! - - Die Terme unseres Sprach-Fragments modellieren wir durch folgenden Datentyp: - -} - -data Term = Var Variable | Abs Variable Term | App Term Term - deriving (Eq) - -type Variable = String - -{- - Einige Hilfsfunktionen, sowie einige Beispiel-Terme sind weiter unten, - im Anhang dieser Datei definiert. Ebenso wurde eine vernünftige Show-Instanz vorgegeben. - so dass die Terme wie Haskell-Code ausschauen: - *Main> Abs "x" (App (Var "f") (Var "x" )) - \x -> f x - - Von den Hilfsfunktionen sollten Sie eigentlich nur - subst :: (Variable, Term) -> Term -> Term - benötigen. Der Ausdruck "subst (x,t1) t2" bedeutet "t2[t1/x]", - also im Ausdruck t2 werden alle Vorkommen von x durch t1 ersetzt. - - - NEBENBEMERKUNG; - zum Lösen dieser Aufgabe nicht wichtig: - - Richtig, es handelt sich dabei erneut um den Lambda-Kalkül, - wie wir ihn schon in Aufgaben A1-1g und A2-2 kennengelernt haben. - Anstatt "\x->x" würde man im Lambda-Kalkül eher "λx.x" schreiben, aber - das ist auch der einzige Unterschied. O - bwohl wir hier auf so viel verzichten, handelt es sich übrigens immer noch um eine Turing-Vollständige Sprache! - Also wollen wir hier die verzögerte Auswertestrategie anhand des Lambda-Kalküls üben... ;) --} - - --- a) Einfache Auswertung --- --- Wir schreiben uns zuerst eine simple Auswertung von Lambda-Ausdrücken, also --- eine Funktion "eval :: Term -> Term". Das vorgehen ist wie folgt: --- --- 1) Variablen werten zu sich selbst aus (d.h. sind bereits ausgewertet); nichts zu tun. --- --- 2) Abstraktionen sind auch bereits ausgewertet; nichts zu tun. --- (Wenn man will, dann könnte man auch erst noch den Rumpf auswerten, soweit möglich. --- Dies ist eine reine Definitionsfrage, darf jeder machen wie er will. --- Im Allgemeinen wird nicht unter einem Lambda reuduziert, aber beim Testen --- werden die Terme leichter verständlich, wenn man unter dem Lambda reduziert.) --- --- 3) Zum Auswerten einer Applikationen "App" muss man zuerst die Funktion auswerten. --- Erhält man einen Lambda-Ausdruck "Abs", so ersetzt man alle Vorkommen --- der abstrahierten Variable durch das zuvor ausgewertete Funktionsargument. --- (Ansonsten liefert man einfach die gesamte Applikation zurück.) --- --- Hinweis: Im 3. Fall muss man noch aufpassen, das keine freien Variablen eingefangen werden. --- Glücklicherweise ist dies für uns bereits implementiert. Verwenden Sie einfach die Funktion "subst" --- zur Substitution des Funktionsparameters im Rumpf der Funktion. --- (Die Funktion "subst" ist weiter unten im Anhang dieser Datei definiert.) --- --- Einfache Implementierung der Auswertung : -eval :: Term -> Term -eval (App f x) = case eval f of - (Abs v t) -> eval $ subst (v, x) t - t -> eval $ t -eval x = x - - -{- Beispiele, ohne Auswertung unter einem Lambda, Konstanten cK, c1, usw. sind weiter unten, im Anhang der Datei definiert. - -*Main> eval $ App (App cK c1) vX -\f -> \a -> f a - -*Main> eval $ App cISNULL (App cSUCC c0) -\x -> \y -> y - --} - - --- b) --- --- Da Haskell eine Sprache mit verzögerter Auswertung ist, --- vererbt sich dies bereits auch auf unsere Implementierung von eval: --- *Main> eval $ App (App cK c1) cOmega --- \f -> \x -> f x --- --- Bei der Auswertestrategie "Call-By-Value" sollte dies eigentlich gar nicht auswerten, --- da cOmega nicht endlich auswertbar ist. --- --- Eine Möglichkeit ist es, die Auswertung genauer zu simulieren. --- Dazu nutzen wir jetzt eine Map zur Modellierung unseres Speichers: - -type Memory = Map Variable Term - --- Ein Wert des Typs "Memory" bildet also Werte des Typs "Variable" auf Werte des Typs "Term" ab. --- --- Zur Anzeige eines Terms benötigen wir nun natürlich auch den Speicher, um den Kontext der Variablen zu haben. --- Verwenden Sie zur Anzeige also diese gegebene Funktion: -showMem :: (Memory,Term) -> Term -showMem (m,t) = Map.foldlWithKey (\r v s -> subst (v,s) r) t m - --- Diese Anzeige bauchen wir gleich in unsere Auswertefunktion ein: -evalStrict :: Term -> Term -evalStrict t = showMem $ evalS0 t - --- Die Funktion evalS0 ist nur eine Kurzform, um die Auswertung mit leerem Speicher zu starten: -evalS0 :: Term -> (Memory, Term) -evalS0 = evalS Map.empty - --- Ihre Aufgabe ist es also, evalS zu implementieren: - -evalS :: Memory -> Term -> (Memory, Term) -evalS m x@(Var v) = (,) m $ fromMaybe x $ Map.lookup v m -evalS m t@(App f x) = case f' of - (Abs v t) -> let - usedVars = Set.unions $ (Map.keysSet m'' :) $ map freeVars $ Map.elems m'' - v' = generateFreshVar usedVars - (m'', x') = evalS m' x - m''' = Map.insert v' x' m'' - in evalS m''' $ subst (v,Var v') t - _ -> (m, t) - where - (m', f') = evalS m f -evalS m x = (m, x) - --- Dabei verfolgen wir folgende Auswertestrategie: --- --- 1) Der Wert einer Variablen wird im Speicher nachgeschlagen. --- Freie Variablen werten nach wie vor zu sich selbst aus. --- --- 2) Unverändert: Abstraktionen sind bereits ausgewertet. --- --- 3) Bei der Auswertung von Applikationen verzichten wir auf Substitution. --- Stattdessen legen wir das ausgewertete Argument im Speicher --- unter der abstrahierten Variable ab. --- --- Im Fall 3) treten einige Probleme auf: --- - Der Speicher muss durch die rekursiven Aufruf von evalS hindurchgefädelt werden. --- Es sollte immer nur auf den neuesten Speicher zugegriffen werden, --- damit die Modellierung stimmt! --- --- - OPTIONAL: Wenn es aber nur einen Speicher gibt, kann es zu Namenskonflikten im Speicher --- kommen. Dies kann vermieden werden, wenn Variable vor dem Speichern in frische Variablen --- umbenannt werden. Verwenden Sie dazu die Hilfsfunktionen: freeVars, generateFreshVar & subst. --- --- Wenn Sie es richtig gemacht haben, sollte das obige Beispiel mit cOmega jetzt nicht mehr terminieren. - - --- c) Nun wollen wir es wieder verbessern, in dem wir verzögerte Auswertung explizit simulieren. --- --- Im Fall 1) updaten wir den Speicher nach der Auswertung des abgespeicherten Terms, --- um wiederholte Auswertung zu vermeiden. --- (Der Einfachheit verzichten wir auf eine Prüfung/Flag ob im Speicher ein Thunk ist oder nicht: --- wir werten und updaten immer - wenn es schon ein Wert war, dann geht die Auswertung ja schnell) --- --- Fall 2) Abs bleibt Unverändert --- --- Im Fall 3) App legen wir also nur den unausgewerten Term im Speicher ab. --- - -evalLazy :: Term -> Term -evalLazy t = showMem $ evalL0 t - -evalL0 ::Term -> (Memory, Term) -evalL0 = evalL Map.empty - -evalL :: Memory -> Term -> (Memory, Term) -evalL m x@(Var v) = case Map.lookup v m of - Nothing -> (m, x) - Just t -> let - (m', t') = evalL m t - in (Map.insert v t' m', t') -evalL m t@(App f x) = case f' of - (Abs v t) -> let - usedVars = Set.unions $ (Map.keysSet m' :) $ map freeVars $ Map.elems m' - v' = generateFreshVar usedVars - m'' = Map.insert v' x m' - in evalL m'' $ subst (v,Var v') t - _ -> (m, t) - where - (m', f') = evalL m f -evalL m x = (m, x) - - - - -- I am of the considered opinion that the above exercises call for State. Therefore: - -data State s a = State { unState :: s -> (a, s) } - -instance Functor (State s) where - fmap f (State g) = State ((\(a, s) -> (f a, s)) . g) - -instance Applicative (State s) where - pure a = State (\s -> (a, s)) - (State f) <*> (State g) = State (\s -> (\(g', s) -> (\(f', s') -> (f' g', s')) $ f s) $ g s) - -instance Monad (State s) where - return = pure - (State f) >>= g = State ((\(a, s) -> (unState $ g a) s) . f) - -get :: State s s -get = State (\s -> (s, s)) - -put :: s -> State s () -put s = State (\_ -> ((), s)) - -modify :: (s -> s) -> State s () -modify f = (f <$> get) >>= put - -evalStrict' :: Term -> Term -evalStrict' t = showMem $ evalS0' t - where - evalS0' = evalS' Map.empty - -evalLazy' :: Term -> Term -evalLazy' t = showMem $ evalL0' t - where - evalL0' = evalL' Map.empty - -evalS' :: Memory -> Term -> (Memory, Term) -evalS' m t = swap $ (unState $ eval t) m - where - eval :: Term -> State Memory Term - eval t@(Var v) = (fromMaybe t . Map.lookup v) <$> get - eval t@(App f x) = do - f' <- eval f - case f' of - (Abs v t) -> do - x' <- eval x - mem <- get - let - boundInTerms = Set.unions . map freeVars $ Map.elems mem - usedVars = boundInTerms `Set.union` Map.keysSet mem - v' = generateFreshVar usedVars - modify $ Map.insert v' x' - eval $ subst (v, Var v') t - _ -> pure t - eval t = pure t - -evalL' :: Memory -> Term -> (Memory, Term) -evalL' m t = swap $ (unState $ eval t) m - where - eval :: Term -> State Memory Term - eval t@(Var v) = do - t' <- Map.lookup v <$> get - case t' of - Nothing -> return t - Just t -> do - t' <- eval t - modify $ Map.insert v t' - return t' - eval t@(App f x) = do - f' <- eval f - case f' of - (Abs v t) -> do - mem <- get - let - boundInTerms = Set.unions . map freeVars $ Map.elems mem - usedVars = boundInTerms `Set.union` Map.keysSet mem - v' = generateFreshVar usedVars - modify $ Map.insert v' x - eval $ subst (v, Var v') t - _ -> pure t - eval t = pure t - ------------------------------------------------------------------------ --- ANHANG --- --- Für erweiterten Komfort gegeben wir noch einige Definitionen vor! --- - - --- Hier einige Lambda-Terme zum Testen: -vX = Var "x" -vY = Var "y" -vZ = Var "z" -lTest1 = App (App vX vY) vZ -lTest2 = App vX (App vY vZ) - --- Combinators (allgmein bekannte Lambda-Terme) -cI = Abs "x" $ Var "x" -- \x -> x -cK = Abs "x" $ Abs "y" $ Var "x" -- \x y -> x -cS = Abs "z" $ Abs "y" $ Abs "x" $ App (App (Var "z") (Var "x")) (App (Var "y") (Var "x")) -- \z y x -> (z x) (y x) -cT = Abs "x" $ App (Var "x") (Var "x") -- \x -> x x -cOmega = App cT cT -- (\x -> x x) (\x -> x x) - --- Church Booleans (wer keine eingebauten Datentypen hat, bastelt sich halt selbst welche, so wie es uns Alonzo Church zeigte) -cTRUE = Abs "x" $ Abs "y" $ Var "x" -- \x y -> x -cFALSE = Abs "x" $ Abs "y" $ Var "y" -- \x y -> y -cCOND = Abs "x" $ Abs "y" $ Abs "z" $ App (App vX vY) vZ -- \x y z -> (x y) z - --- Church Numerals (wer keine eingebauten Zahlen hat, kann sich auch diese selbst stricken) -c0 = Abs "f" $ Abs "x" $ Var "x" -- \f x -> x -c1 = Abs "f" $ Abs "x" $ App (Var "f") (Var "x") -- \f x -> f x -c2 = eval $ App cSUCC c1 -- \f -> \x -> f (f x) -c3 = eval $ App cSUCC c2 -- \f -> \x -> f (f (f x)) -cSUCC = Abs "n" $ Abs "f" $ Abs "x" $ App (Var "f") $ App (App (Var "n" ) (Var "f")) (Var "x") -- \n f x -> f ((n f) x) -cPLUS = Abs "m" $ Abs "n" $ Abs "f" $ Abs "x" $ App (App (Var "m") (Var "f")) $ App (App (Var "n" ) (Var "f")) (Var "x") -- \m n f x -> (m f) ((n f) x) -cISNULL = Abs "x" $ App (App (Var "x") (Abs "x" cFALSE)) cTRUE -- \x -> x (\x -> (\x y -> y))) (\x y -> x)) - --- Lambda Terme hübsch anzeigen, in Haskell Notation, also anstatt "λf.λx.f x" schreiben wir hier "\f-> \x-> f x". -instance Show Term where - showsPrec _ (Var x) = showString x - showsPrec n (App s t) = showParen (n>1) $ (showsPrec 1 s) . showString " " . showsPrec 2 t - showsPrec n (Abs x t) = showParen (n>0) $ showString ('\\':x) . showString " -> " . showsPrec n t - ------------------------------ --- Nützliche Hilfsfunktionen --- - --- Substitution, welche das Einfangen freier Variablen verhindert. --- Alle _freien_ Vorkommen einer Variable werden durch einen Term ersetzt. --- Gebundene Variablen werden ggf. ersetzt, damit es nicht zu Namenskonflikten kommt: --- [y/x] ( \y -> x y ) == \z -> y z --- subst ("x", Var "y") (Abs "y" $ App (Var "x") (Var "y")) --- --- Wenn wir die Variable "x" durch den Term "y" ersetzen wollen, dann müssen wir --- aufpassen, dass keine gebundenen Variablen 'eingefangen' werden, denn --- "\y->x y" ist ja äquivalent zu "\z ->x z". --- Also soll auch "(\y->x y)[y/x]" äquivalent zu "(\z ->x z)[y/x]" == "\z->y z" sein. --- Wenn wir aber nur blind einsetzen würden, gilt das nicht, denn wir bekämen "\y->y y". --- - -subst :: (Variable, Term) -> Term -> Term -subst (x,e) o@(Var y) - | x == y = e - | otherwise = o -subst s (App e1 e2) = App (subst s e1) (subst s e2) -subst s@(x,e) o@(Abs y e1) - | x == y = o - | y `Set.notMember` fv_e = Abs y (subst s e1) - | otherwise = Abs freshV (subst (x,e) $ subst (y, Var freshV) e1) -- avoiding capture - where - fv_e = freeVars e - fv_e1 = freeVars e1 - freshV = generateFreshVar (fv_e `Set.union` fv_e1) - - --- Freie Variablen eines Terms -freeVars :: Term -> Set Variable -freeVars (Var x) = Set.singleton x -freeVars (App e1 e2) = Set.union (freeVars e1) (freeVars e2) -freeVars (Abs x e1) = Set.delete x $ freeVars e1 - --- Frische Variable berechnen -generateFreshVar :: Set Variable -> Variable -generateFreshVar vs - | v `Set.notMember` vs = v - | otherwise = succString $ Set.findMax vs - where - v = "a" - --- Note that Ord String has "z" > "aa", so succString s = s ++ "a" would suffice --- Ensure that "s" < succString "s" -succString :: String -> String -succString "" = "a" -succString ('z':s) = 'z' : succString s -succString ( c :s) = (succ c) : s - -- cgit v1.2.3