From b8c490a23087557af0ce8fd0482edff62139c6ab Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 3 Dec 2015 06:21:07 +0000 Subject: Started on FFP - 07 --- ws2015/ffp/blaetter/07/FFP_U07_Monaden2.hs | 312 +++++++++++++++++++++++++++++ 1 file changed, 312 insertions(+) create mode 100644 ws2015/ffp/blaetter/07/FFP_U07_Monaden2.hs (limited to 'ws2015/ffp/blaetter/07/FFP_U07_Monaden2.hs') 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 + -- cgit v1.2.3