damn

icfp2015.cabal

@@ -60,7 +60,7 @@ executable icfp2015
   other-extensions:    OverloadedStrings, DeriveGeneric, DeriveDataTypeable
  
   -- Other library packages from which modules are imported.
-  build-depends:       base >=4.6 && <4.9, hashable >=1.2 && <1.3, containers >=0.5 && <0.6, QuickCheck >=2.7 && <2.9, bytestring >=0.10 && <0.11, aeson >=0.7 && <0.9, json >=0.4 && <0.10
+  build-depends:       base >=4.6 && <4.9, hashable >=1.2 && <1.3, containers >=0.5 && <0.6, QuickCheck >=2.7 && <2.9, bytestring >=0.10 && <0.11, aeson >=0.8 && <0.9, json >=0.9 && <0.10, pqueue >=1.3 && <1.4
 
   -- Directories containing source files.
   hs-source-dirs:       src

src/Datatypes/Game.hs

@@ -1,4 +1,4 @@
-module Datatypes.Game (Game(..), completed, new) where
+module Datatypes.Game (Game(..), Command(..), completed, new) where
 
 import Data.Hashable (hash)
 import Data.Set (Set)
@@ -8,6 +8,14 @@ import Datatypes.Board (Board)
 import Datatypes.Unit (Unit)
 import qualified Datatypes.Unit as Unit
 
+data Command = MoveW
+             | MoveE
+             | MoveSW
+             | MoveSE
+             | RotateClockwise
+             | RotateCounterclockwise
+             deriving (Show,Eq)
+
 type UnitHash = Int
 
 data Game = Game {
@@ -15,7 +23,8 @@ data Game = Game {
           units :: [Unit],
           visitedUnits :: Set UnitHash,
           oldLines :: Int,
-          score :: Int
+          score :: Int,
+          history :: [Command]
           }
           deriving Show
 
@@ -28,5 +37,6 @@ new b us = Game {
                 units = (c:cs),
                 visitedUnits = Set.singleton (hash c),
                 oldLines = 0,
-                score = 0
+                score = 0,
+                history = []
                 } where (c:cs) = map (flip Unit.centeredIn b) us

src/Main0.hs

@@ -12,7 +12,8 @@ import Datatypes
 import Opt
 import JSONDeser
 import Strategy0
-import VM (Command, cmdToString)
+import VM (cmdToString)
+import Datatypes.Game (Command)
 
 data JSONSer = JSONSer { problemId :: Int,
                          seed :: Int,

src/Strategy0.hs

@@ -1,31 +1,56 @@
+{-# OPTIONS -Wall #-}
+
 module Strategy0 where
 
+import qualified Data.PQueue.Prio.Max as PQ
+
 import Datatypes
+import Datatypes.Game (Command(..))
 import qualified Datatypes.Game as Game
 import VM
 
-seswlist = cycle [MoveSE, MoveSW]
+import Debug.Trace (trace)
+
+commandsList :: [Command]
+commandsList = [MoveSE, MoveSW, MoveW, MoveE]
+
+type Queue = PQ.MaxPQueue Int Game
 
 strat0 :: Game -> ([Command],Int)
-strat0 game = (take nsteps seswlist, score)
-  where
-    (nsteps, score) = stepr game
-    
-stepr :: Game -> (Int,Int)
-stepr game = if notes == GameOver
-             then (1,score)
-             else (1 + (fst new_step), snd new_step) 
-  where
-    (new_game,notes) = step game MoveSE  
-    score = Game.score new_game
-    new_step = (stepl new_game)
-
-stepl :: Game -> (Int,Int)
-stepl game = if notes == GameOver
-             then (1,score)
-             else (1 + (fst new_step), snd new_step) 
-  where
-    (new_game,notes) = step game MoveSW  
-    score = Game.score new_game
-    new_step = (stepr new_game)
+strat0 game | trace (show game) False = undefined
+strat0 game = let firstQueue = PQ.singleton (Game.score game) game
+                  (incomplete, completed) = findBest maxIter firstQueue []
+                  (_, bestIncomplete) = PQ.findMax incomplete
+                  resultGame = findListMax (bestIncomplete:completed)
+                  in trace (show resultGame) (reverse (Game.history resultGame), Game.score resultGame)
+                  where
+                      maxIter = 30000
+
+findListMax :: [Game] -> Game
+findListMax (x:xs) = innerFindListMax x xs where
+    innerFindListMax currentMax [] = currentMax
+    innerFindListMax currentMax (y:ys) = innerFindListMax (if (Game.score currentMax) > (Game.score y) then currentMax else y) ys
+
+partition :: (a -> Bool) -> [a] -> ([a], [a])
+partition p items = innerPartition items [] [] where
+    innerPartition [] ts fs = (ts, fs)
+    innerPartition (x:xs) ts fs = if p x
+                                      then innerPartition xs (x:ts) fs
+                                      else innerPartition xs ts (x:fs)
 
+findBest :: Int -> Queue -> [Game] -> (Queue, [Game])
+findBest 0 queue completed = (queue, completed)
+findBest i queue completed =
+        let candidates = map (step game) commandsList
+            (newQueue, newCompleted) = updateCollections candidates remQueue (game:completed)
+            in findBest (i - 1) newQueue newCompleted
+            where
+                ((score, game), remQueue) = PQ.deleteFindMax queue
+                updateCollections [] q l = (q, l)
+                updateCollections ((g, n):rs) q l = case n of
+                                                        OK -> updateCollections rs (pushToQueue q g) l
+                                                        Lock _ -> updateCollections rs (pushToQueue q g) l
+                                                        GameOver -> updateCollections rs q (pushToList l g)
+                                                        _ -> updateCollections rs q l
+                pushToQueue q x = PQ.insert (Game.score x) x q
+                pushToList c x = x : c

src/VM.hs

@@ -7,19 +7,11 @@ import qualified Data.Set as Set
 import Datatypes.Board (Board(..))
 import qualified Datatypes.Board as Board
 import Datatypes.Cell (Cell(..))
-import Datatypes.Game (Game(..))
+import Datatypes.Game (Game(..), Command(..))
 import qualified Datatypes.Game as Game
 import Datatypes.Unit (Unit(..))
 import qualified Datatypes.Unit as Unit
 
-data Command = MoveW
-             | MoveE
-             | MoveSW
-             | MoveSE
-             | RotateClockwise
-             | RotateCounterclockwise
-             deriving (Show,Eq)
-
 data Notes = OK
            | GameOver
            | Lock { rowsCleaned :: Int }
@@ -66,11 +58,11 @@ lockUnit game = 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)])
-               in  step (Game board [unit] (Set.fromList []) 0 0) MoveSW
+               in  step (Game board [unit] (Set.fromList []) 0 0 []) MoveSW
 
 testStep2 = let unit = Unit (2, 4) (Set.fromList [(0,3),(1,3),(2,3),(3,3),(1,4),(2,4),(3,4), (1,5),(2,5),(2,6)])
                 board = Board 6 10 (Set.fromList [(0,8),(0,9),(4,6),(3,7),(4,7),(3,8),(4,8),(2,9),(3,9),(4,9),(5,8),(5,9)])
-                (g1, n1) = step (Game board [unit] (Set.fromList []) 2 0) MoveSW
+                (g1, n1) = step (Game board [unit] (Set.fromList []) 2 0 []) MoveSW
                 (g2, n2) = step g1 MoveSE
                 (g3, n3) = step g2 MoveSW
                 (g4, n4) = step g3 MoveSW
@@ -78,27 +70,27 @@ testStep2 = let unit = Unit (2, 4) (Set.fromList [(0,3),(1,3),(2,3),(3,3),(1,4),
 
 testStep3 = 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)])
-                in  step (Game board [unit] (Set.fromList []) 0 0) MoveSW
+                in  step (Game board [unit] (Set.fromList []) 0 0 []) MoveSW
 
 step :: Game -> Command -> (Game, Notes)
 step game@(Game { units = [] }) command = (game, ErrorGameEnded)
 step game command =
-        if shouldLock
-        then
-            if Game.completed updatedGame
-                then (updatedGame, GameOver)
-                else (updatedGame, Lock (Game.oldLines updatedGame))
-        else
-            if Set.member (hash newUnit) (Game.visitedUnits game)
-                then (game { units = newUnit:otherUnits }, ErrorSamePosition)
-                else (game { units = newUnit:otherUnits, visitedUnits = newVisitedUnits }, OK)
-        where
-            (unit:otherUnits) = Game.units game
+        let (unit:otherUnits) = Game.units game
             newUnit = applyCommand unit command
             board = Game.board game
             shouldLock = newUnit `Unit.collidesWith` board || newUnit `Unit.isOutsideOf` board
             newVisitedUnits = Set.insert (hash newUnit) (Game.visitedUnits game)
-            updatedGame = checkSpawn $ lockUnit game
+            updatedGame = (checkSpawn $ lockUnit game) { history = command:(Game.history game) }
+            in
+                if shouldLock
+                    then
+                        if Game.completed updatedGame
+                            then (updatedGame, GameOver)
+                            else (updatedGame, Lock (Game.oldLines updatedGame))
+                    else
+                        if Set.member (hash newUnit) (Game.visitedUnits game)
+                            then (game { units = newUnit:otherUnits }, ErrorSamePosition)
+                            else (game { units = newUnit:otherUnits, visitedUnits = newVisitedUnits, history = command:(Game.history game) }, OK)
 
 applyCommand :: Unit -> Command -> Unit
 applyCommand unit MoveW = Unit.map move unit where