{-# 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