You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

85 lines
4.0 KiB

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.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])
instance Strategy Strategy0 where
initst = strategy0initst
advance = strategy0advance
getbest = strategy0getbest
strategy0initst :: Game -> StdGen -> Maybe [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