From ab9484b343abd995cba915bb0ba4be8907dfa6ec Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Fri, 13 Nov 2015 23:45:26 +0000
Subject: Shorter lecture names
---
ws2015/FFP/blaetter/04/FFP_U04_Lazy.hs | 543 ---------------------------------
1 file changed, 543 deletions(-)
delete mode 100644 ws2015/FFP/blaetter/04/FFP_U04_Lazy.hs
(limited to 'ws2015/FFP/blaetter/04')
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