hanabi-dealer-0.11.0.1: Game/Hanabi/Strategies/EndGameSearch.hs
{-# 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