1 files changed, 0 insertions, 543 deletions

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
-