{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} module Game.Hanabi.Strategies.SimpleStrategy where import Game.Hanabi hiding (main) import System.Random import Data.Maybe(isNothing) -- 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:_) mvs s = let pub = publicView pv nextPlayersHand = head $ handsPV pv ::[Card] nextPlayersHints = givenHints pub !! 1 nextPlayer = zip3 [0..] nextPlayersHand nextPlayersHints myHints = head $ givenHints pub myPos = head $ possibilities pub numHand = length myHints mov = case filter (\(ix, te, hint) -> not (isHinted hint) && isCritical pub te) nextPlayer of [] -> foo us -> tryMove pv (Hint 1 $ Right (number $ sndOf3 $ last us)) foo where foo = case break (\(_,card,_) -> isPlayable pub card) nextPlayer of (ts,(_,d,(Nothing, _)) :_) | hintTokens pub >= 3 && all (\(_,c,_) -> color c /= color d) ts -> Hint 1 $ Left $ color d (ts,(_,d,(Just _, Nothing)):_) | hintTokens pub >= 4 -> Hint 1 $ Right $ number d -- This should actually be ANY card. _ -> case filter (\(i,marks,pos) -> isDefinitelyPlayable pv marks pos) $ zip3 [0..] myHints myPos of (i,_,_):_ -> Play i [] -> case mvs of Hint 1 (Left c) : _ | isDefinitelyUseless pv (myHints!!i) (myPos!!i) -> tryMove pv (Drop i) rest | otherwise -> Play i where i = length $ takeWhile ((/=Just c) . fst) $ head $ givenHints $ publicView pv _ -> rest where rest = case definiteChopss pv myHints myPos of ((i:_):_) -> tryMove pv (Drop i) (Hint 1 $ Right $ number $ last $ nextPlayersHand) _ -> tryMove pv (Hint 1 $ Right $ number $ last $ nextPlayersHand) (Drop $ pred numHand) in return (mov, s) sndOf3 (_,b,_) = b 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