LILiK
/
icfp2015


								{-# LANGUAGE BangPatterns #-}

								{-# 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 :: 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 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) ++ " "