Started on FFP - 07

1 files changed, 312 insertions, 0 deletions

diff --git a/ws2015/ffp/blaetter/07/FFP_U07_Monaden2.hs b/ws2015/ffp/blaetter/07/FFP_U07_Monaden2.hs
new file mode 100644
index 0000000..942fd63
--- /dev/null
+++ b/ws2015/ffp/blaetter/07/FFP_U07_Monaden2.hs
@@ -0,0 +1,312 @@
+{-# LANGUAGE RankNTypes #-} -- I like being allowed to specify type signatures
+
+-- Fortgeschrittene Funktionale Programmierung, 
+--   LMU, TCS, Wintersemester 2015/16
+--   Steffen Jost, Alexander Isenko
+--
+-- Übungsblatt 07. 2.12.2015
+--
+-- Thema: Monaden (Teil2)
+--
+-- 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 Control.Applicative
+import Control.Monad
+
+import Control.Monad.ST
+import Data.STRef
+
+import Data.Maybe (fromMaybe)
+
+import Debug.Trace (traceShowId)
+
+---- A7-1 I/O und "Hello World!"
+
+-- a)
+-- Lassen Sie das Programm von Folie 4-77 laufen!
+-- Erstellen Sie dazu eine separate Datei mit dem 
+-- Haskell-Quelltext.
+-- Verwenden Sie GHC und nicht GHCI!
+-- 
+-- HINWEIS:
+--  GHC erstellt nur eine ausführbare Datei,
+--  falls die Funktion main existiert.
+--  Falls Ihr Modul oder Ihre Funktion anders heisst,
+--  so sollten Sie bei der Kompilation die
+--  Option "-main-is" verwenden, also z.B.
+--  "ghc MyFile.hs -main-is MyModule.myfoo"
+
+
+-- b)
+-- Schreiben Sie ein ausführbares Programm,
+-- welches den Benutzer zur Eingabe einer Textzeile auffordert.
+-- Ihr Programm soll abwechselnd 
+--   - die Textzeile rückwärts ausgeben
+--   - die Textzeile ausgeben, wobei 
+--        A/Ä durch E, p durch b und k durch g ersetzt werden
+-- Das Programm beendet sich, falls der Benutzer 
+-- nichts eingibt und nur return drückt.
+--
+-- Beispielausführung:
+--     Hallo Benutzer!
+--     Sag was, ich sag's Dir dann umgekehrt:
+--     Was ist ein Palindrom?
+--     ?mordnilaP nie tsi saW
+--     Sag emol ebbes lustiges:
+--     Äpfel und Birnen                  
+--     Ebfel und Birnen
+--     Sag was, ich sag's Dir dann umgekehrt:
+--
+--     Bye bye!
+-- 
+
+main :: IO ()
+main = do
+  putStrLn "Hallo Benutzer!"
+  main' actions
+  putStrLn "Bye bye!"
+  where
+    actions = cycle [ ("Sag was, ich sag's Dir dann umgekehrt:", reverse)
+                    , ("Sag emal ebbes lustiges:", dialekt)
+                    ]
+    main' ((str, a):as) = do
+      putStrLn str
+      l <- getLine
+      when (not $ null l) $ do
+        putStrLn $ a l
+        main' as
+
+dialekt :: String -> String
+dialekt = map dialekt'
+  where
+    dialekt' 'A' = 'E'
+    dialekt' 'Ä' = 'E'
+    dialekt' 'p' = 'b'
+    dialekt' 'k' = 'g'
+    dialekt' x = x
+  
+  
+             
+---- A7-2 Allgemeine Monadische Funktionen
+--
+-- Implementieren Sie folgende Funktionen aus 
+-- der Standarbibliothek selbst zu Fuss.
+-- Sie dürfen DO-Notation einsetzen, wenn Sie möchten.
+--
+-- Zur Vermeidung von Namenskonflikten 
+-- wurde jedem Funktionsnamen das Kürzel "my" vorangestellt.
+
+
+-- a) reguläres foldl mit monadischer Funktion
+--
+myFoldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
+myFoldM _ a [] = return a
+myFoldM f a (b:bs) = do
+  a' <- (a `f` b)
+  myFoldM f a' bs
+
+
+-- b) Replizieren eines monadischen Wertes
+-- Beispiel:
+--     > myReplicateM 3 (return 7)
+--     [7,7,7]
+-- 
+--     > myReplicateM 4 (putStr "X ")
+--     X X X X [(),(),(),()]
+--
+myReplicateM :: (Monad m) => Int -> m a -> m [a]
+myReplicateM 0 _ = return []
+myReplicateM n a = do
+  a' <- a
+  (a' :) `liftM` myReplicateM (n - 1) a
+
+
+-- c) Hintereinanderausführung zweier monadischer Funktionen 
+-- (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c
+--
+myR2Lcomposition :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)
+myR2Lcomposition f g a = g a >>= f
+
+
+  
+-- A7-3 Anwenden der Zustandsmonade
+--
+-- Gegeben ist die korrekte Berechnung einer Wahrscheinlichkeit für einen Kampf in einem Strategiespiel.
+-- Die Berechnung ist uns zu langsam. Da dabei viele wiederholte Berechnungen auftreten,
+-- möchten wir die gesamte Berechnung durch explizite Memoisation mit einer Zustandsmonade beschleunigen!
+--
+-- IHRE AUFGABE: 
+--     Berechnung der gegebenen Funktion "winchance" dramatisch beschleunigen!
+-- 
+-- Das Ergebnis soll natürlich unverändert sein! Deklarieren Sie also zum Vergleich 
+-- eine neue Funktion "memoWinchance" mit gleichem Typ.
+-- 
+-- Dabei haben Sie die Wahl:
+--   - Kreieren Sie eine Zustandsmonade zu Fuss, wie in der letzten Vorlesung demonstriert; oder
+--   - Verwenden Sie die Module Control.Monad.ST und Data.STRef
+--     Für letztere Variante folgt am Ende dieser Datei ein Programmbeispiel zur Verwendung: demoST
+--
+-- Warum die gegebene Wahrscheinlichkeitsberechnung richtig ist, ist für unser Lernziel unwichtig.
+-- Der Hintergrund "Strategiespiel" dient nur der Illustration, damit die Aufgabe nicht zu langweilig wird.
+-- Es ist also nicht schlimm, wenn Sie die Details davon nicht verstehen.
+-- 
+
+-- 
+-- BESCHREIBUNG UND MODELLIERUNG DES STRATEGIESPIELS
+-- 
+-- In einem Strategiespiel kämpfen verschiedene fantastische Monster gegeneinander.
+-- Eine Monster besitzt zwei Werte: Kampfstärke und Trefferpunkte:
+--
+
+data Monster = Monster Int Int deriving (Show,Eq,Ord)
+-- HINWEIS: Hier könnte man Record-Syntax gut einsetzen. Wir verzichten jedoch darauf,
+--          da Record-Syntax noch nicht in der Vorlesung behandelt wurde.
+
+strength  :: Monster -> Int
+strength (Monster s _) = s
+
+hitpoints :: Monster -> Int
+hitpoints (Monster _ h) = h
+
+takeHit :: Monster -> Monster
+takeHit (Monster s h) = Monster s $ h-1
+
+-- Einige Standard-Monster zum Testen:
+crow  = Monster  5 1
+human = Monster 10 2
+orc   = Monster 20 1
+dwarf = Monster 15 2
+elf   = Monster 25 2
+giant = Monster 20 4
+knight= Monster 35 2
+
+-- Ein Kampf zwischen zwei Parteien in diesem Spiel läuft wie folgt ab:
+--
+-- Die Monster eines Kampfe zwischen zwei gegnerischen Parteien sind
+-- jeweils in einem Stapel geordnet: 
+-- also eine Liste von Angreifern und eine Liste von Verteidigern.
+-- Es kämpfen immer nur jeweils die beiden Monster an vorderster Front der beiden Stapel gegeneinander.
+-- 
+-- Beide Monster würfeln eine Zahl zwischen 0 und 99 und vergleichen diese mit Ihrer eigenen Stärke.
+-- Ist die gewürfelte Zahl kleiner als die Stärke, so verliert das gegnerische Monster einen Trefferpunkt;
+-- beide Würfelwürfe werden jedoch wiederholt, falls beide Monster Ihren Stärketest gleichzeitig bestehen oder beide durchfallen,
+-- es verliert also immer nur genau eines der beiden obersten Monster einen Trefferpunkt.
+-- 
+-- Sobald ein Monster 0 Trefferpunkte hat, wird es aus dem Stapel entfernt.
+-- Die verbleibenden Monster kämpfen, bis einer der beiden gegnerischen Stapel leer ist.
+--
+-- Um uns im Spiel einen Vorteil zu verschaffen, möchten wir die Gewinnwahrscheinlichkeit
+-- für zwei gegebene Stacks von Monstern im Voraus ausrechnen.
+-- Dies haben wir auch schnell in Haskell implementiert:
+--
+-- Die Funktion winchance berechnet uns die Gewinnwahrscheinlichkeit
+-- für den ersten Stapel aus (d.h. mindestens ein Angreifermonster überlebt).
+
+dice = 100
+
+winchance :: [Monster] -> [Monster] -> Double
+winchance [] _  = 0
+winchance _  [] = 1
+winchance allatt@(a:att) alldef@(d:def) 
+  | hitpoints a <= 0 = winchance    att alldef -- remove dead attacker
+  | hitpoints d <= 0 = winchance allatt    def -- remove dead defender
+  | otherwise = 
+      let attchance = nextHitchance dice (strength a) (strength d) -- chance for next hit by attacker on defender
+          defchance = 1 - attchance                                -- chance for next hit by defender on attacker
+          atthit = winchance         allatt (takeHit d:def) -- attacker's winchance if defender took a hit
+          defhit = winchance (takeHit a:att)        alldef  -- attacker's winchance if attacker took a hut
+      in (attchance * atthit) + (defchance * defhit) -- overall winchance for first stack
+                
+-- Die Funktion nextHitchance 100 x y rechnet uns die Chance aus,
+-- das ein Monster mit Stärke x gegen ein Monster mit Stärke y den nächsten Treffer landet.
+-- Möglicherweise auftretende Wiederholungen der Würfelwürfe haben wir
+-- mit Hilfe der Mathematik über die Grenzwerte unendlicher Reihen bereits vereinfacht:
+              
+nextHitchance :: Int -> Int -> Int -> Double
+nextHitchance die attstr defstr = a*d' / (d*a' + a*d')
+  where    
+    a  = (fromIntegral attstr)/(fromIntegral die)
+    a' = if a > 1 then 0 else 1 - a
+    d  = (fromIntegral defstr)/(fromIntegral die)
+    d' = if d > 1 then 0 else 1 - d
+    
+{-    
+Der Code funktioniert auch prinzipiell:
+
+> nextHitchance 100 10 20
+0.30769230769230776
+
+> winchance [orc,dwarf,elf,giant] [human,human,human,knight,knight]
+0.35168883031403275
+
+> winchance [human,human,human,knight,knight] [orc,dwarf,elf,giant] 
+0.6483111696859674
+
+> winchance [orc,orc,orc,dwarf,dwarf,giant,giant] [human,human,human,elf,elf,knight,knight]
+0.33760541326192256
+
+jedoch zeigt das letzte Beispiel, dass die Berechnung sehr lange dauern kann!
+    
+Dabei wird jedoch oft das Gleiche frisch berechnet:
+Zum Beispiel bei der Berechnung von "winchance [orc,elf] [human,dwarf]"
+wird zwei mal "winchance [elf] [dwarf]" frisch ausgerechnet.
+Einmal unter der Annahme, dass zuerst der orc stirbt, und 
+dann nochmal unter der Annahme das zuerst der mensch besiegt wurde.
+
+Es bietet sich daher an, die Werte von winchance in einer Tabelle abzulegen, 
+z.B.    Map ([Monster],[Monster]) Double
+Ein Aufruf von memoWinchance schaut zuerst in dieser Tabelle nach,
+ob die Wahrscheinlichkeit für diesen kompletten (Rest-)Kampf bereits bekannt ist.
+Falls ja, wird schnell der bekannte Wert zurückgegeben.
+Falls nein, wird der Wert berechnet und anschliessend in die Tabelle eingetragen.
+Beachten Sie, das bei der Berechnung eines Wertes die Tabelle bereits wachsen kann!
+
+Hinweis: Da die Tabelle für verschieden Stacks schnell groß werden kann,
+verzichten wir darauf, diese zwischen verschiedenen Aufrufen von winchance
+im Speicher zu halten. Nur während der Rekursion in einer Hilfsfunktion 
+von winchance führen wir die Tabelle immer mit.
+-}
+
+type MM = Map ([Monster], [Monster]) Double -- MM stands for MonsterManual
+    
+memoWinchance :: [Monster] -> [Monster] -> Double
+memoWinchance atts defs = runST (newSTRef Map.empty >>= memoWinchance' atts defs)
+
+memoWinchance' :: forall s. [Monster] -> [Monster] -> STRef s MM -> ST s Double
+memoWinchance' [] _ = 0
+memoWinchance' _ [] = 1
+memoWinchance' atts@(a:att) defs@(d:def) mmRef = (Map.lookup (atts, defs) <$> readSTRef mmRef) >>= fromMaybe winchance . fmap return . traceShowId
+  where
+    memoize x = modifySTRef mmRef (Map.insert (atts, defs) x)
+    winchance
+      | hitpoints a <= 0 = 
+               
+--
+-- Simples Beispiel zur Verwendung der ST-Monade:
+-- 
+demoST :: (Integer, [Char])
+demoST = runST $ do
+    somerefA <- newSTRef 0
+    somerefB <- newSTRef "A"
+    increment somerefA
+    increment somerefA  
+    modifySTRef somerefB $ \s -> s ++ "B"
+    increment somerefA
+    a <- readSTRef somerefA
+    b <- readSTRef somerefB
+    increment somerefA
+    increment somerefA
+    return (a,b)  
+  where 
+    increment ref = do
+      x <- readSTRef ref
+      let y = succ x
+      writeSTRef ref y
+