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

add debug info to ai

Browse Source
This commit is contained in:
christian
2019-09-15 23:27:39 +02:00
parent b94584aee4
commit c9eb1b5bc9
1 changed files with 12 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Skat/AI/Rulebased.hs
+12 -4
View File
@@ -250,7 +250,7 @@ chooseStatistic = do
3 -> 3 3 -> 3
-- simulate only partially -- simulate only partially
4 -> 3 4 -> 3
5 -> 2 5 -> 3
6 -> 2 6 -> 2
7 -> 1 7 -> 1
8 -> 1 8 -> 1
@@ -277,6 +277,7 @@ chooseStatistic = do
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 $ "players hand" ++ show handCards
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 piless vals <- M.toList <$> foldWithLimit limit runOnPiles M.empty piless
@@ -307,6 +308,7 @@ chooseOpen = do
piles <- showPiles piles <- showPiles
hand <- gets getHand hand <- gets getHand
let myCards = handCards hand piles let myCards = handCards hand piles
liftIO $ putStrLn $ show hand ++ " chooses from " ++ show myCards
possible <- filterM (P.isAllowed myCards) myCards possible <- filterM (P.isAllowed myCards) myCards
case length myCards of case length myCards of
0 -> do 0 -> do
@@ -329,6 +331,7 @@ chooseSimulating = do
results <- mapM simulate cs results <- mapM simulate cs
let both = zip results cs let both = zip results cs
best = maximumBy (comparing fst) both best = maximumBy (comparing fst) both
liftIO $ putStrLn $ "results " ++ show both
return $ snd best return $ snd best
simulate :: (MonadState AIEnv m, MonadPlayerOpen m) simulate :: (MonadState AIEnv m, MonadPlayerOpen m)
@@ -341,6 +344,7 @@ simulate card = do
myTeam <- gets getTeam myTeam <- gets getTeam
myHand <- gets getHand myHand <- gets getHand
depth <- gets simulationDepth depth <- gets simulationDepth
liftIO $ putStrLn $ "simulate: " ++ show myHand ++ " plays " ++ show card
let newDepth = depth - 1 let newDepth = depth - 1
-- create a virtual env with 3 ai players -- create a virtual env with 3 ai players
ps = Players ps = Players
@@ -364,7 +368,8 @@ predictValue (own, others) = do
piles <- showPiles piles <- showPiles
let cs = handCards hand piles let cs = handCards hand piles
pot <- potential cs pot <- potential cs
return $ own + pot --return $ own + pot
return (own-others)
potential :: (MonadState AIEnv m, MonadPlayerOpen m) potential :: (MonadState AIEnv m, MonadPlayerOpen m)
=> [Card] -> m Int => [Card] -> m Int
@@ -383,7 +388,7 @@ position card = do
let effCol = effectiveColour tr card let effCol = effectiveColour tr card
l = M.toList guess l = M.toList guess
cs = filterMap ((==effCol) . effectiveColour tr . fst) fst l cs = filterMap ((==effCol) . effectiveColour tr . fst) fst l
csInd = zip [0..] cs csInd = zip [0..] (reverse cs)
Just (pos, _) = find ((== card) . snd) csInd Just (pos, _) = find ((== card) . snd) csInd
return pos return pos
@@ -401,8 +406,11 @@ chooseLead :: (MonadState AIEnv m, MonadPlayer m) => m Card
chooseLead = do chooseLead = do
cards <- gets myHand cards <- gets myHand
possible <- filterM (P.isAllowed cards) cards possible <- filterM (P.isAllowed cards) cards
liftIO $ putStrLn $ "choosing lead from " ++ show possible
pots <- mapM leadPotential possible pots <- mapM leadPotential possible
return $ snd $ maximumBy (comparing fst) (zip pots possible) let ps = zip pots possible
liftIO $ putStrLn $ "lead potential of cards " ++ show ps
return $ snd $ maximumBy (comparing fst) ps
mkAIEnv :: Team -> Hand -> Int -> AIEnv mkAIEnv :: Team -> Hand -> Int -> AIEnv
mkAIEnv tm h depth = AIEnv tm h [] [] [] newGuess depth mkAIEnv tm h depth = AIEnv tm h [] [] [] newGuess depth