diff options
| author | Gregor Kleen <gkleen@yggdrasil.li> | 2015-12-04 18:46:13 +0100 |
|---|---|---|
| committer | Gregor Kleen <gkleen@yggdrasil.li> | 2015-12-04 18:46:13 +0100 |
| commit | 5d3e86e66309f66b9c40e97a8800313b59964e2f (patch) | |
| tree | 18a42b805ff20d5c508a31ef396ad26210fb389d | |
| parent | 3ec5296d27f192ab6805e12c775f8c547c7c618e (diff) | |
| download | uni-5d3e86e66309f66b9c40e97a8800313b59964e2f.tar uni-5d3e86e66309f66b9c40e97a8800313b59964e2f.tar.gz uni-5d3e86e66309f66b9c40e97a8800313b59964e2f.tar.bz2 uni-5d3e86e66309f66b9c40e97a8800313b59964e2f.tar.xz uni-5d3e86e66309f66b9c40e97a8800313b59964e2f.zip | |
cleanup
| -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: |
