{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} module Game.Hanabi.Strategies.SimpleStrategy where import Game.Hanabi hiding (main) import System.Random import Data.Maybe(isNothing) import Data.List(zip4, sortOn) import Data.Bits(bit) -- An example of a simple and stupid strategy. data Simple = S instance Monad m => Strategy Simple m where strategyName ms = return "Stupid example strategy" move (pv:pvs) mvs s = let pub = publicView pv nextPlayersHand = head $ handsPV pv ::[Card] nextPlayersHints = givenHints pub !! 1 nextPlayersPos = possibilities pub !! 1 nextPlayer = zip4 [0..] nextPlayersHand nextPlayersHints nextPlayersPos myHints = head $ givenHints pub myPos = head $ possibilities pub myHand = zip3 [0..] myHints myPos numHand = length myHints isColorMarkable col = isPlayable pub (head [ c | (j,c,(_,Nothing),_) <- nextPlayer, color c == col ]) || any (isPlayable pub) [ c | (j,c,(Nothing,Just num),_) <- nextPlayer, color c == col ] isNewestOfColor i d = null [ () | (j,c,(_,Nothing),_) <- nextPlayer, color c == color d, j < i ] -- True if there is no newer number-unmarked card of the same color in nextPlayer. markCandidates = filter (\(_,card,_,pos) -> isPlayable pub card && not (isObviouslyPlayable pub pos)) $ reverse nextPlayer -- Playable cards that are not enough hinted, old to new. markUnhintedCritical = take 1 [ Hint 1 (if isColorMarkable (color te) then Left $ color te else Right $ number te) | (_ix, te, hint, _pos) <- reverse nextPlayer, not (isHinted hint), isCritical pub te ] keep2 = take 1 [ Hint 1 $ Right $ K2 | (_ix, te@(C _ K2), hint, _pos) <- reverse nextPlayer, not (isHinted hint), not $ isUseless pub te ] colorMarkUnmarkedPlayable = take 1 [ Hint 1 $ Left $ color d | (i,d,(Nothing, Nothing),_) <- markCandidates, -- Mark the color if a (not obviously) playable card is not marked isNewestOfColor i d ] -- but be cautious not to color-mark newer cards. colorMarkNumberMarkedPlayable = take 1 [ Hint 1 $ Left $ color d | (_,d,(Nothing, Just _),_) <- markCandidates ] -- Mark the color if a (not obviously) playable card is only number-marked. numberMarkPlayable = take 1 [ Hint 1 $ Right $ number d | (_,d,(_, Nothing),_) <- markCandidates ] -- Mark the number if a (not obviously) playable card is not number-marked. numberMarkUselessIfInformative = take 1 [ Hint 1 $ Right $ number d | (_,d,_,p@(pc, _)) <- nextPlayer, not $ isObviouslyUseless pub p, isObviouslyUseless pub (pc, bit $ 5 - fromEnum (number d)) ] colorMarkUselessIfInformative = take 1 [ Hint 1 $ Left $ color d | (i,d,_,p@(_, pn)) <- reverse nextPlayer, not $ isObviouslyUseless pub p, isObviouslyUseless pub (bit $ 5 - fromEnum (color d), pn), isNewestOfColor i d ] -- but be cautious not to color-mark newer cards. numberMarkUnmarked = take 1 [ Hint 1 $ Right $ number d | (_,d,(Nothing, Nothing),p) <- nextPlayer, not $ isObviouslyUseless pub p ] numberMarkNumberUnmarked = take 1 [ Hint 1 $ Right $ number d | (_,d,(Just _, Nothing),p) <- nextPlayer, not $ isObviouslyUseless pub p ] colorMarkColorUnmarked = take 1 [ Hint 1 $ Left $ color d | (i,d,(Nothing, Just _),p) <- reverse nextPlayer, not $ isObviouslyUseless pub p, isNewestOfColor i d ] -- but be cautious not to color-mark newer cards. playPlayable5 = take 1 [ Play i | (i,marks@(_,Just K5),pos) <- myHand, isDefinitelyPlayable pv marks pos ] dropUselessCard = take 1 [ Drop i | hintTokens pub < 7, (i,marks,pos) <- reverse myHand, isDefinitelyUseless pv marks pos ] dropSafe = take 1 [ Drop i | (i,marks,pos) <- reverse myHand, isDefinitelyUncritical pv marks pos ] dropPossiblyUncritical = take 1 [ Drop i | (i,marks,pos) <- reverse myHand, not $ isDefinitelyCritical pv marks pos ] sontakuColorMark = case mvs of -- When the last move is color mark, Hint 1 (Left c) : _ | isDefinitelyUseless pv (myHints!!i) (myPos!!i) -> [Drop i] -- If the first color-marked is obviously useless, drop it. | isDefinitelyUnplayable pv (myHints!!i) (myPos!!i) -> [] -- If the first color-marked is unplayable for now, ignore it. | otherwise -> [Play i] -- Otherwise, it means "Play!" where i = length $ takeWhile ((/=Just c) . fst) $ head $ givenHints $ publicView pv -- (This should also be rewritten using list comprehension.) _ -> [] sontakuPositionalDrop = case mvs of Drop i : _ | i `notElem` unusualChops -> [] -- It is not a positional drop if nothing is unusual. | not $ isDefinitelyUnplayable pv (myHints!!i) (myPos!!i) -> [Play i] | otherwise -> [Drop i] -- if by no means it is playable, it means "drop it" (unless there are 8 hints), even if isDefinitelyCritical. where lastpub = publicView (head pvs) lastHints = last (givenHints lastpub) lastPos = last (possibilities lastpub) unusualChops = drop 1 $ concat $ map reverse $ obviousChopss lastpub lastHints lastPos _ -> [] dropChopUnlessDoubleDrop = [ Drop i | is@(i:_) <- take 1 $ map reverse $ definiteChopss pv myHints myPos, not $ isDoubleDrop pv (result pub) is $ myPos !! i ] dropChop = [ Drop i | i:_ <- take 1 $ definiteChopss pv myHints myPos ] current = currentScore pub achievable = achievableScore pub enoughDeck = prolong (Game.Hanabi.rule $ gameSpec pub) || achievable - current < pileNum pub mov = head $ filter (isMoveValid pv) $ sontakuPositionalDrop ++ markUnhintedCritical ++ (if hintTokens pub >= 2 || not enoughDeck then colorMarkUnmarkedPlayable else []) ++ (if hintTokens pub >= 4 then colorMarkNumberMarkedPlayable ++ numberMarkPlayable ++ keep2 else []) -- Do one of these only when there are spare hint tokens. ++ playPlayable5 ++ (if enoughDeck then dropUselessCard else []) -- Drop a useless card unless endgame is approaching. ++ take 1 [ Play i | (i,marks,pos) <- myHand, isDefinitelyPlayable pv marks pos ] -- Play a playable card ++ sontakuColorMark -- guess the meaning of the last move, and believe it. ++ dropChopUnlessDoubleDrop ++ colorMarkUnmarkedPlayable ++ colorMarkNumberMarkedPlayable ++ numberMarkPlayable ++ dropUselessCard ++ keep2 ++ colorMarkUselessIfInformative ++ numberMarkUselessIfInformative ++ colorMarkColorUnmarked ++ numberMarkNumberUnmarked ++ dropSafe -- drop the oldest 'safe to drop' card ++ numberMarkUnmarked ++ [Hint 1 $ Right n | n <- [K1 .. K5]] ++ dropChop -- ++ dropPossiblyUncritical -- This may not be a good idea. See Haddock comment on Hanabi.isDefinitelyCritical. ++ reverse [ Drop i | (i,_,_) <- sortOn (\(_,(_,mb),_) -> fmap fromEnum mb) myHand ] in return (mov, s) main = do g <- newStdGen -- ((eg,_),_) <- start defaultGS [] ([S],[stdio]) g -- Play it with standard I/O (human player). ((eg,_),_) <- start defaultGS [peek] [S,S] g -- Play it with itself. putStrLn $ prettyEndGame eg