christian/skat
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

replace map with list to improve efficiency

Browse Source
This commit is contained in:
Christian Merten
2019-05-19 12:03:56 +02:00
parent 56c04ae5df
commit c47e82d2e0
1 changed files with 7 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files
AI/Rulebased.hs
+7 -6
View File
@@ -197,7 +197,9 @@ abstract cs = foldr f (0, 0, 0, 0) cs
Spades -> (clubs, spades + 1 + v*100, hearts, diamonds) Spades -> (clubs, spades + 1 + v*100, hearts, diamonds)
Clubs -> (clubs + 1 + v*100, spades, hearts, diamonds) Clubs -> (clubs + 1 + v*100, spades, hearts, diamonds)
remove789s :: Hand -> [Distribution] -> M.Map (Abstract, Abstract)(Distribution, Int) remove789s :: Hand
-> [Distribution]
-> M.Map (Abstract, Abstract) (Distribution, Int)
remove789s hand ds = foldl' f M.empty ds remove789s hand ds = foldl' f M.empty ds
where f cleaned d = where f cleaned d =
let (c1, c2) = reduce hand d let (c1, c2) = reduce hand d
@@ -207,10 +209,9 @@ remove789s hand ds = foldl' f M.empty ds
reduce Hand2 (h1, _, h3, _) = (h1, h3) reduce Hand2 (h1, _, h3, _) = (h1, h3)
reduce Hand3 (h1, h2, _, _) = (h1, h2) reduce Hand3 (h1, h2, _, _) = (h1, h2)
simplify :: Hand -> [Distribution] -> M.Map Distribution Int simplify :: Hand -> [Distribution] -> [(Distribution, Int)]
simplify hand ds = M.foldl' f M.empty cleaned simplify hand ds = M.elems cleaned
where cleaned = remove789s hand ds where cleaned = remove789s hand ds
f m (d, n) = M.insert d n m
onPlayed :: MonadPlayer m => CardS Played -> AI m () onPlayed :: MonadPlayer m => CardS Played -> AI m ()
onPlayed c = do onPlayed c = do
@@ -269,13 +270,13 @@ chooseStatistic = do
realDisNo = length realDis realDisNo = length realDis
reducedDis = simplify Hand3 realDis reducedDis = simplify Hand3 realDis
reducedDisNo = length reducedDis reducedDisNo = length reducedDis
piless = M.mapKeys (toPiles table) reducedDis piless = map (\(d, n) -> (toPiles table d, n)) reducedDis
limit = if depth == 1 && length table == 2 limit = if depth == 1 && length table == 2
then 1 then 1
else min 10000 $ realDisNo `div` 2 else min 10000 $ realDisNo `div` 2
liftIO $ putStrLn $ "possible distrs without simp " ++ show realDisNo liftIO $ putStrLn $ "possible distrs without simp " ++ show realDisNo
liftIO $ putStrLn $ "possible distrs " ++ show reducedDisNo liftIO $ putStrLn $ "possible distrs " ++ show reducedDisNo
vals <- M.toList <$> foldWithLimit limit runOnPiles M.empty (M.toList piless) vals <- M.toList <$> foldWithLimit limit runOnPiles M.empty piless
liftIO $ print vals liftIO $ print vals
return $ fst $ maximumBy (comparing snd) vals return $ fst $ maximumBy (comparing snd) vals