{-# LANGUAGE CPP, FlexibleContexts, RecordWildCards #-}
module Main where
import Game.Hanabi.VersionInfo
import Game.Hanabi.Strategies
import System.Random
#ifdef TFRANDOM
import System.Random.TF
import System.Random.TF.Gen
#else
import System.Random.SplitMix
#endif
import Game.Hanabi.Strategies.AppendDSL
import MagicHaskeller
import Control.Monad.Search.Combinatorial(unMx)
import Control.Concurrent
import Control.Concurrent.MVar
import System.Environment
import System.IO
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad.Trans.Class(lift)
import Data.List(transpose)
import Game.Hanabi hiding (main) -- (pileNum, egToInt, Card) -- (Replay(..))
newGen = newSMGen
runOnceToInt :: StateT (AdaptiveLMC SMGen (Stateful Sless), SMGen) IO Int
runOnceToInt = do
(almc, g) <- get
guessedProgName <- foldr const (return "No program remained!") $ map (strategyName . return) (concat $ unMx $ head $ rolloutStrategiesLMC almc :: [Stateful Sless])
lift $ putStrLn $
"------------------------------------------------------\n"
++ guessedProgName
++ "\n------------------------------------------------------\n"
let (gen,g') = split g
#ifdef TEST
{-
(((eg,st:_,_),(_,[almc'])),_) <-startToEnd defaultGS [] ([SF {guessColorToPlay=True,
guessPositionalDrop=True,
baseStrategy=simpleSl,
anns=[]}
], [almc]) gen
-}
-- (((eg,st:_,_),(_,[almc'])),_) <-startToEnd defaultGS [] ([testSl], [almc]) gen
-- (((eg,st:_,_),(_,[almc'])),_) <-startToEnd defaultGS [] ([SL $ S False], [almc]) gen
(((eg,st:_,_),(_,[almc'])),_) <-startToEnd defaultGS [] ([SF{guessColorToPlay=True, guessPositionalDrop=True, baseStrategy=S False, anns=[]}], [almc]) gen
#else
(((eg,st:_,_),(_,[almc'])),_) <-startToEnd defaultGS [] ([simpleSl], [almc]) gen
#endif
put (almc', g')
lift $ print $ egToInt st eg
return $ egToInt st eg
tryManyExperiments :: ExpSpec -> IO [[Int]]
tryManyExperiments ES{..} = do
hSetBuffering stdout NoBuffering
seed <- case mbSeed of
Nothing -> newGen
Just s -> return s
{-
-- let seed = read "SMGen 13080994445437667243 17591135057895218335" :: SMGen -- unlucky
let seed = read "SMGen 7907189382150968454 13455886919517719531" :: SMGen -- lucky
-}
putStrLn $ "seed = " ++ show seed
let (g0, g1) = split seed
putStrLn ("(g0,g1) = " ++ show (g0,g1))
hPutStr stderr "Preparing MagicHaskeller..."
-- constrAssoc <- mapM sequenceA [ (name, crs) | (name, Just crs) <- predefinedStrategies]
-- almc <- snd $ last constrAssoc
ioalmc <- preload (mkAdaptiveLMC paramsES instinct g0) return False
hPutStrLn stderr "Done!"
let gens = take numExperiments $ map snd $ iterate (split.fst) $ split g1
putStrLn $ "seeds = " ++ show gens
mvars <- sequence $ replicate numExperiments newEmptyMVar
mapM_ (forkIO . tryManyGames ioalmc numGames) $ zip gens mvars
mapM takeMVar mvars
data ExpSpec = ES { mbSeed :: Maybe SMGen
, numExperiments :: Int
, numGames :: Int
, paramsES :: ParamsADSL -- could be an ADT, maybe defined in Strategies.hs
, outFile :: FilePath
}
deriving (Show, Read)
defaultES = ES (read "Just (SMGen 7907189382150968454 13455886919517719531)") 10 40 (PADSL (PALMC 0 AverageScore PartiallyObserved {- FromTheBeginning -} 800 False) 1 (ProgsPerDepth 20000)) "noname.out"
tryManyGames :: IO (AdaptiveLMC SMGen (Stateful Sless)) -> Int -> (SMGen, MVar [Int]) -> IO ()
tryManyGames ioalmc n (gen,mvar) = do
almc <- ioalmc
{-
#ifdef TEST
almc <- mkAdaptiveLMC 200000 simpleInstinct g0
#else
almc <- mkAdaptiveLMC 200000 instinct g0
#endif
-- ready almc `seq` hPutStrLn stderr "Done!"
almc' <- initialize almc
hPutStrLn stderr "Done!"
-}
result <- evalStateT (sequence $ replicate n $ runOnceToInt) (almc, gen)
putMVar mvar result
-- convert the result of tryManyExperiments into a String that can be supplied to Gnuplot.
experimentsToPlottable :: [[Int]] -> String
experimentsToPlottable es = unlines $ map (\(x, vs) -> unwords $ map show [x, average vs, sd vs]) $ zip [1..] $ transpose es
average :: [Int] -> Double
average xs = fromIntegral (sum xs) / fromIntegral (length xs)
variance :: [Int] -> Double
variance xs = average [ x*x | x<-xs] - ave * ave
where ave = average xs
sd :: [Int] -> Double
sd xs = sqrt $ variance xs
-- チームメイトがまだparameterizeされていなくて、TESTで頑張ってる
main = do let ver = versionInfo
hPutStrLn stderr ver
mbFilename <- lookupEnv "EXPSPEC"
es <- case mbFilename of Nothing -> do hPutStrLn stderr "EXPSPEC not defined. Using the default."
return defaultES
Just fn -> do cs <- readFile fn
readIO cs
resultss <- tryManyExperiments es
let reportLastGames n = let results = concat $ map (drop (numGames es - n)) resultss
in "Average of averages of last "++shows n " games = " ++ shows (average results) ", S.D. = " ++ shows (sd results) "\n"
appendFile (outFile es) $ ver ++ "\n" ++ show resultss ++ '\n' : reportLastGames 5 ++ reportLastGames 10
reproduceSplit :: IO ()
reproduceSplit = do
hSetBuffering stdout NoBuffering
let g0 = read "SMGen 11480901701853605824 13110886293999377183" :: SMGen
let g = read "SMGen " :: SMGen
putStrLn ("(g0,g) = " ++ show (g0,g))
#ifdef TEST
almc <- mkAdaptiveLMC (PADSL (PALMC 0 AverageScore PartiallyObserved 800 False) 1 (ProgsPerDepth 200000)) simpleInstinct g0
#else
almc <- mkAdaptiveLMC (PADSL (PALMC 0 AverageScore PartiallyObserved 800 False) 1 (ProgsPerDepth 200000)) instinct g0
#endif
runStateT runOnceToInt (almc,g)
return ()