use minmax for rulebased ai

2020-02-29 12:39:04 +01:00
parent 173bd0df2e
commit 5846a22d8a
7 changed files with 93 additions and 62 deletions
@@ -16,7 +16,8 @@ import qualified Skat.Player as P
 data SkatEnv = SkatEnv { piles :: Piles
                       , turnColour :: Maybe Colour
                       , trumpColour :: Colour
-                       , players :: Players }
+                       , players :: Players
+                       , currentHand :: Hand }
               deriving Show

 type Skat = StateT SkatEnv IO
@@ -45,5 +46,19 @@ modifyPlayers f = modify g
 setTurnColour :: Maybe Colour -> SkatEnv -> SkatEnv
 setTurnColour col sk = sk { turnColour = col }

-mkSkatEnv :: Piles -> Maybe Colour -> Colour -> Players -> SkatEnv
+setCurrentHand :: Hand -> SkatEnv -> SkatEnv
+setCurrentHand hand sk = sk { currentHand = hand }
+
+mkSkatEnv :: Piles -> Maybe Colour -> Colour -> Players -> Hand -> SkatEnv
 mkSkatEnv = SkatEnv
+
+allowedCards :: Skat [Card]
+allowedCards = do
+    curHand <- gets currentHand
+    pls <- gets players
+    turnCol <- gets turnColour
+    trumpCol <- gets trumpColour
+    ps <- gets piles
+    let p = P.player pls curHand
+        cards = handCards curHand ps
+    return $ filter (isAllowed trumpCol turnCol cards) cards
@@ -24,6 +24,8 @@ import Skat.Card
 import Skat.Utils
 import Skat (Skat, modifyp, mkSkatEnv) 
 import Skat.Operations
+import qualified Skat.AI.Minmax as Minmax
+import qualified Skat.AI.Stupid as Stupid (Stupid(..))

 data AIEnv = AIEnv { getTeam :: Team
                   , getHand :: Hand
@@ -229,34 +231,12 @@ onPlayed c = do
        Nothing -> return ()

 choose :: MonadPlayer m => AI m Card
-choose = do
-    handCards <- gets myHand
-    table <- gets table
-    case length table of
-        0 -> if length handCards >= 7
-            then chooseLead
-            else chooseStatistic
-        n -> chooseStatistic
+choose = chooseStatistic

 chooseStatistic :: MonadPlayer m => AI m Card
 chooseStatistic = do
    h <- gets getHand
    handCards <- gets myHand
-    let depth = case length handCards of
-                    0 -> 0
-                    1 -> 1
-                    -- simulate whole game
-                    2 -> 2
-                    3 -> 3
-                    -- simulate only partially
-                    4 -> 3
-                    5 -> 3
-                    6 -> 2
-                    7 -> 1
-                    8 -> 1
-                    9 -> 1
-                    10 -> 1
-    modify $ setDepth depth
    guess__ <- gets guess
    self <- get
    maySkat <- showSkat self
@@ -274,9 +254,7 @@ chooseStatistic = do
        reducedDis = simplify Hand3 realDis
        reducedDisNo = length reducedDis
        piless = map (\(d, n) -> (toPiles table d, n)) reducedDis
-        limit = if depth == 1 && length table == 2
-            then 1
-            else min 10000 $ realDisNo `div` 2
+        limit = min 10000 $ realDisNo `div` 2
    liftIO $ putStrLn $ "players hand" ++ show handCards
    liftIO $ putStrLn $ "possible distrs without simp " ++ show realDisNo
    liftIO $ putStrLn $ "possible distrs " ++ show reducedDisNo
@@ -310,29 +288,26 @@ chooseOpen = do
    let myCards = handCards hand piles
    liftIO $ putStrLn $ show hand ++ " chooses from " ++ show myCards
    possible <- filterM (P.isAllowed myCards) myCards
-    case length myCards of
+    case length possible of
        0 -> do
            liftIO $ print hand
            liftIO $ print piles
            error "no cards left to choose from"
-        1 -> return $ head myCards
+        1 -> return $ head possible
        _ -> chooseSimulating

 chooseSimulating :: (MonadState AIEnv m, MonadPlayerOpen m)
                 => m Card
 chooseSimulating = do
    piles <- showPiles
-    hand <- gets getHand
-    let myCards = handCards hand piles
-    possible <- filterM (P.isAllowed myCards) myCards
-    case possible of
-        [card] -> return card
-        cs -> do
-            results <- mapM simulate cs
-            let both = zip results cs
-                best = maximumBy (comparing fst) both
-            liftIO $ putStrLn $ "results " ++ show both
-            return $ snd best
+    turnCol <- turnColour
+    trumpCol <- trumpColour
+    myHand <- gets getHand
+    let ps = Players (PL $ Stupid.Stupid Team Hand1)
+                     (PL $ Stupid.Stupid Team Hand2)
+                     (PL $ Stupid.Stupid Single Hand3)
+        env = mkSkatEnv piles turnCol trumpCol ps myHand
+    liftIO $ evalStateT (Minmax.choose :: Skat Card) env

 simulate :: (MonadState AIEnv m, MonadPlayerOpen m)
         => Card -> m Int
@@ -351,11 +326,11 @@ simulate card = do
            (PL $ mkAIEnv Team Hand1 newDepth)
            (PL $ mkAIEnv Team Hand2 newDepth)
            (PL $ mkAIEnv Single Hand3 newDepth)
-        env = mkSkatEnv piles turnCol trumpCol ps
+        env = mkSkatEnv piles turnCol trumpCol ps (next myHand)
    -- simulate the game after playing the given card
    (sgl, tm) <- liftIO $ evalStateT (do
        modifyp $ playCard card
-        turnGeneric playOpen depth (next myHand)) env
+        turnGeneric playOpen depth) env
    let v = if myTeam == Single then (sgl, tm) else (tm, sgl)
    -- put the value into context for when not the whole game is
    -- simulated
@@ -39,7 +39,7 @@ data Colour = Diamonds
              deriving (Eq, Ord, Show, Enum, Read)

 data Card = Card Type Colour
-            deriving (Eq, Show, Ord)
+            deriving (Eq, Show, Ord, Read)

 instance ToJSON Card where
    toJSON (Card t c) =
@@ -40,5 +40,5 @@ singleVsBots comm = do
                (PL $ OnlineEnv Team Hand1 comm)
                (PL $ Stupid Team Hand2)
                (PL $ mkAIEnv Single Hand3 10)
-        env = SkatEnv cardDistr Nothing Spades ps
-    liftIO $ evalStateT (publishGameStart Hand3 >> turn Hand1 >>= publishGameResults) env
+        env = SkatEnv cardDistr Nothing Spades ps Hand1
+    liftIO $ evalStateT (publishGameStart Hand3 >> turn >>= publishGameResults) env
@@ -1,6 +1,6 @@
 module Skat.Operations (
    turn, turnGeneric, play, playOpen, publishGameResults,
-    publishGameStart
+    publishGameStart, play_, sortRender
 ) where

 import Control.Monad.State
@@ -23,32 +23,45 @@ compareRender (Card t1 c1) (Card t2 c2) = case compare c1 c2 of
 sortRender :: [Card] -> [Card]
 sortRender = sortBy compareRender

+play_ :: Card -> Skat ()
+play_ card = do
+    hand <- gets currentHand
+    trCol <- gets trumpColour
+    modifyp $ playCard card
+    table <- getp tableCards
+    case length table of
+        1 -> do modify (setCurrentHand $ next hand)
+                modify $ setTurnColour (Just $ effectiveColour trCol $ head table)
+        3 -> evaluateTable >>= modify . setCurrentHand
+        _ -> modify (setCurrentHand $ next hand)
+
 turnGeneric :: (PL -> Skat Card)
            -> Int
-            -> Hand
            -> Skat (Int, Int)
-turnGeneric playFunc depth n = do
+turnGeneric playFunc depth = do
+    n <- gets currentHand
    table <- getp tableCards
    ps <- gets players
    let p = player ps n
    hand <- getp $ handCards n
    trCol <- gets trumpColour
    case length table of
-        0 -> playFunc p >> turnGeneric playFunc depth (next n)
+        0 -> playFunc p >> modify (setCurrentHand $ next n) >> turnGeneric playFunc depth
        1 -> do
            modify $ setTurnColour
                (Just $ effectiveColour trCol $ head table)
            playFunc p
-            turnGeneric playFunc depth (next n)
-        2 -> playFunc p >> turnGeneric playFunc depth (next n)
+            modify (setCurrentHand $ next n)
+            turnGeneric playFunc depth
+        2 -> playFunc p >> modify (setCurrentHand $ next n) >> turnGeneric playFunc depth
        3 -> do
            w <- evaluateTable
            if depth <= 1 || length hand == 0
                then countGame
-                else turnGeneric playFunc (depth - 1) w
+                else modify (setCurrentHand w) >> turnGeneric playFunc (depth - 1)

-turn :: Hand -> Skat (Int, Int)
-turn n = turnGeneric play 10 n
+turn :: Skat (Int, Int)
+turn = turnGeneric play 10

 evaluateTable :: Skat Hand
 evaluateTable = do