use minmax for rulebased ai

app/Main.hs

@@ -16,6 +16,7 @@ import Skat.Pile
 import Skat.AI.Stupid
 import Skat.AI.Online
 import Skat.AI.Rulebased
+import Skat.AI.Minmax (playCLI)
 
 main :: IO ()
 main = testAI 10
@@ -34,17 +35,17 @@ runAI = do
         trs = filter (isTrump Spades) cs
     if length trs >= 5 && any ((==32) . getID) cs
         then do
-            pts <- fst <$> evalStateT (turn Hand1) env
+            pts <- fst <$> evalStateT turn env
             -- if pts > 60 then return 1 else return 0
             return pts
         else runAI
 
 env :: SkatEnv
-env = SkatEnv piles Nothing Spades playersExamp
+env = SkatEnv piles Nothing Spades playersExamp Hand1
     where piles = distribute allCards 
 
 envStupid :: SkatEnv
-envStupid = SkatEnv piles Nothing Spades pls2
+envStupid = SkatEnv piles Nothing Spades pls2 Hand1
     where piles = distribute allCards 
 
 playersExamp :: Players
@@ -57,15 +58,20 @@ pls2 :: Players
 pls2 = Players
     (PL $ Stupid Team Hand1)
     (PL $ Stupid Team Hand2)
-    (PL $ Stupid Team Hand3)
+    (PL $ Stupid Single Hand3)
 
 shuffledEnv :: IO SkatEnv
 shuffledEnv = do
     cards <- shuffleCards
-    return $ SkatEnv (distribute cards) Nothing Spades playersExamp
+    return $ SkatEnv (distribute cards) Nothing Spades playersExamp Hand1
+
+shuffledEnv2 :: IO SkatEnv
+shuffledEnv2 = do
+    cards <- shuffleCards
+    return $ SkatEnv (distribute cards) Nothing Spades pls2 Hand1
 
 env2 :: SkatEnv
-env2 = SkatEnv piles Nothing Spades playersExamp
+env2 = SkatEnv piles Nothing Spades playersExamp Hand1
     where hand1 = [Card Seven Clubs, Card King Clubs, Card Ace Clubs, Card Queen Diamonds]
           hand2 = [Card Seven Hearts, Card King Hearts, Card Ace Hearts, Card Queen Spades]
           hand3 = [Card Seven Spades, Card King Spades, Card Ace Spades, Card Queen Clubs]
@@ -74,6 +80,23 @@ env2 = SkatEnv piles Nothing Spades playersExamp
           h3 = map (putAt Hand3) hand3
           piles = Piles (h1 ++ h2 ++ h3) [] []
 
+env3 :: SkatEnv
+env3 = SkatEnv piles Nothing Diamonds pls2 Hand3
+    where hand1 = [ Card Jack Diamonds, Card Jack Clubs, Card Nine Spades, Card King Spades
+                  , Card Seven Diamonds, Card Nine Diamonds, Card Seven Clubs, Card Eight Clubs
+                  , Card Ten Clubs, Card Eight Hearts ]
+          hand2 = [ Card Seven Spades, Card Eight Spades, Card Seven Hearts, Card Nine Hearts
+                  , Card Ace Hearts, Card King Diamonds, Card Ace Diamonds, Card Nine Clubs
+                  , Card King Clubs, Card Ace Clubs ]
+          hand3 = [ Card Jack Hearts, Card Jack Spades, Card Ten Spades, Card Ace Spades, Card Eight Diamonds
+                  , Card Queen Diamonds, Card Ten Diamonds, Card Ten Hearts, Card Queen Hearts, Card King Hearts ]
+          skat = [ Card Queen Clubs, Card Queen Spades]
+          h1 = map (putAt Hand1) hand1
+          h2 = map (putAt Hand2) hand2
+          h3 = map (putAt Hand3) hand3
+          skt = map (putAt SkatP) skat
+          piles = Piles (h1 ++ h2 ++ h3) [] skt
+
 runWebSocketServer :: IO ()
 runWebSocketServer = do
     WS.runServer "localhost" 4243 application
@@ -85,3 +108,7 @@ application pending = do
     forever $ do
         msg <- WS.receiveData conn
         putStrLn $ BS.unpack msg
+
+playSkat :: IO ()
+playSkat = do
+    void $ (flip runStateT) env3 playCLI

skat.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 0d6eafec0c3ba6bb4c0150a39f4dbab784c7a519ec911d0f0344edd1c5d916da
+-- hash: 589f4321e3ce9847f3a53afb14e0fa9eaa1b98b3fc7386eac20f8fae7f7b6bf7
 
 name:           skat
 version:        0.1.0.1
@@ -29,6 +29,7 @@ library
   exposed-modules:
       Skat
       Skat.AI.Human
+      Skat.AI.Minmax
       Skat.AI.Online
       Skat.AI.Rulebased
       Skat.AI.Server

src/Skat.hs

@@ -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

src/Skat/AI/Rulebased.hs

@@ -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
+choose = chooseStatistic
-    handCards <- gets myHand
-    table <- gets table
-    case length table of
-        0 -> if length handCards >= 7
-            then chooseLead
-            else chooseStatistic
-        n -> 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
+        limit = min 10000 $ realDisNo `div` 2
-            then 1
-            else 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
+    turnCol <- turnColour
-    let myCards = handCards hand piles
+    trumpCol <- trumpColour
-    possible <- filterM (P.isAllowed myCards) myCards
+    myHand <- gets getHand
-    case possible of
+    let ps = Players (PL $ Stupid.Stupid Team Hand1)
-        [card] -> return card
+                     (PL $ Stupid.Stupid Team Hand2)
-        cs -> do
+                     (PL $ Stupid.Stupid Single Hand3)
-            results <- mapM simulate cs
+        env = mkSkatEnv piles turnCol trumpCol ps myHand
-            let both = zip results cs
+    liftIO $ evalStateT (Minmax.choose :: Skat Card) env
-                best = maximumBy (comparing fst) both
-            liftIO $ putStrLn $ "results " ++ show both
-            return $ snd best
 
 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

src/Skat/Card.hs

@@ -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) =

src/Skat/Matches.hs

@@ -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
+        env = SkatEnv cardDistr Nothing Spades ps Hand1
-    liftIO $ evalStateT (publishGameStart Hand3 >> turn Hand1 >>= publishGameResults) env
+    liftIO $ evalStateT (publishGameStart Hand3 >> turn >>= publishGameResults) env

src/Skat/Operations.hs

@@ -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)
+            modify (setCurrentHand $ next n)
-        2 -> playFunc p >> turnGeneric playFunc depth (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 :: Skat (Int, Int)
-turn n = turnGeneric play 10 n
+turn = turnGeneric play 10
 
 evaluateTable :: Skat Hand
 evaluateTable = do