added Masterpf

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

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

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

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

src/PowerPhrases.hs

@@ -1,7 +1,6 @@
 module PowerPhrases where
 
 import Data.Maybe
-import VM
 import Datatypes.Game (Command(..))
 
 

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
+