diff options
Diffstat (limited to 'ws2015/ffp')
-rw-r--r-- | ws2015/ffp/blaetter/07/FFP_U07_Monaden2.hs | 29 |
1 files changed, 14 insertions, 15 deletions
diff --git a/ws2015/ffp/blaetter/07/FFP_U07_Monaden2.hs b/ws2015/ffp/blaetter/07/FFP_U07_Monaden2.hs index 5200851..18eacfa 100644 --- a/ws2015/ffp/blaetter/07/FFP_U07_Monaden2.hs +++ b/ws2015/ffp/blaetter/07/FFP_U07_Monaden2.hs | |||
@@ -278,28 +278,27 @@ type MM = Map ([Monster], [Monster]) Double -- MM stands for MonsterManual | |||
278 | 278 | ||
279 | memoWinchance :: [Monster] -> [Monster] -> Double | 279 | memoWinchance :: [Monster] -> [Monster] -> Double |
280 | memoWinchance atts defs = runST (newSTRef Map.empty >>= memoWinchance' atts defs) | 280 | memoWinchance atts defs = runST (newSTRef Map.empty >>= memoWinchance' atts defs) |
281 | |||
282 | memoWinchance' :: forall s. [Monster] -> [Monster] -> STRef s MM -> ST s Double | ||
283 | memoWinchance' [] _ _ = return 0 -- We do this here so we don't clutter our manual with entries for empty lists | ||
284 | memoWinchance' _ [] _ = return 1 | ||
285 | memoWinchance' atts defs mmRef = recall >>= fromMaybeM (winchance >>= memoize) | ||
286 | where | 281 | where |
282 | memoWinchance' [] _ _ = return 0 -- We do this here so we don't clutter our manual with entries for empty lists | ||
283 | memoWinchance' _ [] _ = return 1 | ||
284 | memoWinchance' atts defs mmRef = recall >>= fromMaybeM (winchance >>= memoize) | ||
285 | |||
287 | recall = Map.lookup (atts, defs) <$> readSTRef mmRef | 286 | recall = Map.lookup (atts, defs) <$> readSTRef mmRef |
288 | memoize x = modifySTRef mmRef (Map.insert (atts, defs) x) >> return x | 287 | memoize x = modifySTRef mmRef (Map.insert (atts, defs) x) >> return x |
289 | winchance = winchance' atts defs mmRef | 288 | winchance = winchance' atts defs mmRef |
289 | |||
290 | fromMaybeM x Nothing = x | 290 | fromMaybeM x Nothing = x |
291 | fromMaybeM _ (Just x) = return x | 291 | fromMaybeM _ (Just x) = return x |
292 | 292 | ||
293 | winchance' :: forall s. [Monster] -> [Monster] -> STRef s MM -> ST s Double | 293 | winchance' allatts@(a:atts) alldefs@(d:defs) mmRef |
294 | winchance' allatts@(a:atts) alldefs@(d:defs) mmRef | 294 | | hitpoints a <= 0 = memoWinchance' atts alldefs mmRef |
295 | | hitpoints a <= 0 = memoWinchance' atts alldefs mmRef | 295 | | hitpoints d <= 0 = memoWinchance' allatts defs mmRef |
296 | | hitpoints d <= 0 = memoWinchance' allatts defs mmRef | 296 | | otherwise = do |
297 | | otherwise = do | 297 | let attchance = nextHitchance dice (strength a) (strength d) |
298 | let attchance = nextHitchance dice (strength a) (strength d) | 298 | defchance = 1 - attchance |
299 | defchance = 1 - attchance | 299 | atthit <- memoWinchance' allatts (takeHit d:defs) mmRef |
300 | atthit <- memoWinchance' allatts (takeHit d:defs) mmRef | 300 | defhit <- memoWinchance' (takeHit a:atts) alldefs mmRef |
301 | defhit <- memoWinchance' (takeHit a:atts) alldefs mmRef | 301 | return $ (attchance * atthit) + (defchance * defhit) |
302 | return $ (attchance * atthit) + (defchance * defhit) | ||
303 | 302 | ||
304 | -- | 303 | -- |
305 | -- Simples Beispiel zur Verwendung der ST-Monade: | 304 | -- Simples Beispiel zur Verwendung der ST-Monade: |