From 1a178698a94945163461dc6f7e8a54a4ca0418f4 Mon Sep 17 00:00:00 2001 From: Slash Date: Sat, 8 Aug 2015 20:47:19 +0200 Subject: [PATCH] more vm refactoring --- getStats | 2 ++ src/Datatypes/Game.hs | 4 ++-- src/Datatypes/Unit.hs | 9 +++++++-- src/Strategy0.hs | 4 ++-- src/VM.hs | 42 +++++++++++++++++++++++++++--------------- 5 files changed, 40 insertions(+), 21 deletions(-) create mode 100755 getStats diff --git a/getStats b/getStats new file mode 100755 index 0000000..da4fe5b --- /dev/null +++ b/getStats @@ -0,0 +1,2 @@ +#!/bin/bash +curl --user :2aaFCkjNIDHAsAIh9iQHc+Y+FGhkM5Z0RQgpO6TL6EA= -X GET https://davar.icfpcontest.org/teams/235/solutions diff --git a/src/Datatypes/Game.hs b/src/Datatypes/Game.hs index b4c1ba9..44e225b 100644 --- a/src/Datatypes/Game.hs +++ b/src/Datatypes/Game.hs @@ -10,9 +10,9 @@ type UnitHash = Int data Game = Game { board :: Board, units :: [Unit], - oldPositions :: Set UnitHash, + visitedUnits :: Set UnitHash, oldLines :: Int, - points :: Int + score :: Int } deriving Show diff --git a/src/Datatypes/Unit.hs b/src/Datatypes/Unit.hs index b5c2298..2e34190 100644 --- a/src/Datatypes/Unit.hs +++ b/src/Datatypes/Unit.hs @@ -1,4 +1,4 @@ -module Datatypes.Unit (Unit(..), map, collidesWith, isOutsideOf) where +module Datatypes.Unit (Unit(..), map, collidesWith, isOutsideOf, mergeWith) where import Prelude hiding (map) @@ -8,7 +8,7 @@ import Data.Set (Set) import qualified Data.Set as Set import Datatypes.Cell (Cell) -import Datatypes.Board (Board) +import Datatypes.Board (Board(..)) import qualified Datatypes.Board as Board data Unit = Unit { pivot :: Cell, members :: Set Cell } deriving Show @@ -35,3 +35,8 @@ collidesWith u b = not . Set.null $ Set.intersection (members u) (Board.filled b isOutsideOf :: Unit -> Board -> Bool isOutsideOf u@(Unit _ ms) b = any isOutside (Set.toList ms) where isOutside (x, y) = x < 0 || x >= Board.width b || y < 0 || y >= Board.height b + +mergeWith :: Unit -> Board -> Board +mergeWith unit board = board { filled = Set.union unitMembers boardFilled } where + unitMembers = members unit + boardFilled = Board.filled board diff --git a/src/Strategy0.hs b/src/Strategy0.hs index 3dc05a0..158d4d5 100644 --- a/src/Strategy0.hs +++ b/src/Strategy0.hs @@ -11,7 +11,7 @@ strat0 game = (take nsteps seswlist, score) (nsteps, score) = stepr game stepr :: Game -> (Int,Int) -stepr game = if notes == Ended +stepr game = if notes == GameOver then (1,score) else (1 + (fst new_step), snd new_step) where @@ -20,7 +20,7 @@ stepr game = if notes == Ended new_step = (stepl new_game) stepl :: Game -> (Int,Int) -stepl game = if notes == Ended +stepl game = if notes == GameOver then (1,score) else (1 + (fst new_step), snd new_step) where diff --git a/src/VM.hs b/src/VM.hs index 37734e0..1f9e82b 100644 --- a/src/VM.hs +++ b/src/VM.hs @@ -13,10 +13,10 @@ import Datatypes.Unit (Unit(..)) import qualified Datatypes.Unit as Unit data Notes = OK - | Ended - | Collision - | CollisionWithRowElision - | ErrorZero + | GameOver + | Lock { rowsCleaned :: Int } + | ErrorSamePosition + | ErrorGameEnded deriving (Show,Eq) cmdToString :: [Command] -> String @@ -28,7 +28,6 @@ cmdToString (RotateClockwise:cs) = 'd' : cmdToString cs cmdToString (RotateCounterclockwise:cs) = 'k' : cmdToString cs cmdToString [] = [] - data Command = MoveW | MoveE | MoveSW @@ -36,6 +35,14 @@ data Command = MoveW | RotateClockwise | RotateCounterclockwise deriving (Show,Eq) + +moveScore :: Int -> Int -> Int -> Int +moveScore size lines linesOld = points + lineBonus where + points = size + 100 * ((1 + lines) * lines) `div` 2 + lineBonus = if linesOld > 1 + then floor (fromIntegral ((linesOld - 1) * points) / 100) + else 0 + checkSpawn :: Game -> Game checkSpawn game@(Game _ [] _ _ _) = game checkSpawn game@(Game board (u:us) oldPos _ _) = if u `Unit.collidesWith` board @@ -43,13 +50,18 @@ checkSpawn game@(Game board (u:us) oldPos _ _) = if u `Unit.collidesWith` board else game lockUnit :: Game -> Game -lockUnit (Game board (u:us) _ oldLines oldPoints) = Game newBoard us (Set.fromList []) newLines (newPoints + lineBonus + oldPoints) where - tempBoard = board { Board.filled = Set.union (Unit.members u) (Board.filled board) } - (newBoard, newLines) = Board.clearLines tempBoard - newPoints = (Set.size (Unit.members u)) + (100 * (1 + newLines) * newLines `div` 2) - lineBonus = if oldLines > 1 - then floor (fromIntegral ((oldLines - 1) * newPoints) / 10) - else 0 +lockUnit game = game { + board = newBoard, + units = us, + visitedUnits = Set.empty, + oldLines = clearedLines, + score = Game.score game + newScore + } where + (u:us) = Game.units game + mergedBoard = u `Unit.mergeWith` (Game.board game) + (newBoard, clearedLines) = Board.clearLines mergedBoard + size = Set.size $ Unit.members u + newScore = moveScore size clearedLines (Game.oldLines game) testStep = let unit = Unit (0, 0) (Set.fromList [(2,9)]) board = Board 5 10 (Set.fromList [(0,8),(1,8),(0,9),(1,9),(4,8),(3,9),(4,9)]) @@ -68,14 +80,14 @@ testStep3 = let unit = Unit (0, 0) (Set.fromList [(2,9)]) in step (Game board [unit] (Set.fromList []) 0 0) MoveSW step :: Game -> Command -> (Game, Notes) -step game@(Game _ [] _ _ _) command = (game, ErrorZero) +step game@(Game _ [] _ _ _) command = (game, ErrorGameEnded) step game@(Game board (unit:us) oldPositions o l) command = if newUnit `Unit.collidesWith` board || newUnit `Unit.isOutsideOf` board then let final = checkSpawn (lockUnit game) in - (if Game.completed final then (final, Ended) else (final, OK)) + (if Game.completed final then (final, GameOver) else (final, Lock 0)) else if Set.member (hash newUnit) oldPositions - then (Game board (newUnit:us) oldPositions o l, ErrorZero) + then (Game board (newUnit:us) oldPositions o l, ErrorSamePosition) else (Game board (newUnit:us) newOldPositions o l, OK) where newUnit = applyCommand unit command