From 3ec5296d27f192ab6805e12c775f8c547c7c618e Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 4 Dec 2015 18:40:37 +0100 Subject: FFP - 07 --- ws2015/ffp/blaetter/07/FFP_U07_Monaden2.hs | 25 +++++++++++++++++++------ 1 file changed, 19 insertions(+), 6 deletions(-) (limited to 'ws2015') 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: -- cgit v1.2.3