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 insertions(+) create mode 100644 ws2015/ffp/blaetter/02/FFP_U02_Typklassen.hs create mode 100644 ws2015/ffp/blaetter/03/FFP_U03_Funktoren.hs create mode 100644 ws2015/ffp/blaetter/04/FFP_U04_Lazy.hs (limited to 'ws2015/ffp') diff --git a/ws2015/ffp/blaetter/02/FFP_U02_Typklassen.hs b/ws2015/ffp/blaetter/02/FFP_U02_Typklassen.hs new file mode 100644 index 0000000..5f2d936 --- /dev/null +++ b/ws2015/ffp/blaetter/02/FFP_U02_Typklassen.hs @@ -0,0 +1,206 @@ +-- 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 new file mode 100644 index 0000000..88ee00f --- /dev/null +++ b/ws2015/ffp/blaetter/03/FFP_U03_Funktoren.hs @@ -0,0 +1,191 @@ +-- 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 new file mode 100644 index 0000000..36c0578 --- /dev/null +++ b/ws2015/ffp/blaetter/04/FFP_U04_Lazy.hs @@ -0,0 +1,543 @@ +-- 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