Browse Source

completed Strategy0 refactoring

adaptedStrategy0
Andrea Bellandi 9 years ago
parent
commit
b168df78cd
3 changed files with 82 additions and 43 deletions
  1. +6
    -3
      src/Mainpf.hs
  2. +63
    -27
      src/Strategy0.hs
  3. +13
    -13
      src/StrategyManager.hs

+ 6
- 3
src/Mainpf.hs View File

@ -15,6 +15,7 @@ import Data.Aeson
import Data.Maybe import Data.Maybe
import StrategyManager import StrategyManager
import Strategy0
import Datatypes import Datatypes
import Datatypes.Game import Datatypes.Game
import VM import VM
@ -32,7 +33,7 @@ timelimitratio = 0.9
memlimitratio :: Double memlimitratio :: Double
memlimitratio = 0.9 memlimitratio = 0.9
gccompperstep :: Integer gccompperstep :: Integer
gccompperstep = 10
gccompperstep = 100000
data JSONSer = JSONSer { problemId :: Int, data JSONSer = JSONSer { problemId :: Int,
@ -48,8 +49,10 @@ type Id = Int
type Seed = Int type Seed = Int
strategies :: Game -> StdGen -> Maybe [Command] -> GameComputation strategies :: Game -> StdGen -> Maybe [Command] -> GameComputation
strategies g sgen cmd = [MkStrategyWrapper (initst g sgen cmd :: NullStrategy1),
MkStrategyWrapper (initst g sgen cmd :: NullStrategy2)]
strategies g sgen cmd = [MkStrategyWrapper (initst g sgen cmd :: Strategy0)]
-- = [MkStrategyWrapper (initst g sgen cmd :: NullStrategy1),
-- MkStrategyWrapper (initst g sgen cmd :: NullStrategy2)]
-- example :: -- example ::
-- = [MkStrategyWrapper (init g sgen cmd :: Strat0), -- = [MkStrategyWrapper (init g sgen cmd :: Strat0),


+ 63
- 27
src/Strategy0.hs View File

@ -1,36 +1,61 @@
module Strategy0 where
module Strategy0(Strategy0) where
import qualified Data.PQueue.Prio.Max as PQ import qualified Data.PQueue.Prio.Max as PQ
import System.Random(StdGen)
import Data.Maybe (isJust) import Data.Maybe (isJust)
import Datatypes import Datatypes
import Datatypes.Game (Command(..)) import Datatypes.Game (Command(..))
import qualified Datatypes.Game as Game import qualified Datatypes.Game as Game
import VM import VM
import StrategyManager
commandsList :: [Command] commandsList :: [Command]
commandsList = [MoveSE, MoveSW, MoveW, MoveE, RotateClockwise, RotateCounterclockwise] commandsList = [MoveSE, MoveSW, MoveW, MoveE, RotateClockwise, RotateCounterclockwise]
type Queue = PQ.MaxPQueue Int Game 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 -> Int
fullScore game = Game.score game + (Game.cacheToScore $ Game.phrasesCache game) 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 :: [Game] -> Game
findListMax (x:xs) = innerFindListMax x xs where findListMax (x:xs) = innerFindListMax x xs where
innerFindListMax currentMax [] = currentMax innerFindListMax currentMax [] = currentMax
innerFindListMax currentMax (y:ys) = innerFindListMax (if (fullScore currentMax) > (fullScore y) then currentMax else y) ys innerFindListMax currentMax (y:ys) = innerFindListMax (if (fullScore currentMax) > (fullScore y) then currentMax else y) ys
partition :: (a -> Bool) -> [a] -> ([a], [a]) partition :: (a -> Bool) -> [a] -> ([a], [a])
partition p items = innerPartition items [] [] where partition p items = innerPartition items [] [] where
innerPartition [] ts fs = (ts, fs) innerPartition [] ts fs = (ts, fs)
@ -55,19 +80,30 @@ tryPowerPhrases game = validResults where
Lock _ -> innerExpand nn ps Lock _ -> innerExpand nn ps
_ -> Nothing _ -> 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
--
-- 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

+ 13
- 13
src/StrategyManager.hs View File

@ -15,19 +15,6 @@ data StrategyWrapper = forall a . Strategy a => MkStrategyWrapper a
data NullStrategy1 = NullS1 data NullStrategy1 = NullS1
instance Strategy NullStrategy1 where
initst _ _ _ = NullS1
advance _ = Left NullS1
getbest _ = ([],0)
data NullStrategy2 = NullS2
instance Strategy NullStrategy2 where
initst _ _ _ = NullS2
advance _ = Left NullS2
getbest _ = ([],0)
initWrapper :: Strategy a => a -> StrategyWrapper initWrapper :: Strategy a => a -> StrategyWrapper
@ -69,3 +56,16 @@ getBestGameComputation gc = foldl bestgame (([], 0), 0) (map getbestWrapper gc)
advanceGameComputation :: GameComputation -> GameComputation advanceGameComputation :: GameComputation -> GameComputation
advanceGameComputation gc = map advanceWrapper gc advanceGameComputation gc = map advanceWrapper gc
instance Strategy NullStrategy1 where
initst _ _ _ = NullS1
advance _ = Left NullS1
getbest _ = ([],0)
data NullStrategy2 = NullS2
instance Strategy NullStrategy2 where
initst _ _ _ = NullS2
advance _ = Left NullS2
getbest _ = ([],0)

Loading…
Cancel
Save