From b168df78cdecd655e757def6c6070712d0989e12 Mon Sep 17 00:00:00 2001 From: Andrea Bellandi Date: Sun, 9 Aug 2015 20:55:40 +0200 Subject: [PATCH 1/8] completed Strategy0 refactoring --- src/Mainpf.hs | 9 +++-- src/Strategy0.hs | 90 +++++++++++++++++++++++++++++------------- src/StrategyManager.hs | 26 ++++++------ 3 files changed, 82 insertions(+), 43 deletions(-) diff --git a/src/Mainpf.hs b/src/Mainpf.hs index 6b707c9..bbaa0bc 100644 --- a/src/Mainpf.hs +++ b/src/Mainpf.hs @@ -15,6 +15,7 @@ import Data.Aeson import Data.Maybe import StrategyManager +import Strategy0 import Datatypes import Datatypes.Game import VM @@ -32,7 +33,7 @@ timelimitratio = 0.9 memlimitratio :: Double memlimitratio = 0.9 gccompperstep :: Integer -gccompperstep = 10 +gccompperstep = 100000 data JSONSer = JSONSer { problemId :: Int, @@ -48,8 +49,10 @@ 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)] +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), diff --git a/src/Strategy0.hs b/src/Strategy0.hs index b6f8e41..0424331 100644 --- a/src/Strategy0.hs +++ b/src/Strategy0.hs @@ -1,36 +1,61 @@ -module Strategy0 where +module Strategy0(Strategy0) where import qualified Data.PQueue.Prio.Max as PQ +import System.Random(StdGen) import Data.Maybe (isJust) - import Datatypes import Datatypes.Game (Command(..)) import qualified Datatypes.Game as Game import VM +import StrategyManager + commandsList :: [Command] commandsList = [MoveSE, MoveSW, MoveW, MoveE, RotateClockwise, RotateCounterclockwise] type Queue = PQ.MaxPQueue Int Game +data Strategy0 = Strategy0 (Queue, [Game]) + + +instance Strategy Strategy0 where + initst = strategy0initst + advance = strategy0advance + getbest = strategy0getbest + +strategy0initst :: Game -> StdGen -> Maybe [Command] -> Strategy0 +strategy0initst game _ _ = (Strategy0 (PQ.singleton (fullScore game) game, [])) + +strategy0advance :: Strategy0 -> Either Strategy0 ([Command],Int) +strategy0advance (Strategy0 (queue,completed)) = let candidates = map (step game) commandsList + (newQueue, newCompleted) = updateCollections candidates remQueue (game:completed) + in Left (Strategy0 (newQueue, newCompleted)) + where + ((score, game), remQueue) = PQ.deleteFindMax queue + updateCollections [] q l = (q, l) + updateCollections ((g, n):rs) q l = case n of + OK -> updateCollections rs (pushToQueue q g) l + Lock _ -> updateCollections rs (pushToQueue q g) l + GameOver -> updateCollections rs q (pushToList l g) + _ -> updateCollections rs q l + pushToQueue q x = PQ.insert (fullScore x) x q + pushToList c x = x : c + +strategy0getbest :: Strategy0 -> ([Command], Int) +strategy0getbest (Strategy0 (incomplete,completed)) = let (_, bestIncomplete) = PQ.findMax incomplete + resultGame = findListMax (bestIncomplete:completed) + in (reverse (Game.history resultGame), fullScore resultGame) + fullScore :: Game -> Int fullScore game = Game.score game + (Game.cacheToScore $ Game.phrasesCache game) -strat0 :: Game -> ([Command],Int) -strat0 game = let firstQueue = PQ.singleton (fullScore game) game - (incomplete, completed) = findBest maxIter firstQueue [] - (_, bestIncomplete) = PQ.findMax incomplete - resultGame = findListMax (bestIncomplete:completed) - in (reverse (Game.history resultGame), fullScore resultGame) - where - maxIter = 50000 - findListMax :: [Game] -> Game findListMax (x:xs) = innerFindListMax x xs where innerFindListMax currentMax [] = currentMax innerFindListMax currentMax (y:ys) = innerFindListMax (if (fullScore currentMax) > (fullScore y) then currentMax else y) ys + partition :: (a -> Bool) -> [a] -> ([a], [a]) partition p items = innerPartition items [] [] where innerPartition [] ts fs = (ts, fs) @@ -55,19 +80,30 @@ tryPowerPhrases game = validResults where Lock _ -> innerExpand nn ps _ -> Nothing -findBest :: Int -> Queue -> [Game] -> (Queue, [Game]) -findBest 0 queue completed = (queue, completed) -findBest i queue completed = - let candidates = map (step game) commandsList -- ++ (tryPowerPhrases game) - (newQueue, newCompleted) = updateCollections candidates remQueue (game:completed) - in findBest (i - 1) newQueue newCompleted - where - ((score, game), remQueue) = PQ.deleteFindMax queue - updateCollections [] q l = (q, l) - updateCollections ((g, n):rs) q l = case n of - OK -> updateCollections rs (pushToQueue q g) l - Lock _ -> updateCollections rs (pushToQueue q g) l - GameOver -> updateCollections rs q (pushToList l g) - _ -> updateCollections rs q l - pushToQueue q x = PQ.insert (fullScore x) x q - pushToList c x = x : c +-- +-- Old Strategy0 Code +-- +-- findBest :: Int -> Queue -> [Game] -> (Queue, [Game]) +-- findBest 0 queue completed = (queue, completed) +-- findBest i queue completed = let candidates = map (step game) commandsList ++ (tryPowerPhrases game) +-- (newQueue, newCompleted) = updateCollections candidates remQueue (game:completed) +-- in findBest (i - 1) newQueue newCompleted +-- where +-- ((score, game), remQueue) = PQ.deleteFindMax queue +-- updateCollections [] q l = (q, l) +-- updateCollections ((g, n):rs) q l = case n of +-- OK -> updateCollections rs (pushToQueue q g) l +-- Lock _ -> updateCollections rs (pushToQueue q g) l +-- GameOver -> updateCollections rs q (pushToList l g) +-- _ -> updateCollections rs q l +-- pushToQueue q x = PQ.insert (fullScore x) x q + +-- strat0 :: Game -> ([Command],Int) +-- strat0 game = let firstQueue = PQ.singleton (fullScore game) game +-- (incomplete, completed) = findBest maxIter firstQueue [] +-- (_, bestIncomplete) = PQ.findMax incomplete +-- resultGame = findListMax (bestIncomplete:completed) +-- in (reverse (Game.history resultGame), fullScore resultGame) +-- where +-- maxIter = 50000 +-- pushToList c x = x : c diff --git a/src/StrategyManager.hs b/src/StrategyManager.hs index c6b661a..f9583d9 100644 --- a/src/StrategyManager.hs +++ b/src/StrategyManager.hs @@ -15,19 +15,6 @@ data StrategyWrapper = forall a . Strategy a => MkStrategyWrapper a 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 @@ -69,3 +56,16 @@ getBestGameComputation gc = foldl bestgame (([], 0), 0) (map getbestWrapper gc) advanceGameComputation :: GameComputation -> GameComputation advanceGameComputation gc = map advanceWrapper gc +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) + From 0a80fe2b077012d606a425e14d52c5511060fad3 Mon Sep 17 00:00:00 2001 From: Andrea Bellandi Date: Sun, 9 Aug 2015 22:23:06 +0200 Subject: [PATCH 2/8] broken Main.hs --- icfp2015.cabal | 4 ++-- src/{Mainpf.hs => Main.hs} | 14 +++++++------- 2 files changed, 9 insertions(+), 9 deletions(-) rename src/{Mainpf.hs => Main.hs} (97%) diff --git a/icfp2015.cabal b/icfp2015.cabal index 734a37d..7c61263 100644 --- a/icfp2015.cabal +++ b/icfp2015.cabal @@ -51,7 +51,7 @@ cabal-version: >=1.10 executable icfp2015 -- .hs or .lhs file containing the Main module. - main-is: Main0.hs + main-is: Main.hs -- Modules included in this executable, other than Main. other-modules: Datatypes, Datatypes.Board, Datatypes.Cell, Datatypes.Game, Datatypes.Unit @@ -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, clock >= 0.1 + 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, random -- Directories containing source files. hs-source-dirs: src diff --git a/src/Mainpf.hs b/src/Main.hs similarity index 97% rename from src/Mainpf.hs rename to src/Main.hs index bbaa0bc..8597033 100644 --- a/src/Mainpf.hs +++ b/src/Main.hs @@ -2,7 +2,7 @@ {-# LANGUAGE ExistentialQuantification #-} {-# OPTIONS -Wall #-} -module Mainf where +module Main where import Data.Int import Data.List @@ -29,11 +29,11 @@ logfilename :: String logfilename = "scores" timelimitratio :: Double -timelimitratio = 0.9 +timelimitratio = 1.0 memlimitratio :: Double -memlimitratio = 0.9 +memlimitratio = 1.0 gccompperstep :: Integer -gccompperstep = 100000 +gccompperstep = 100 data JSONSer = JSONSer { problemId :: Int, @@ -49,7 +49,7 @@ type Id = Int type Seed = Int strategies :: Game -> StdGen -> Maybe [Command] -> GameComputation -strategies g sgen cmd = [MkStrategyWrapper (initst g sgen cmd :: Strategy0)] +strategies g sgen cmd = [MkStrategyWrapper (initst g sgen cmd :: NullStrategy1)] -- = [MkStrategyWrapper (initst g sgen cmd :: NullStrategy1), -- MkStrategyWrapper (initst g sgen cmd :: NullStrategy2)] @@ -73,6 +73,7 @@ main = do args <- getArgs 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 @@ -118,8 +119,7 @@ iterategc gcs tlimit mlimit = do rtl <- timeLimit tlimit 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 From af00345e0083b7087bf57788a68fb7f694226589 Mon Sep 17 00:00:00 2001 From: Andrea Bellandi Date: Sun, 9 Aug 2015 22:45:24 +0200 Subject: [PATCH 3/8] push version --- src/Main.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 8597033..e261822 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} {-# OPTIONS -Wall #-} @@ -49,7 +50,7 @@ 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)] @@ -106,8 +107,8 @@ readFiles (x:xs) = do f <- BS.readFile x 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) + rml <- memLimit mlimit + (gcresult rtl rml) where gcresult True _ = return best gcresult _ True = return best From 623b94df5014b8a363ed51d1a878fbdffee68d71 Mon Sep 17 00:00:00 2001 From: Slash Date: Sun, 9 Aug 2015 23:13:10 +0200 Subject: [PATCH 4/8] tail recursion fix --- src/Main.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index e261822..cefcad5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -107,8 +107,8 @@ readFiles (x:xs) = do f <- BS.readFile x 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) + rml <- memLimit mlimit + (gcresult rtl rml) where gcresult True _ = return best gcresult _ True = return best @@ -116,9 +116,9 @@ iterategc gcs tlimit mlimit = do rtl <- timeLimit tlimit 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) + 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 From 26b59c0a9a61e9f53a989c2fdbba7ee764f4ab0f Mon Sep 17 00:00:00 2001 From: Slash Date: Mon, 10 Aug 2015 00:22:53 +0200 Subject: [PATCH 5/8] deepseq awesomeness --- src/Main.hs | 54 ++++++++++++++++++++++++++++++----------------------- 1 file changed, 31 insertions(+), 23 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index cefcad5..c8a0de2 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -5,8 +5,9 @@ module Main where +import Control.DeepSeq (deepseq, NFData(..)) import Data.Int -import Data.List +import Data.List (zip4) import qualified Data.ByteString.Lazy.Char8 as BS import System.Environment import System.Random @@ -24,15 +25,20 @@ import Opt import JSONDeser(readInput) import PowerPhrases -ptag :: String -ptag = "lilik0" -logfilename :: String -logfilename = "scores" +import Debug.Trace (trace) + +strategyTag :: String +strategyTag = "lilik0" + +logFileName :: String +logFileName = "scores" + +timeLimitRatio :: Double +timeLimitRatio = 1.0 + +memLimitRatio :: Double +memLimitRatio = 1.0 -timelimitratio :: Double -timelimitratio = 1.0 -memlimitratio :: Double -memlimitratio = 1.0 gccompperstep :: Integer gccompperstep = 100 @@ -78,7 +84,7 @@ main = do args <- getArgs 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 + let outJSONstructs = zipWith3 (\x y z -> (JSONSer x y strategyTag z)) ids seeds wordlists BS.putStrLn $ encode outJSONstructs writelogfile logf (zip4 ids seeds points strat) where @@ -105,27 +111,29 @@ readFiles (x:xs) = do f <- BS.readFile x fs <- readFiles xs return (f:fs) +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 - (gcresult rtl rml) + 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 - 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 advanceGameComputation gcs1 - applyNtimes 0 _ accum = accum - applyNtimes n f accum = applyNtimes (n - 1) f (f accum) - best = map getBestGameComputation gcs + 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 timeLimit Nothing = return False timeLimit (Just (itime,limit)) = do atime <- secTime let diff = (atime - (fromIntegral itime)) - return (((fromIntegral limit) * timelimitratio) < (fromIntegral diff)) + return (((fromIntegral limit) * timeLimitRatio) < (fromIntegral diff)) memLimit :: Maybe Int -> IO Bool @@ -137,7 +145,7 @@ secTime = do (TimeSpec s _) <- getTime Monotonic writelogfile :: Bool -> [(Int,Int,Int,Int)] -> IO () writelogfile False _ = return () -writelogfile _ els = writeFile logfilename scoredata +writelogfile _ els = writeFile logFileName scoredata where scoredata = foldl strlog "\n" els strlog x (a,b,c,d) = sa ++ sb ++ sc ++ sd ++ x ++ "\n" From 1d849d6fb1ddd4dbc099eb03266066eeb8a58535 Mon Sep 17 00:00:00 2001 From: Slash Date: Mon, 10 Aug 2015 00:40:41 +0200 Subject: [PATCH 6/8] added deepseq dependency, fixes --- icfp2015.cabal | 2 +- src/Main.hs | 9 ++++----- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/icfp2015.cabal b/icfp2015.cabal index 7c61263..175bb83 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, clock, random + 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, random, deepseq >= 1.3 && <1.4 -- Directories containing source files. hs-source-dirs: src diff --git a/src/Main.hs b/src/Main.hs index c8a0de2..10e2d3d 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -80,13 +80,12 @@ main = do args <- getArgs 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 strategyTag z)) ids seeds wordlists BS.putStrLn $ encode outJSONstructs - writelogfile logf (zip4 ids seeds points strat) + writeLogFile logf (zip4 ids seeds points strat) where timestruct Nothing _ = Nothing timestruct (Just maxtime) intime = Just (maxtime, intime) @@ -143,9 +142,9 @@ 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 +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" From 787cc8789c42750d3ffed2743e2d594b665a51c3 Mon Sep 17 00:00:00 2001 From: Andrea Bellandi Date: Mon, 10 Aug 2015 00:50:39 +0200 Subject: [PATCH 7/8] removed some dependencies --- src/JSONDeser.hs | 6 +++--- src/LCG.hs | 2 +- src/Main.hs | 2 +- src/PowerPhrases.hs | 10 +++++----- src/StrategyManager.hs | 8 +++----- 5 files changed, 13 insertions(+), 15 deletions(-) diff --git a/src/JSONDeser.hs b/src/JSONDeser.hs index b85fded..353e8a9 100644 --- a/src/JSONDeser.hs +++ b/src/JSONDeser.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DeriveGeneric #-} module JSONDeser where -import qualified Data.Set as Set +import Data.Set(fromList) import Data.Maybe import qualified Data.ByteString.Lazy as BS import Data.Aeson @@ -52,10 +52,10 @@ newGame :: Input -> (Int,[(Int,DT.Game)]) newGame input = (JSONDeser.id input, zip (sourceSeeds input) (map gameFromSeed (sourceSeeds input))) where gameFromSeed seed = DT.Game.new board (seedUnits seed input) - board = DT.Board w h filledel + board = DT.Board w h filledelement w = width input h = height input - filledel = Set.fromList (map cellConvVM (filled input)) + filledelement = Set.fromList (map cellConvVM (filled input)) seedUnits :: Int -> Input -> [DT.Unit] seedUnits s input = map (\x -> uinput !! x ) unit_index diff --git a/src/LCG.hs b/src/LCG.hs index 98a413d..ea005dc 100644 --- a/src/LCG.hs +++ b/src/LCG.hs @@ -1,6 +1,6 @@ module LCG where -import Data.Bits +import Data.Bits(shiftR,(.&.)) modulus = 2^32 multiplier = 1103515245 diff --git a/src/Main.hs b/src/Main.hs index cefcad5..337f7c0 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -50,7 +50,7 @@ type Id = Int type Seed = Int strategies :: Game -> StdGen -> Maybe [Command] -> GameComputation -strategies g sgen cmd = [MkStrategyWrapper (initst g sgen cmd :: Strategy0)] +strategies g sgen cmd = [MkStrategyWrapper (initst g sgen cmd :: NullStrategy1)] -- = [MkStrategyWrapper (initst g sgen cmd :: NullStrategy1), -- MkStrategyWrapper (initst g sgen cmd :: NullStrategy2)] diff --git a/src/PowerPhrases.hs b/src/PowerPhrases.hs index 94ac0d7..6c59930 100644 --- a/src/PowerPhrases.hs +++ b/src/PowerPhrases.hs @@ -1,8 +1,11 @@ +{-# OPTIONS -Wall #-} module PowerPhrases where -import Data.Maybe +import Data.Maybe(mapMaybe) import Datatypes.Game (Command(..)) +listToCommand :: String -> [Command] +listToCommand str = mapMaybe charToCommand str charToCommand :: Char -> Maybe Command @@ -48,8 +51,5 @@ charToCommand 'u' = Just RotateCounterclockwise charToCommand 'w' = Just RotateCounterclockwise charToCommand 'x' = Just RotateCounterclockwise -charToCommand '\t' = Nothing -charToCommand '\n' = Nothing -charToCommand '\r' = Nothing - +charToCommand _ = Nothing diff --git a/src/StrategyManager.hs b/src/StrategyManager.hs index f9583d9..915d779 100644 --- a/src/StrategyManager.hs +++ b/src/StrategyManager.hs @@ -2,16 +2,14 @@ {-# OPTIONS -Wall #-} module StrategyManager where -import System.Random - -import Datatypes -import Datatypes.Game +import System.Random(StdGen) +import Datatypes.Game(Game,Command) type GameComputation = [StrategyWrapper] data StrategyWrapper = forall a . Strategy a => MkStrategyWrapper a | FinishedGame ([Command], Int) - + data NullStrategy1 = NullS1 From c5926314c6b9a11bf41762addeb2db7c5ece4da6 Mon Sep 17 00:00:00 2001 From: Andrea Bellandi Date: Mon, 10 Aug 2015 04:19:47 +0200 Subject: [PATCH 8/8] resolved time bug cleaned Main --- src/JSONDeser.hs | 4 +- src/Main.hs | 125 +++++++++++++++++++++-------------------- src/StrategyManager.hs | 23 +++++--- 3 files changed, 82 insertions(+), 70 deletions(-) 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