Compare commits
2
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
c9eb1b5bc9 | ||
|
|
b94584aee4 |
@@ -250,7 +250,7 @@ chooseStatistic = do
|
||||
3 -> 3
|
||||
-- simulate only partially
|
||||
4 -> 3
|
||||
5 -> 2
|
||||
5 -> 3
|
||||
6 -> 2
|
||||
7 -> 1
|
||||
8 -> 1
|
||||
@@ -277,6 +277,7 @@ chooseStatistic = do
|
||||
limit = if depth == 1 && length table == 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
|
||||
vals <- M.toList <$> foldWithLimit limit runOnPiles M.empty piless
|
||||
@@ -307,6 +308,7 @@ chooseOpen = do
|
||||
piles <- showPiles
|
||||
hand <- gets getHand
|
||||
let myCards = handCards hand piles
|
||||
liftIO $ putStrLn $ show hand ++ " chooses from " ++ show myCards
|
||||
possible <- filterM (P.isAllowed myCards) myCards
|
||||
case length myCards of
|
||||
0 -> do
|
||||
@@ -329,6 +331,7 @@ chooseSimulating = do
|
||||
results <- mapM simulate cs
|
||||
let both = zip results cs
|
||||
best = maximumBy (comparing fst) both
|
||||
liftIO $ putStrLn $ "results " ++ show both
|
||||
return $ snd best
|
||||
|
||||
simulate :: (MonadState AIEnv m, MonadPlayerOpen m)
|
||||
@@ -341,6 +344,7 @@ simulate card = do
|
||||
myTeam <- gets getTeam
|
||||
myHand <- gets getHand
|
||||
depth <- gets simulationDepth
|
||||
liftIO $ putStrLn $ "simulate: " ++ show myHand ++ " plays " ++ show card
|
||||
let newDepth = depth - 1
|
||||
-- create a virtual env with 3 ai players
|
||||
ps = Players
|
||||
@@ -364,7 +368,8 @@ predictValue (own, others) = do
|
||||
piles <- showPiles
|
||||
let cs = handCards hand piles
|
||||
pot <- potential cs
|
||||
return $ own + pot
|
||||
--return $ own + pot
|
||||
return (own-others)
|
||||
|
||||
potential :: (MonadState AIEnv m, MonadPlayerOpen m)
|
||||
=> [Card] -> m Int
|
||||
@@ -383,7 +388,7 @@ position card = do
|
||||
let effCol = effectiveColour tr card
|
||||
l = M.toList guess
|
||||
cs = filterMap ((==effCol) . effectiveColour tr . fst) fst l
|
||||
csInd = zip [0..] cs
|
||||
csInd = zip [0..] (reverse cs)
|
||||
Just (pos, _) = find ((== card) . snd) csInd
|
||||
return pos
|
||||
|
||||
@@ -401,8 +406,11 @@ chooseLead :: (MonadState AIEnv m, MonadPlayer m) => m Card
|
||||
chooseLead = do
|
||||
cards <- gets myHand
|
||||
possible <- filterM (P.isAllowed cards) cards
|
||||
liftIO $ putStrLn $ "choosing lead from " ++ show 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 tm h depth = AIEnv tm h [] [] [] newGuess depth
|
||||
|
||||
+4
-1
@@ -6,7 +6,7 @@ module Skat.Card where
|
||||
|
||||
import Data.List
|
||||
import Data.Aeson
|
||||
import System.Random (newStdGen)
|
||||
import System.Random (newStdGen, StdGen)
|
||||
import Control.DeepSeq
|
||||
|
||||
import Skat.Utils
|
||||
@@ -123,6 +123,9 @@ shuffleCards = do
|
||||
gen <- newStdGen
|
||||
return $ shuffle gen allCards
|
||||
|
||||
shuffleCardsWithGen :: StdGen -> [Card]
|
||||
shuffleCardsWithGen gen = shuffle gen allCards
|
||||
|
||||
-- TESTING VARS
|
||||
|
||||
c1 :: Card
|
||||
|
||||
+21
-2
@@ -3,6 +3,7 @@ module Skat.Matches (
|
||||
) where
|
||||
|
||||
import Control.Monad.State
|
||||
import System.Random (mkStdGen)
|
||||
|
||||
import Skat
|
||||
import Skat.Operations
|
||||
@@ -14,12 +15,30 @@ import Skat.AI.Rulebased
|
||||
import Skat.AI.Online
|
||||
import Skat.AI.Stupid
|
||||
|
||||
-- | predefined card distribution for testing purposes
|
||||
cardDistr :: Piles
|
||||
cardDistr = Piles hands [] (map (putAt SkatP) skt)
|
||||
where hand3 = [Card Ace Spades, Card Jack Diamonds, Card Jack Clubs, Card King Spades,
|
||||
Card Nine Spades, Card Ace Diamonds, Card Queen Diamonds, Card Ten Clubs,
|
||||
Card Eight Clubs, Card King Clubs]
|
||||
hand1 = [Card Jack Spades, Card Jack Hearts, Card Ten Spades, Card Ace Hearts, Card Ten Hearts,
|
||||
Card Nine Hearts, Card Seven Clubs, Card Ace Clubs, Card King Diamonds,
|
||||
Card Ten Diamonds]
|
||||
hand2 = [Card Eight Spades, Card Queen Spades, Card Seven Spades, Card Seven Diamonds,
|
||||
Card Seven Hearts, Card Eight Hearts, Card Queen Hearts, Card King Hearts,
|
||||
Card Nine Diamonds, Card Eight Diamonds]
|
||||
hands = map (putAt Hand1) hand1
|
||||
++ map (putAt Hand2) hand2
|
||||
++ map (putAt Hand3) hand3
|
||||
skt = [Card Nine Clubs, Card Queen Clubs]
|
||||
|
||||
singleVsBots :: (Team -> Hand -> OnlineEnv) -> IO ()
|
||||
singleVsBots mkPlayer = do
|
||||
cards <- liftIO $ shuffleCards
|
||||
--let gen = mkStdGen 123
|
||||
-- cards = shuffleCardsWithGen gen
|
||||
let ps = Players
|
||||
(PL $ mkPlayer Team Hand1)
|
||||
(PL $ Stupid Team Hand2)
|
||||
(PL $ mkAIEnv Single Hand3 10)
|
||||
env = SkatEnv (distribute cards) Nothing Spades ps
|
||||
env = SkatEnv cardDistr Nothing Spades ps
|
||||
liftIO $ evalStateT (publishGameStart Hand3 >> turn Hand1 >>= publishGameResults) env
|
||||
|
||||
Reference in New Issue
Block a user