Prima strategia e altre robe

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

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

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

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

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

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