more vm refactoring

getStats

@@ -0,0 +1,2 @@
+#!/bin/bash
+curl --user :2aaFCkjNIDHAsAIh9iQHc+Y+FGhkM5Z0RQgpO6TL6EA= -X GET  https://davar.icfpcontest.org/teams/235/solutions

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
 

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

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

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