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.
73 lines
3.5 KiB
73 lines
3.5 KiB
module Strategy0 where
|
|
|
|
import qualified Data.PQueue.Prio.Max as PQ
|
|
|
|
import Data.Maybe (isJust)
|
|
|
|
import Datatypes
|
|
import Datatypes.Game (Command(..))
|
|
import qualified Datatypes.Game as Game
|
|
import VM
|
|
|
|
commandsList :: [Command]
|
|
commandsList = [MoveSE, MoveSW, MoveW, MoveE, RotateClockwise, RotateCounterclockwise]
|
|
|
|
type Queue = PQ.MaxPQueue Int Game
|
|
|
|
fullScore :: Game -> Int
|
|
fullScore game = Game.score game + (Game.cacheToScore $ Game.phrasesCache game)
|
|
|
|
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
|
|
|
|
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
|
|
|
|
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
|
|
pushToList c x = x : c
|