LILiK
/
icfp2015


								{-# LANGUAGE BangPatterns #-}

								{-# LANGUAGE DeriveGeneric #-}

								{-# LANGUAGE ExistentialQuantification #-}

								{-# OPTIONS -Wall #-}


								module Main where


								import Control.DeepSeq (deepseq, NFData(..))

								import Data.Int

								import qualified Data.ByteString.Lazy.Char8 as BS

								import System.Environment

								import System.Random

								import System.Clock

								import GHC.Generics

								import Data.Aeson


								import StrategyManager

								import Strategy0

								import Datatypes.Game(Game,Command,commandsToString,stringToCommands)

								--import VM

								import Opt

								import JSONDeser(readInput)


								strategyTag :: String

								strategyTag = "lilik0"


								logFileName :: String

								logFileName = "scores"


								timeLimitRatio :: Double

								timeLimitRatio = 0.96


								memLimitRatio :: Double

								memLimitRatio = 1.0


								computationsPerStep :: Int

								computationsPerStep = 10


								data JSONSer = JSONSer { problemId :: Int,

								                         problemSeed :: Int,

								                         problemTag :: String,

								                         problemSolution :: String

								                       } deriving (Show, Generic)


								instance FromJSON JSONSer

								instance ToJSON JSONSer


								type Id = Int

								type Seed = Int


								strategies :: Game -> StdGen ->  [[Command]] -> GameComputation

								strategies g sgen cmd = [MkStrategyWrapper (initst g sgen cmd :: Strategy0)]


								-- = [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 initTime <- secTime

								          args <- getArgs

								          opt <- parseArgs args

								          let files       = optFile                opt

								          let maxTime     = optTime                opt

								          let maxMem      = optMem                 opt

								          let powerPhrases = optPowerPhrase         opt

								          let logFile     = optLog                 opt

								          rng <- getStdGen

								          initialData <- createComputationsFromFiles files rng powerPhrases

								          let (_, _,gameComputations) = unzip3 initialData

								          commandResults <- iterateGame gameComputations (timeStruct maxTime initTime) maxMem

								          let stringResults = map (\(cmds,score,algoIdx) -> (commandsToString cmds,score,algoIdx)) commandResults

								          let outJSONstructs = zipWith jsonBuilder initialData stringResults

								          BS.putStrLn $ encode outJSONstructs

								          writeLogFile logFile (zipWith logFileBuilder initialData stringResults)

								  where

								    timeStruct Nothing    _               = Nothing

								    timeStruct (Just stopTime) initialTime = Just (fromIntegral stopTime,fromIntegral initialTime)


								    jsonBuilder (idx, seed, _) (strCmds, _, _)         = (JSONSer idx seed strategyTag strCmds)

								    logFileBuilder (idx, seed, _) (_ ,score , algoIdx) = (idx, seed, score, algoIdx)


								createComputationsFromFiles :: [String] -> StdGen -> [String] -> IO [(Id,Seed,GameComputation)]

								createComputationsFromFiles fileNames randomGen powerPhrases = do inputs <- readFiles fileNames

								                                                                  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 game = strategies game randomGen (map stringToCommands powerPhrases)


								readFiles :: [String] -> IO [BS.ByteString]

								readFiles []     = return []

								readFiles (x:xs) = do f  <- BS.readFile x

								                      fs <- readFiles xs

								                      return (f:fs)


								instance NFData Command where rnf x = seq x ()


								iterateGame :: [GameComputation] -> Maybe (Double,Double) -> Maybe Int -> IO [FinishedGame]

								iterateGame gameComputations timeLimitData memLimitData = do alive <- checkComputationAlive

								                                                             if alive

								                                                             then nextPass

								                                                             else return bestGames

								  where

								    nextPass              = (bestGames `deepseq` (iterateGame nextGameComputations timeLimitData memLimitData))

								    nextGameComputations  = (applyNtimes computationsPerStep advanceGameComputations gameComputations)

								    checkComputationAlive = do timeLimitFlag <- timeLimit timeLimitData

								                               memLimitFlag  <- memLimit memLimitData

								                               let finishedComputation = (and $ map finishedGameComputation gameComputations)

								                               return $ not (timeLimitFlag || memLimitFlag || finishedComputation)

								    advanceGameComputations computations = map advanceGameComputation computations

								    bestGames = map getBestGameComputation gameComputations


								timeLimit :: Maybe (Double, Double) ->  IO Bool

								timeLimit Nothing = return False

								timeLimit (Just (initialTime,stopTime)) = do actualTime <- secTime

								                                             let actualTimeD = fromIntegral actualTime

								                                             let timeDifference = (actualTimeD - initialTime)

								                                             return (stopTime <= timeDifference)


								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\n"

								      where

								        sa = (show a) ++ " "

								        sb = (show b) ++ " "

								        sc = (show c) ++ " "

								        sd = (show d) ++ " "


								applyNtimes :: Int -> (a -> a) -> a -> a

								applyNtimes 0 _ accum = accum

								applyNtimes n f accum = applyNtimes (n - 1) f (f accum)