Strategies.hs

{-# LANGUAGE FlexibleContexts, CPP #-}
module Game.Hanabi.Strategies(module Game.Hanabi.Strategies,
                              module Game.Hanabi.Strategies.SimpleStrategy,
                              module Game.Hanabi.Strategies.StatefulStrategy,
                              module Game.Hanabi.Strategies.Stateless,
                              module Game.Hanabi.Strategies.EndGameSearch,
                              module Game.Hanabi.Strategies.MCSearch,
#ifdef MHLMC
                              module Game.Hanabi.Strategies.AdaptiveLMC,
                              module Game.Hanabi.Strategies.AppendDSL
#endif
                             ) where

import Game.Hanabi.Strategies.SimpleStrategy hiding (main)
import Game.Hanabi.Strategies.StatefulStrategy hiding (main, lookupOn)
import Game.Hanabi.Strategies.Stateless hiding (main)
import Game.Hanabi.Strategies.EndGameSearch hiding (main)
import Game.Hanabi.Strategies.MCSearch(mcs)
import qualified Game.Hanabi.Strategies.LazyMC as LMC
#ifdef MHLMC
import Game.Hanabi.Strategies.AdaptiveLMC
import Game.Hanabi.Strategies.AppendDSL
#endif
import System.Random

import Data.Typeable
import Game.Hanabi(pileNum, DynamicStrategy, mkDS, Strategy(..)) -- (Replay(..))


-- DynamicStrategyにする前にpreloadしないと、DynamicStrategyのinitializeが使われる。

type Constrs = Bool -> IO (IO (DynamicStrategy IO))
mkStr :: (String, String -> DynamicStrategy IO) -> (String, Maybe Constrs)
mkStr (xs, f)  = (xs, Just $ preload (return $ f xs) return)
mkStrIO :: (String, String -> IO (DynamicStrategy IO)) -> (String, Maybe Constrs)
mkStrIO (xs, f) = (xs, Just $ preload (f xs) return)
mksd :: (Strategy t IO, Typeable t) => t -> String -> DynamicStrategy IO
mksd = flip mkDS
mksdIO :: (Strategy t IO, Typeable t) => IO t -> String -> IO (DynamicStrategy IO)
mksdIO iop s = fmap (mkDS s) iop

preload :: Strategy p m =>
           m p           -- ^ constructor that should be executed only once that can take time,
                         --   such as reading parameters from a file or maybe self-contained training
           -> (p -> m p) -- ^ constructor that require different behaviour at every game,
                         --   such as setting RNG or creating network socket
           -> Bool       -- ^ if True, initialize lazily, i.e., does not stop computation until the initialization finishes
           -> m (m p)
preload oneShot beforeTheGame lz = do p <- oneShot
                                      p' <- initialize lz p
                                      return (beforeTheGame p')

-- | 'predefinedStrategies' is the list of strategies included in this library, with some recommended parameters.
--   This value is subject to change in future versions, and adding strategies to this list is considered as extension rather than modification.
predefinedStrategies :: [(String, Maybe Constrs)]
predefinedStrategies = map mkStr [
     ("Stupid example strategy",                                                                     mksd $ S False),
--     ("Example strategy with states",                                                                mksd $ sfs (S False)),
     ("Stateless implementation of the strategy with states",                                        mksd $ SL $ S False),
     ("Strategy with states with aggressive positional drop",                                        mksd $ sf),
     ("Strategy with end game search",                                                               mksd $ EG $ SL (S False)),
--     ("Strategy with end game search with aggressive positional drop",                               mksd $ EG $ sf),
--     ("Strategy with Monte Carlo search assuming Stateless with aggressive positional drop (light)", mksd $ lightmc),
     ("Strategy with Monte Carlo search assuming Stateless with aggressive positional drop",         mksd $ mc),
     ("Lazy Monte Carlo search specialized to Stateful with aggressive positional drop",             mksd $ lmc $ sf)
--   , ("Lazy Monte Carlo search specialized to Stateless with aggressive positional drop",            mksd $ lmc $ sl)
  ]
#ifdef MHLMC
  ++ [mkStrIO ("Adaptive Lazy Monte Carlo without incremental learning",
               mksdIO $ mkAdaptiveLMC (PADSL (PALMC 0 AverageScore FromTheBeginning 800 False) 1 (ProgsPerDepth 20000)) instinct $ mkStdGen 54321012345)]
#else
  ++ [("Adaptive Lazy Monte Carlo without incremental learning", Nothing)]
#endif

lightmc = mcs (\pub -> pileNum pub < 8) 3000 (mkStdGen 1234567890) (SL $ S True) (SL $ S True) $ repeat $ SL $ S True
mc = mcs (\pub -> pileNum pub < 18) 6000 (mkStdGen 1234567890) (SL $ S True) (SL $ S True) $ repeat $ SL $ S True

lmc sf = LMC.lmcs LMC.AvoidZero 400 100 (mkStdGen 1234567890) sf sf [repeat sf]

sl = SL $ S True
sf = sfs $ S True