icfp2015/src/Strategy0.hs

module Strategy0(Strategy0) where

import qualified Data.PQueue.Prio.Max as PQ

import System.Random(StdGen)
import Data.Maybe (isJust)
import Datatypes
import Datatypes.Game (Command(..))
import qualified Datatypes.Game as Game
import VM
import StrategyManager


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

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


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

strategy0initst :: Game -> StdGen -> Maybe [Command] -> Strategy0
strategy0initst game _ _ = (Strategy0 (PQ.singleton (fullScore game) game, []))

strategy0advance :: Strategy0 -> Either Strategy0 ([Command],Int) 
strategy0advance (Strategy0 (queue,completed)) = let candidates = 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) 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.cacheToScore $ Game.phrasesCache 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.powerPhrases
    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

--
-- Old Strategy0 Code
-- 
-- findBest :: Int -> Queue -> [Game] -> (Queue, [Game])
-- findBest 0 queue completed = (queue, completed)
-- findBest i queue completed = let candidates = map (step game) commandsList ++ (tryPowerPhrases game)
--                                  (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 (fullScore x) x q

-- strat0 :: Game -> ([Command],Int)
-- strat0 game = let firstQueue = PQ.singleton (fullScore game) game
--                   (incomplete, completed) = findBest maxIter firstQueue []
--                   (_, bestIncomplete) = PQ.findMax incomplete
--                   resultGame = findListMax (bestIncomplete:completed)
--               in (reverse (Game.history resultGame), fullScore resultGame)
--   where
--     maxIter = 50000
--     pushToList c x = x : c