diff --git a/icfp2015.cabal b/icfp2015.cabal index c3b1002..734a37d 100644 --- a/icfp2015.cabal +++ b/icfp2015.cabal @@ -60,7 +60,7 @@ executable icfp2015 other-extensions: OverloadedStrings, DeriveGeneric, DeriveDataTypeable -- Other library packages from which modules are imported. - build-depends: base >=4.6 && <4.9, hashable >=1.2 && <1.3, containers >=0.5 && <0.6, QuickCheck >=2.7 && <2.9, bytestring >=0.10 && <0.11, aeson >=0.8 && <0.9, pqueue >=1.3 && <1.4 + build-depends: base >=4.6 && <4.9, hashable >=1.2 && <1.3, containers >=0.5 && <0.6, QuickCheck >=2.7 && <2.9, bytestring >=0.10 && <0.11, aeson >=0.8 && <0.9, pqueue >=1.3 && <1.4, clock >= 0.1 -- Directories containing source files. hs-source-dirs: src diff --git a/src/JSONDeser.hs b/src/JSONDeser.hs index 10e28c2..b85fded 100644 --- a/src/JSONDeser.hs +++ b/src/JSONDeser.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} -module JSONDeser(readInput) where +module JSONDeser where import qualified Data.Set as Set import Data.Maybe diff --git a/src/Mainpf.hs b/src/Mainpf.hs new file mode 100644 index 0000000..b2ac481 --- /dev/null +++ b/src/Mainpf.hs @@ -0,0 +1,127 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# OPTIONS -Wall #-} + +module Mainf where + +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 Datatypes +import Datatypes.Game +import VM +import Opt +import JSONDeser(Input(..),readInput) +import PowerPhrases + +ptag :: String +ptag = "lilik0" + +timelimitratio :: Double +timelimitratio = 0.9 +memlimitratio :: Double +memlimitratio = 0.9 +gccompperstep :: Integer +gccompperstep = 10 + + +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 :: 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 + rng <- getStdGen + loaddata <- createComputationsFromFiles files rng powerp + let (ids,seeds,gamecomputations) = unzip3 loaddata + inittime <- secTime + results <- iterategc gamecomputations (timestruct timelimit inittime) memlimit + 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 + 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 diff --git a/src/Opt.hs b/src/Opt.hs index 58b38dd..e1f13ef 100644 --- a/src/Opt.hs +++ b/src/Opt.hs @@ -15,14 +15,17 @@ data Options = Options { optFile :: [String], optTime :: Maybe Int, optMem :: Maybe Int, optPowerPhrase :: Maybe String, - optSeedNumber :: Int } + optSeedNumber :: Int, + optCores :: Int + } deriving Show startOptions = Options { optFile = [], optTime = Nothing, optMem = Nothing, optPowerPhrase = Nothing, - optSeedNumber = 0 + optSeedNumber = 0, + optCores = 1 } options :: [ OptDescr (Options -> IO Options) ] @@ -51,6 +54,11 @@ options = [ Option "f" ["filename"] (\arg opt -> return opt { optSeedNumber = (read arg) }) "SEEDNUMBER") "Seed Number" + , Option "c" ["cores"] + (ReqArg + (\arg opt -> return opt { optCores = (read arg) }) + "CORES") + "Cores" ] parseArgs :: [String] -> IO Options diff --git a/src/PowerPhrases.hs b/src/PowerPhrases.hs index 4c03eed..94ac0d7 100644 --- a/src/PowerPhrases.hs +++ b/src/PowerPhrases.hs @@ -1,7 +1,6 @@ module PowerPhrases where import Data.Maybe -import VM import Datatypes.Game (Command(..)) diff --git a/src/StrategyManager.hs b/src/StrategyManager.hs new file mode 100644 index 0000000..c6b661a --- /dev/null +++ b/src/StrategyManager.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# OPTIONS -Wall #-} +module StrategyManager where + +import System.Random + +import Datatypes +import Datatypes.Game + +type GameComputation = [StrategyWrapper] + +data StrategyWrapper = forall a . Strategy a => MkStrategyWrapper a + | FinishedGame ([Command], Int) + + +data NullStrategy1 = NullS1 + +instance Strategy NullStrategy1 where + initst _ _ _ = NullS1 + advance _ = Left NullS1 + getbest _ = ([],0) + + +data NullStrategy2 = NullS2 + +instance Strategy NullStrategy2 where + initst _ _ _ = NullS2 + advance _ = Left NullS2 + getbest _ = ([],0) + + + +initWrapper :: Strategy a => a -> StrategyWrapper +initWrapper = MkStrategyWrapper + +class Strategy a where + initst :: Game -> StdGen -> Maybe [Command] -> a + advance :: a -> Either a ([Command], Int) + getbest :: a -> ([Command], Int) + + +advanceWrapper :: StrategyWrapper -> StrategyWrapper +advanceWrapper (FinishedGame result) = (FinishedGame result) +advanceWrapper (MkStrategyWrapper st) = wrapResult $ advance st + where + wrapResult (Left nst) = MkStrategyWrapper nst + wrapResult (Right result) = FinishedGame result + +finishedWrapper :: StrategyWrapper -> Bool +finishedWrapper (FinishedGame _) = True +finishedWrapper _ = False + +getbestWrapper :: StrategyWrapper -> ([Command], Int) +getbestWrapper (FinishedGame result) = result +getbestWrapper (MkStrategyWrapper st) = getbest st + +--- puo essere parallelizzato --- +finishedGameComputation :: GameComputation -> Bool +finishedGameComputation gc = and $ map finishedWrapper gc + +-- Ritorna i comandi con i punti piu l indice della strategia +getBestGameComputation :: GameComputation -> (([Command], Int),Int) +getBestGameComputation gc = foldl bestgame (([], 0), 0) (map getbestWrapper gc) + where + bestgame (b,i) a = if (snd a) > (snd b) + then (a,i+1) + else (b,i) + +advanceGameComputation :: GameComputation -> GameComputation +advanceGameComputation gc = map advanceWrapper gc +