From c624909408a253f841c8a14249d66f0fb90880e7 Mon Sep 17 00:00:00 2001 From: Slash Date: Sun, 9 Aug 2015 03:09:48 +0200 Subject: [PATCH] damn --- icfp2015.cabal | 2 +- src/Datatypes/Game.hs | 16 ++++++++-- src/Main0.hs | 3 +- src/Strategy0.hs | 69 +++++++++++++++++++++++++++++-------------- src/VM.hs | 40 ++++++++++--------------- 5 files changed, 79 insertions(+), 51 deletions(-) diff --git a/icfp2015.cabal b/icfp2015.cabal index 6815e53..136b63a 100644 --- a/icfp2015.cabal +++ b/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 diff --git a/src/Datatypes/Game.hs b/src/Datatypes/Game.hs index 8480722..e161f7d 100644 --- a/src/Datatypes/Game.hs +++ b/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 diff --git a/src/Main0.hs b/src/Main0.hs index 0d90e58..e083c12 100644 --- a/src/Main0.hs +++ b/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, diff --git a/src/Strategy0.hs b/src/Strategy0.hs index 838da43..816a93f 100644 --- a/src/Strategy0.hs +++ b/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 diff --git a/src/VM.hs b/src/VM.hs index 8099ee7..92ec62c 100644 --- a/src/VM.hs +++ b/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