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 Data.Maybe


								import StrategyManager

								import Strategy0

								import Datatypes.Game(Game,Command)

								import VM

								import Opt

								import JSONDeser(readInput)

								import PowerPhrases


								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 ->  Maybe [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 powerPhrase = optPowerPhrase         opt

								          let logFile     = optLog                 opt

								          rng <- getStdGen

								          initialData <- createComputationsFromFiles files rng powerPhrase

								          let (_, _,gameComputations) = unzip3 initialData

								          commandResults <- iterateGame gameComputations (timeStruct maxTime initTime) maxMem

								          let stringResults = map (\(cmds,score,algoIdx) -> (cmdToString 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 -> Maybe String -> IO [(Id,Seed,GameComputation)]

								createComputationsFromFiles fileNames randomGen powerPhrase = 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 (powerCommands powerPhrase)

								    powerCommands Nothing  = Nothing

								    powerCommands (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)


								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)