resolved time bug cleaned Main

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

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)
+    

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