FFP - 07

1 files changed, 19 insertions, 6 deletions

diff --git a/ws2015/ffp/blaetter/07/FFP_U07_Monaden2.hs b/ws2015/ffp/blaetter/07/FFP_U07_Monaden2.hs
index 942fd63..5200851 100644
--- a/ws2015/ffp/blaetter/07/FFP_U07_Monaden2.hs
+++ b/ws2015/ffp/blaetter/07/FFP_U07_Monaden2.hs
@@ -280,13 +280,26 @@ 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
+memoWinchance' [] _ _ = return 0 -- We do this here so we don't clutter our manual with entries for empty lists
+memoWinchance' _ [] _ = return 1
+memoWinchance' atts defs mmRef = recall >>= fromMaybeM (winchance >>= memoize)
   where
-    memoize x = modifySTRef mmRef (Map.insert (atts, defs) x)
-    winchance
-      | hitpoints a <= 0 = 
+    recall = Map.lookup (atts, defs) <$> readSTRef mmRef
+    memoize x = modifySTRef mmRef (Map.insert (atts, defs) x) >> return x
+    winchance = winchance' atts defs mmRef
+    fromMaybeM x Nothing = x
+    fromMaybeM _ (Just x) = return x
+
+winchance' :: forall s. [Monster] -> [Monster] -> STRef s MM -> ST s Double
+winchance' allatts@(a:atts) alldefs@(d:defs) mmRef 
+  | hitpoints a <= 0 = memoWinchance' atts alldefs mmRef
+  | hitpoints d <= 0 = memoWinchance' allatts defs mmRef
+  | otherwise = do
+      let attchance = nextHitchance dice (strength a) (strength d)
+          defchance = 1 - attchance
+      atthit <- memoWinchance'           allatts (takeHit d:defs) mmRef
+      defhit <- memoWinchance' (takeHit a:atts)          alldefs  mmRef
+      return $ (attchance * atthit) + (defchance * defhit)
                
 --
 -- Simples Beispiel zur Verwendung der ST-Monade: