{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, CPP #-} module Game.Hanabi.Strategies.EndGameSearch where import Game.Hanabi hiding (main) import Game.Hanabi.Strategies.Stateless hiding (main) import Game.Hanabi.Strategies.SimpleStrategy hiding (main) import System.Random -- x #define EXACT -- A strategy with endgame search #ifdef EXACT data EndGameSearch = EG | EGS (EndGameMirrorLite Stateless (EndGameLite Stateless Stateless [EndGameMirrorLite Stateless Stateless])) mkEG :: Int -> EndGameMirrorLite Stateless (EndGameLite Stateless Stateless [EndGameMirrorLite Stateless Stateless]) #else data EndGameSearch = EG | EGS (EndGameMirrorLite Stateless (EndGameLite Stateless Stateless [Stateless])) mkEG :: Int -> EndGameMirrorLite Stateless (EndGameLite Stateless Stateless [Stateless]) #endif mkEG nump = -- assumeOthersAre SL SL -- searchExhaustivelyLite SL #ifdef EXACT searchExhaustivelyLite $ assumeOthers SL $ searchExhaustivelyLite SL -- This is more exact, but sometimes prohibitively time-consuming. #else searchExhaustivelyLite $ assumeOthers SL SL #endif -- searchExhaustively SL -- assumeOthersAreSL SL -- searchExhaustively $ assumeOthersAreSL SL where searchExhaustivelyLite :: s -> EndGameMirrorLite Stateless s searchExhaustivelyLite fallback = egml (\pub -> pileNum pub == 0) SL fallback nump assumeOthers fallback other = egl (\pub -> pileNum pub <= 1) SL fallback $ replicate (pred nump) other searchExhaustively fallback = egmo (\pub -> pileNum pub == 0) fallback nump assumeOthersAreSL fallback = EGO (\pub -> pileNum pub <= 1 && hintTokens pub <= 2) fallback $ replicate (pred nump) SL -- assumeOthersAreSL fallback = EGO (\pub -> pileNum pub <=2 && hintTokens pub <= 4) fallback $ replicate (pred nump) SL -- assumeOthersAreSL fallback = EGO (\pub -> pileNum pub + hintTokens pub < 4) fallback $ replicate (pred nump) SL instance (Monad m) => Strategy EndGameSearch m where strategyName ms = return "EndGame" move pvs@(pv:_) mvs EG = do (m, e') <- move (sontakuColorHint pvs mvs) mvs $ mkEG $ numPlayers $ gameSpec $ publicView pv return (m, EGS e') move pvs@(pv:_) mvs (EGS e) = do (m, e') <- move (sontakuColorHint pvs mvs) mvs e return (m, if pileNum (publicView pv) > 1 then EG else EGS e') main = do g <- newStdGen ((eg,_),_) <- start defaultGS [] ([EG], [stdio]) g -- Play it with standard I/O (human player). -- ((eg,_),_) <- start defaultGS [peek] [EG, EG] g -- Play it with itself. putStrLn $ prettyEndGame eg