{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE ExistentialQuantification #-}
|
|
{-# OPTIONS -Wall #-}
|
|
|
|
module Main where
|
|
|
|
import Data.Int
|
|
import Data.List
|
|
import qualified Data.ByteString.Lazy.Char8 as BS
|
|
import System.Environment
|
|
import System.Random
|
|
import System.Clock
|
|
import GHC.Generics
|
|
import Data.Aeson
|
|
import Data.Maybe
|
|
|
|
import StrategyManager
|
|
import Strategy0
|
|
import Datatypes
|
|
import Datatypes.Game
|
|
import VM
|
|
import Opt
|
|
import JSONDeser(readInput)
|
|
import PowerPhrases
|
|
|
|
ptag :: String
|
|
ptag = "lilik0"
|
|
logfilename :: String
|
|
logfilename = "scores"
|
|
|
|
timelimitratio :: Double
|
|
timelimitratio = 1.0
|
|
memlimitratio :: Double
|
|
memlimitratio = 1.0
|
|
gccompperstep :: Integer
|
|
gccompperstep = 100
|
|
|
|
|
|
data JSONSer = JSONSer { problemId :: Int,
|
|
seed :: Int,
|
|
tag :: String,
|
|
solution :: String
|
|
} deriving (Show, Generic)
|
|
|
|
instance FromJSON JSONSer
|
|
instance ToJSON JSONSer
|
|
|
|
type Id = Int
|
|
type Seed = Int
|
|
|
|
strategies :: Game -> StdGen -> Maybe [Command] -> GameComputation
|
|
strategies g sgen cmd = [MkStrategyWrapper (initst g sgen cmd :: NullStrategy1)]
|
|
|
|
-- = [MkStrategyWrapper (initst g sgen cmd :: NullStrategy1),
|
|
-- MkStrategyWrapper (initst g sgen cmd :: NullStrategy2)]
|
|
|
|
-- example ::
|
|
-- = [MkStrategyWrapper (init g sgen cmd :: Strat0),
|
|
-- MkStrategyWrapper (init g sgen cmd :: Strat1),
|
|
-- MkStrategyWrapper (init g sgen cmd :: Strat2)]
|
|
|
|
main :: IO ()
|
|
main = do args <- getArgs
|
|
opt <- parseArgs args
|
|
let files = optFile opt
|
|
let timelimit = optTime opt
|
|
let memlimit = optMem opt
|
|
let powerp = optPowerPhrase opt
|
|
let cores = optCores opt
|
|
let logf = optLog opt
|
|
rng <- getStdGen
|
|
loaddata <- createComputationsFromFiles files rng powerp
|
|
let (ids,seeds,gamecomputations) = unzip3 loaddata
|
|
inittime <- secTime
|
|
results <- iterategc gamecomputations (timestruct timelimit inittime) memlimit
|
|
putStrLn "lol"
|
|
let (commandswpoints,strat) = unzip results
|
|
let (commandlists, points) = unzip commandswpoints
|
|
let wordlists = map cmdToString commandlists
|
|
let outJSONstructs = zipWith3 (\x y z -> (JSONSer x y ptag z)) ids seeds wordlists
|
|
BS.putStrLn $ encode outJSONstructs
|
|
writelogfile logf (zip4 ids seeds points strat)
|
|
where
|
|
timestruct Nothing _ = Nothing
|
|
timestruct (Just maxtime) intime = Just (maxtime, intime)
|
|
|
|
createComputationsFromFiles :: [String] -> StdGen -> Maybe String -> IO [(Id,Seed,GameComputation)]
|
|
createComputationsFromFiles fns sg pp = do inputs <- readFiles fns
|
|
let igames = map readInput inputs
|
|
let cstruct = compstruct igames
|
|
return (gcstruct cstruct)
|
|
where
|
|
compstruct ig = concat (map genf ig)
|
|
genf (i,g) = zipWith (\x (y,z) -> (x,y,z)) (replicate (length g) i) g
|
|
gcstruct cst = map (\(x,y,z) -> (x,y,j z))cst
|
|
where
|
|
j z = strategies z sg (ppascommands pp)
|
|
ppascommands Nothing = Nothing
|
|
ppascommands (Just a) = Just (mapMaybe charToCommand a)
|
|
|
|
readFiles :: [String] -> IO [BS.ByteString]
|
|
readFiles [] = return []
|
|
readFiles (x:xs) = do f <- BS.readFile x
|
|
fs <- readFiles xs
|
|
return (f:fs)
|
|
|
|
iterategc :: [GameComputation] -> Maybe (Int,Int64) -> Maybe Int -> IO [(([Command], Int), Int)]
|
|
iterategc gcs tlimit mlimit = do rtl <- timeLimit tlimit
|
|
rml <- memLimit mlimit
|
|
(gcresult rtl rml)
|
|
where
|
|
gcresult True _ = return best
|
|
gcresult _ True = return best
|
|
gcresult _ _ = if (and $ map finishedGameComputation gcs)
|
|
then return best
|
|
else iterategc (applyNtimes gccompperstep itf gcs) tlimit mlimit
|
|
where
|
|
itf gcs1 = map (\x -> advanceGameComputation x) gcs1
|
|
applyNtimes 1 f x = f x
|
|
applyNtimes n f x = f (applyNtimes (n-1) f x)
|
|
best = map getBestGameComputation gcs
|
|
|
|
timeLimit :: Maybe (Int,Int64) -> IO Bool
|
|
timeLimit Nothing = return False
|
|
timeLimit (Just (itime,limit)) = do atime <- secTime
|
|
let diff = (atime - (fromIntegral itime))
|
|
return (((fromIntegral limit) * timelimitratio) < (fromIntegral diff))
|
|
|
|
|
|
memLimit :: Maybe Int -> IO Bool
|
|
memLimit _ = return False
|
|
|
|
secTime :: IO Int64
|
|
secTime = do (TimeSpec s _) <- getTime Monotonic
|
|
return s
|
|
|
|
writelogfile :: Bool -> [(Int,Int,Int,Int)] -> IO ()
|
|
writelogfile False _ = return ()
|
|
writelogfile _ els = writeFile logfilename scoredata
|
|
where
|
|
scoredata = foldl strlog "\n" els
|
|
strlog x (a,b,c,d) = sa ++ sb ++ sc ++ sd ++ x ++ "\n"
|
|
where
|
|
sa = (show a) ++ " "
|
|
sb = (show b) ++ " "
|
|
sc = (show c) ++ " "
|
|
sd = (show d) ++ " "
|