Browse Source

first ReadString Version

adaptedStrategy0
Andrea Bellandi 9 years ago
parent
commit
7d3518f474
5 changed files with 59 additions and 39 deletions
  1. +1
    -1
      src/JSONDeser.hs
  2. +15
    -9
      src/Opt.hs
  3. +1
    -1
      src/PowerPhrases.hs
  4. +22
    -20
      src/ReadString.hs
  5. +20
    -8
      src/SinglePasses.hs

+ 1
- 1
src/JSONDeser.hs View File

@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
module JSONDeser(readInput) where module JSONDeser(readInput) where
import qualified Data.Set as Set import qualified Data.Set as Set


+ 15
- 9
src/Opt.hs View File

@ -11,17 +11,18 @@ data Flag = File String
| PowerPhrase String | PowerPhrase String
deriving Show deriving Show
data Options = Options { optFile :: [String]
, optTime :: Maybe Int
, optMem :: Maybe Int
, optPowerPhrase :: Maybe String
}
data Options = Options { optFile :: [String],
optTime :: Maybe Int,
optMem :: Maybe Int,
optPowerPhrase :: Maybe String,
optSeedNumber :: Int }
deriving Show deriving Show
startOptions = Options { optFile = []
, optTime = Nothing
, optMem = Nothing
, optPowerPhrase = Nothing
startOptions = Options { optFile = [],
optTime = Nothing,
optMem = Nothing,
optPowerPhrase = Nothing,
optSeedNumber = 0
} }
options :: [ OptDescr (Options -> IO Options) ] options :: [ OptDescr (Options -> IO Options) ]
@ -45,6 +46,11 @@ options = [ Option "f" ["filename"]
(\arg opt -> return opt { optPowerPhrase = Just arg }) (\arg opt -> return opt { optPowerPhrase = Just arg })
"POWERPHRASE") "POWERPHRASE")
"Power Phrase" "Power Phrase"
, Option "n" ["seednumber"]
(ReqArg
(\arg opt -> return opt { optSeedNumber = (read arg) })
"SEEDNUMBER")
"Seed Number"
] ]
parseArgs :: [String] -> IO Options parseArgs :: [String] -> IO Options


+ 1
- 1
src/PowerPhrases.hs View File

@ -1,7 +1,7 @@
module PowerPhrases where module PowerPhrases where
import Data.Maybe import Data.Maybe
import Datatypes
import VM
charToCommand :: Char -> Maybe Command charToCommand :: Char -> Maybe Command


+ 22
- 20
src/ReadString.hs View File

@ -5,33 +5,35 @@ import GHC.Generics
import Data.Aeson import Data.Aeson
import Data.Aeson.Types import Data.Aeson.Types
import Data.Maybe
import System.Environment import System.Environment
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Lazy.Char8 as BS
import System.IO import System.IO
import Datatypes
import qualified Datatypes as DT
import qualified VM
import Opt import Opt
import JSONDeser import JSONDeser
import VM (Command, cmdToString)
data JSONSer = JSONSer { problemId :: Int,
seed :: Int,
tag :: String,
solution :: String
} deriving (Show, Generic)
instance FromJSON JSONSer
instance ToJSON JSONSer
import SinglePasses
import PowerPhrases
main :: IO () main :: IO ()
main = do args <- getArgs main = do args <- getArgs
opt <- parseArgs args opt <- parseArgs args
file <- return ((optFile opt) !! 0)
str <- BS.readFile file
filename <- return ((optFile opt) !! 0)
file <- BS.readFile filename
phrase <- return (fromJust $ optPowerPhrase opt)
seedn <- return $ optSeedNumber opt
(id, seedgame) <- return $ readInput file
(seed,game) <- return $ unzip seedgame
outputs <- return $ passes $ propagateCommand (game !! seedn) phrase
BS.putStrLn $ encode outputs
packAll :: Int -> [Int] -> [[Command]] -> [JSONSer]
packAll id seeds commandLists = zipWith (\x y -> JSONSer id x "lilik0" y) seeds commandStrings
propagateCommand :: DT.Game -> String -> [(DT.Game, VM.Notes)]
propagateCommand game str = (game,VM.OK):(propagateCommand0 game str)
where where
commandStrings = map cmdToString commandLists
propagateCommand0 game0 [] = []
propagateCommand0 game0 (c:cs) = res1:(propagateCommand game1 cs)
where
res1@(game1,note1) = VM.step game0 (fromJust $ charToCommand c)

+ 20
- 8
src/SinglePasses.hs View File

@ -1,14 +1,19 @@
{-# LANGUAGE DeriveDataTypeable #-}
module SinglePasses where
{-# LANGUAGE DeriveGeneric #-}
module SinglePasses(Output(..), Cell(..), passes) where
import Data.Set(Set(..),difference,union,toList,empty) import Data.Set(Set(..),difference,union,toList,empty)
import Data.Maybe import Data.Maybe
import Data.Typeable import Data.Typeable
import GHC.Generics
import Data.Aeson
import Data.Aeson.Types
import qualified Datatypes as DT import qualified Datatypes as DT
import qualified VM import qualified VM
data Cell = Cell { x :: Int, y :: Int} data Cell = Cell { x :: Int, y :: Int}
deriving (Show, Typeable)
deriving (Show, Generic)
data Output = Output { width :: Int, data Output = Output { width :: Int,
height :: Int, height :: Int,
@ -17,7 +22,14 @@ data Output = Output { width :: Int,
unit :: [Cell], unit :: [Cell],
score :: Int score :: Int
} }
deriving (Show, Typeable)
deriving (Show, Generic)
instance FromJSON Cell
instance ToJSON Cell
instance FromJSON Output
instance ToJSON Output
passes :: [(DT.Game, VM.Notes)] -> [Output] passes :: [(DT.Game, VM.Notes)] -> [Output]
passes gamesnotes = map generateoutput (gameswithtouched gamesnotes) passes gamesnotes = map generateoutput (gameswithtouched gamesnotes)
@ -27,7 +39,7 @@ passes gamesnotes = map generateoutput (gameswithtouched gamesnotes)
filled = filledcells game, filled = filledcells game,
touched = touchedcells touched, touched = touchedcells touched,
unit = unitcells game, unit = unitcells game,
score = DT.points game
score = DT.score game
} }
filledcells gm = extractcell $ DT.filled $ DT.board gm filledcells gm = extractcell $ DT.filled $ DT.board gm
unitcells gm = if null $ DT.units gm unitcells gm = if null $ DT.units gm
@ -37,17 +49,17 @@ passes gamesnotes = map generateoutput (gameswithtouched gamesnotes)
gameswithtouched :: [(DT.Game,VM.Notes)] -> [((DT.Game,VM.Notes),Set DT.Cell)] gameswithtouched :: [(DT.Game,VM.Notes)] -> [((DT.Game,VM.Notes),Set DT.Cell)]
gameswithtouched [] = [] gameswithtouched [] = []
gameswithtouched (x:[]) = [(x,empty)]
gameswithtouched (x:[]) = [(x,Data.Set.empty)]
gameswithtouched (x:xs) = (x,touched):lastels gameswithtouched (x:xs) = (x,touched):lastels
where where
touched1 = snd $ head lastels touched1 = snd $ head lastels
touched2 = if null $ DT.units $ fst $ fst $ head lastels touched2 = if null $ DT.units $ fst $ fst $ head lastels
then empty
then Data.Set.empty
else DT.members $ head $ DT.units $ fst $ fst $ head lastels else DT.members $ head $ DT.units $ fst $ fst $ head lastels
touched = difference (difference (union touched1 touched2) cells) units touched = difference (difference (union touched1 touched2) cells) units
cells = DT.filled $ DT.board $ fst x cells = DT.filled $ DT.board $ fst x
units = if null $ DT.units $ fst x units = if null $ DT.units $ fst x
then empty
then Data.Set.empty
else DT.members $ head $ DT.units $ fst x else DT.members $ head $ DT.units $ fst x
touchedcells tc = extractcell touched touchedcells tc = extractcell touched
lastels = gameswithtouched xs lastels = gameswithtouched xs


Loading…
Cancel
Save