diff --git a/vm/Datatypes.hs b/vm/Datatypes.hs index da4d1cc..bca081e 100644 --- a/vm/Datatypes.hs +++ b/vm/Datatypes.hs @@ -26,7 +26,7 @@ data Command = MoveW | MoveSE | RotateClockwise | RotateCounterclockwise - deriving Show + deriving (Show,Eq) data Game = Game { gameBoard :: Board, @@ -40,7 +40,7 @@ data Notes = OK | Collision | CollisionWithRowElision | ErrorZero - deriving Show + deriving (Show,Eq) instance Hashable Unit where hashWithSalt salt (Unit members pivot) = diff --git a/vm/JSONDeser.hs b/vm/JSONDeser.hs new file mode 100644 index 0000000..bab5467 --- /dev/null +++ b/vm/JSONDeser.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE OverloadedStrings, DeriveGeneric #-} +module JSONDeser where + +import Data.Maybe +import Data.ByteString.Lazy +import Data.Aeson +import GHC.Generics + + +data Cell = Cell { x :: Int, y :: Int} + deriving (Show, Generic) + +data Unit = Unit { members :: [Cell], pivot :: Cell} + deriving (Show, Generic) + +data Input = Input { id :: Int, + units :: [Unit], + width :: Int, + height :: Int, + filled :: [Cell], + sourceLength :: Int, + sourceSeeds :: [Int] + } + deriving (Show, Generic) + + +instance FromJSON Cell +instance ToJSON Cell + +instance FromJSON Unit +instance ToJSON Unit + +instance FromJSON Input +instance ToJSON Input + +readInputInternal :: ByteString -> Input +readInputInternal str = if isJust result + then fromJust result + else error "Error during JSON parsing" + where + result = (decode str :: Maybe Input) + + + diff --git a/vm/LCG.hs b/vm/LCG.hs new file mode 100644 index 0000000..98a413d --- /dev/null +++ b/vm/LCG.hs @@ -0,0 +1,19 @@ +module LCG where + +import Data.Bits + +modulus = 2^32 +multiplier = 1103515245 +increment = 12345 +shiftval = 16 +andmask = 0x7FFF + +lcg_pseudorandom_internal :: Integer -> [Integer] +lcg_pseudorandom_internal n = pseudo_val:(lcg_pseudorandom_internal n_new) + where n_new = (multiplier * n + increment) `mod` modulus + pseudo_val = (shiftR n shiftval) .&. andmask + +--take a seed, a length of units vector and number of units and give a vector of orders +lcg :: Int -> Int -> Int -> [Int] +lcg seed len num = map (\x -> fromInteger (x `mod` toInteger len)) finite_vec + where finite_vec = take num (lcg_pseudorandom_internal (toInteger seed)) diff --git a/vm/Opt.hs b/vm/Opt.hs new file mode 100644 index 0000000..1537293 --- /dev/null +++ b/vm/Opt.hs @@ -0,0 +1,54 @@ +module Opt(parseArgs,Options(..)) where + +import System.Console.GetOpt +import Data.Maybe + +-- import Vm + +data Flag = File String + | Time Int + | Mem Int + | PowerPhrase String + deriving Show + +data Options = Options { optFile :: [String] + , optTime :: Maybe Int + , optMem :: Maybe Int + , optPowerPhrase :: Maybe String + } + deriving Show + +startOptions = Options { optFile = [] + , optTime = Nothing + , optMem = Nothing + , optPowerPhrase = Nothing + } + +options :: [ OptDescr (Options -> IO Options) ] +options = [ Option "f" ["filename"] + (ReqArg + (\arg opt -> return opt { optFile = (arg:(optFile opt)) }) + "FILE") + "Input Filename" + , Option "t" ["timelimit"] + (ReqArg + (\arg opt -> return opt { optTime = Just (read arg) }) + "TIMELIMIT") + "Time Limit in seconds" + , Option "m" ["memlimit"] + (ReqArg + (\arg opt -> return opt { optMem = Just (read arg) }) + "MEMLIMIT") + "Memory Limit in MB" + , Option "p" ["phrasepower"] + (ReqArg + (\arg opt -> return opt { optPowerPhrase = Just arg }) + "POWERPHRASE") + "Power Phrase" + ] + +parseArgs :: [String] -> IO Options +parseArgs args = do + let (actions, _, _) = getOpt RequireOrder options args + opts <- foldl (>>=) (return startOptions) actions + return opts diff --git a/vm/PowerPhrases.hs b/vm/PowerPhrases.hs new file mode 100644 index 0000000..667a63c --- /dev/null +++ b/vm/PowerPhrases.hs @@ -0,0 +1,55 @@ +module PowerPhrases where + +import Data.Maybe +import VM (Command(..)) + + +charToCommand :: Char -> Maybe Command + +charToCommand 'p' = Just MoveW +charToCommand '\'' = Just MoveW +charToCommand '!' = Just MoveW +charToCommand '.' = Just MoveW +charToCommand '0' = Just MoveW +charToCommand '3' = Just MoveW + +charToCommand 'b' = Just MoveE +charToCommand 'c' = Just MoveE +charToCommand 'e' = Just MoveE +charToCommand 'f' = Just MoveE +charToCommand 'y' = Just MoveE +charToCommand '2' = Just MoveE + +charToCommand 'a' = Just MoveSW +charToCommand 'g' = Just MoveSW +charToCommand 'h' = Just MoveSW +charToCommand 'i' = Just MoveSW +charToCommand 'j' = Just MoveSW +charToCommand '4' = Just MoveSW + +charToCommand 'l' = Just MoveSE +charToCommand 'm' = Just MoveSE +charToCommand 'n' = Just MoveSE +charToCommand 'o' = Just MoveSE +charToCommand ' ' = Just MoveSE +charToCommand '5' = Just MoveSE + +charToCommand 'd' = Just RotateClockwise +charToCommand 'q' = Just RotateClockwise +charToCommand 'r' = Just RotateClockwise +charToCommand 'v' = Just RotateClockwise +charToCommand 'z' = Just RotateClockwise +charToCommand '1' = Just RotateClockwise + +charToCommand 'k' = Just RotateCounterclockwise +charToCommand 's' = Just RotateCounterclockwise +charToCommand 't' = Just RotateCounterclockwise +charToCommand 'u' = Just RotateCounterclockwise +charToCommand 'w' = Just RotateCounterclockwise +charToCommand 'x' = Just RotateCounterclockwise + +charToCommand '\t' = Nothing +charToCommand '\n' = Nothing +charToCommand '\r' = Nothing + + diff --git a/vm/Strategy0.hs b/vm/Strategy0.hs new file mode 100644 index 0000000..9b4280e --- /dev/null +++ b/vm/Strategy0.hs @@ -0,0 +1,25 @@ +module Strategy0 where + +import Datatypes +import VM + +seswlist = cycle [MoveSE, MoveSW] + +strat0 :: Game -> [Command] +strat0 game = take nsteps seswlist + where + nsteps = stepr game + +stepr :: Game -> Int +stepr game = if notes == Ended + then 1 + else 1 + (stepl new_game) + where + (new_game,notes) = step game MoveSE + +stepl :: Game -> Int +stepl game = if notes == Ended + then 1 + else 1 + (stepr new_game) + where + (new_game,notes) = step game MoveSW