icfp2015/src/Strategy0.hs

{-# LANGUAGE DeriveGeneric #-}
module Strategy0(Strategy0) where

import qualified Data.PQueue.Prio.Max as PQ

import GHC.Generics (Generic)
import Control.DeepSeq
import System.Random(StdGen)
import Data.Maybe (isJust)
import Datatypes
import Datatypes.Game (Command(..))
import qualified Datatypes.Unit as Unit
import qualified Datatypes.Game as Game
import VM
import StrategyManager


commandsList :: [Command]
commandsList = [MoveSE, MoveSW, MoveW, MoveE, RotateClockwise, RotateCounterclockwise]

type Queue = PQ.MaxPQueue (Int, Int, Int) Game
data Strategy0 = Strategy0 (Queue, [Game])
               deriving Generic

instance Strategy Strategy0 where
 initst  = strategy0initst
 advance = strategy0advance
 getbest = strategy0getbest

instance NFData Strategy0

strategy0initst :: Game -> StdGen -> [[Command]] -> Strategy0
strategy0initst game _ _ = (Strategy0 (firstQueue, firstList)) where
    firstQueue = PQ.singleton (fullScore game, -(length $ Game.units game), snd . Unit.pivot . head . Game.units $ game) game
    firstList = []

strategy0advance :: Strategy0 -> Either Strategy0 ([Command],Int) 
strategy0advance (Strategy0 (queue,completed)) =
        let candidates = (tryPowerPhrases game) ++ (map (step game) commandsList)
            (newQueue, newCompleted) = updateCollections candidates remQueue (game:completed)
            in Left (Strategy0 (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 (fullScore x, -(length $ Game.units x), snd . Unit.pivot . head . Game.units $ x) x q
                pushToList c x = x : c

strategy0getbest :: Strategy0 -> ([Command], Int)
strategy0getbest (Strategy0 (incomplete,completed)) =
        let (_, bestIncomplete) = PQ.findMax incomplete
            resultGame = findListMax (bestIncomplete:completed)
            in (reverse (Game.history resultGame), fullScore resultGame)

fullScore :: Game -> Int
fullScore game = Game.score game + (Game.powerCounterToScore $ Game.powerCounter game)

findListMax :: [Game] -> Game
findListMax (x:xs) = innerFindListMax x xs where
    innerFindListMax currentMax [] = currentMax
    innerFindListMax currentMax (y:ys) = innerFindListMax (if (fullScore currentMax) > (fullScore 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)

tryPowerPhrases :: Game -> [(Game, Notes)]
tryPowerPhrases game = validResults where
    allResults = map (innerExpand (game, OK)) Game.powerPhrasesAsCommands
    validResults = map (\(Just x) -> x) $ filter (\x -> isJust x) allResults
    innerExpand (game, note) [] = Just (game, note)
    innerExpand (game, note) [p] =  let nn@(newGame, newNote) = step game p
                                        in case newNote of
                                               OK -> Just nn
                                               Lock _ -> Just nn
                                               GameOver -> Just nn
                                               _ -> Nothing
    innerExpand (game, note) (p:ps) = let nn@(newGame, newNote) = step game p
                                          in case newNote of
                                                 OK -> innerExpand nn ps
                                                 Lock _ -> innerExpand nn ps
                                                 _ -> Nothing