diff --git a/src/JSONDeser.hs b/src/JSONDeser.hs index 353e8a9..8ffff2b 100644 --- a/src/JSONDeser.hs +++ b/src/JSONDeser.hs @@ -55,7 +55,7 @@ newGame input = (JSONDeser.id input, zip (sourceSeeds input) (map gameFromSeed ( board = DT.Board w h filledelement w = width input h = height input - filledelement = Set.fromList (map cellConvVM (filled input)) + filledelement = fromList (map cellConvVM (filled input)) seedUnits :: Int -> Input -> [DT.Unit] seedUnits s input = map (\x -> uinput !! x ) unit_index @@ -69,5 +69,5 @@ cellConvVM (Cell x y) = (x,y) unitConvVM :: Unit -> DT.Unit unitConvVM unit = DT.Unit (cellConvVM (pivot unit)) setcell where - setcell = Set.fromList (map cellConvVM (members unit)) + setcell = fromList (map cellConvVM (members unit)) diff --git a/src/Main.hs b/src/Main.hs index e6823d0..0042480 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -7,7 +7,6 @@ module Main where import Control.DeepSeq (deepseq, NFData(..)) import Data.Int -import Data.List (zip4) import qualified Data.ByteString.Lazy.Char8 as BS import System.Environment import System.Random @@ -18,15 +17,12 @@ import Data.Maybe import StrategyManager import Strategy0 -import Datatypes -import Datatypes.Game +import Datatypes.Game(Game,Command) import VM import Opt import JSONDeser(readInput) import PowerPhrases -import Debug.Trace (trace) - strategyTag :: String strategyTag = "lilik0" @@ -34,19 +30,19 @@ logFileName :: String logFileName = "scores" timeLimitRatio :: Double -timeLimitRatio = 1.0 +timeLimitRatio = 0.96 memLimitRatio :: Double memLimitRatio = 1.0 -gccompperstep :: Integer -gccompperstep = 100 +computationsPerStep :: Int +computationsPerStep = 10 data JSONSer = JSONSer { problemId :: Int, - seed :: Int, - tag :: String, - solution :: String + problemSeed :: Int, + problemTag :: String, + problemSolution :: String } deriving (Show, Generic) instance FromJSON JSONSer @@ -55,8 +51,9 @@ 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)] +strategies g sgen cmd = [MkStrategyWrapper (initst g sgen cmd :: Strategy0)] -- = [MkStrategyWrapper (initst g sgen cmd :: NullStrategy1), -- MkStrategyWrapper (initst g sgen cmd :: NullStrategy2)] @@ -67,42 +64,44 @@ strategies g sgen cmd = [MkStrategyWrapper (initst g sgen cmd :: NullStrategy1)] -- MkStrategyWrapper (init g sgen cmd :: Strat2)] main :: IO () -main = do args <- getArgs +main = do initTime <- secTime + 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 + let files = optFile opt + let maxTime = optTime opt + let maxMem = optMem opt + let powerPhrase = optPowerPhrase opt + let logFile = optLog 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 strategyTag z)) ids seeds wordlists + 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 logf (zip4 ids seeds points strat) + writeLogFile logFile (zipWith logFileBuilder initialData stringResults) where - timestruct Nothing _ = Nothing - timestruct (Just maxtime) intime = Just (maxtime, intime) - + 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 fns sg pp = do inputs <- readFiles fns - let igames = map readInput inputs - let cstruct = compstruct igames - return (gcstruct cstruct) +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 + 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) + j game = strategies game randomGen (powerCommands powerPhrase) + powerCommands Nothing = Nothing + powerCommands (Just a) = Just (mapMaybe charToCommand a) readFiles :: [String] -> IO [BS.ByteString] readFiles [] = return [] @@ -112,28 +111,27 @@ readFiles (x:xs) = do f <- BS.readFile x instance NFData Command where rnf x = seq x () -iterategc :: [GameComputation] -> Maybe (Int,Int64) -> Maybe Int -> IO [(([Command], Int), Int)] -iterategc gcs tlimit mlimit = do rtl <- timeLimit tlimit - rml <- memLimit mlimit - if rtl || rml - then return best - else if (and $ map finishedGameComputation gcs) - then return best - else let mona = (applyNtimes gccompperstep itf gcs) - mona1 = map getBestGameComputation gcs - in mona1 `deepseq` (iterategc mona tlimit mlimit) - where - itf gcs1 = map advanceGameComputation gcs1 - applyNtimes 0 _ accum = accum - applyNtimes n f accum = applyNtimes (n - 1) f (f accum) - best = map getBestGameComputation gcs - -timeLimit :: Maybe (Int,Int64) -> IO Bool +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 (itime,limit)) = do atime <- secTime - let diff = (atime - (fromIntegral itime)) - return (((fromIntegral limit) * timeLimitRatio) < (fromIntegral diff)) - +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 @@ -147,9 +145,14 @@ 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" + 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) + diff --git a/src/StrategyManager.hs b/src/StrategyManager.hs index 915d779..cb8b3bb 100644 --- a/src/StrategyManager.hs +++ b/src/StrategyManager.hs @@ -5,8 +5,12 @@ module StrategyManager where import System.Random(StdGen) import Datatypes.Game(Game,Command) +type Score = Int +type StrategyIdx = Int +type FinishedGame = ([Command], Score, StrategyIdx) type GameComputation = [StrategyWrapper] + data StrategyWrapper = forall a . Strategy a => MkStrategyWrapper a | FinishedGame ([Command], Int) @@ -26,9 +30,9 @@ class Strategy a where advanceWrapper :: StrategyWrapper -> StrategyWrapper advanceWrapper (FinishedGame result) = (FinishedGame result) -advanceWrapper (MkStrategyWrapper st) = wrapResult $ advance st +advanceWrapper (MkStrategyWrapper strategy) = wrapResult $ advance strategy where - wrapResult (Left nst) = MkStrategyWrapper nst + wrapResult (Left nextStrategy) = MkStrategyWrapper nextStrategy wrapResult (Right result) = FinishedGame result finishedWrapper :: StrategyWrapper -> Bool @@ -44,12 +48,17 @@ 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) +getBestGameComputation :: GameComputation -> FinishedGame +getBestGameComputation gameComputation = bestGame where - bestgame (b,i) a = if (snd a) > (snd b) - then (a,i+1) - else (b,i) + resultsFromAlgorithms = (map getbestWrapper gameComputation) + algoIdxs = take (length resultsFromAlgorithms) [ i | i <- [0..]] + bestGames = zipWith (\(a,b) c -> (a,b,c)) resultsFromAlgorithms algoIdxs + bestGame = foldl findBest ([], 0, 0) bestGames + findBest best nextBest = if ((bestScore best) > (bestScore nextBest)) + then best + else nextBest + bestScore (_, score, _) = score advanceGameComputation :: GameComputation -> GameComputation advanceGameComputation gc = map advanceWrapper gc