simulation working
This commit is contained in:
@@ -1,6 +1,35 @@
|
|||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import Codingame
|
import Codingame
|
||||||
|
import Simulation.Board
|
||||||
|
import Simulation.Data
|
||||||
|
import Data.Vector as V
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = bundle
|
-- main = test
|
||||||
|
main = bundle
|
||||||
|
|
||||||
|
test :: IO ()
|
||||||
|
test = print $ Prelude.reverse $ loop1 (0,0) 10 []
|
||||||
|
|
||||||
|
loop1 :: Pos -> Int -> [Pos] -> [Pos]
|
||||||
|
loop1 pos depth acc
|
||||||
|
| depth == 0 = acc
|
||||||
|
| otherwise =
|
||||||
|
let sim = snd $ sim1 pos
|
||||||
|
acc' = sim : acc
|
||||||
|
in loop1 sim (depth - 1) acc'
|
||||||
|
|
||||||
|
sim1 :: Pos -> (Int, Pos)
|
||||||
|
sim1 pos = simulate board1 pos (0, 100, singleton (0,4))
|
||||||
|
|
||||||
|
board1 :: Board
|
||||||
|
board1 = fromList $ fmap fromList
|
||||||
|
[[Air, Air, Air, Air, Air],
|
||||||
|
[Air, Air, Air, Air, Air],
|
||||||
|
[Air, Air, Air, Air, Air],
|
||||||
|
[Air, Air, Air, Air, Air],
|
||||||
|
[Mine,Air, Air, Mine,Air]]
|
||||||
|
|
||||||
|
emptyBoard :: Board
|
||||||
|
emptyBoard = V.generate 5 (\_ -> V.replicate 5 Air)
|
||||||
|
|||||||
@@ -80,7 +80,7 @@ bot readLine writeLine = do
|
|||||||
_ -> False) entities
|
_ -> False) entities
|
||||||
|
|
||||||
let (val, pos) = simulate board (posFromEntity hero) (gameState hero $ fmap posFromEntity myMines)
|
let (val, pos) = simulate board (posFromEntity hero) (gameState hero $ fmap posFromEntity myMines)
|
||||||
hPrint stderr (val, pos)
|
-- hPrint stderr (gameState hero $ fmap posFromEntity myMines) -- (val, pos)
|
||||||
putStrLn $ moveToPos pos
|
putStrLn $ moveToPos pos
|
||||||
|
|
||||||
-- putStrLn $ case life hero of
|
-- putStrLn $ case life hero of
|
||||||
|
|||||||
@@ -9,77 +9,76 @@ import Control.Monad.State.Class
|
|||||||
import Data.List as L
|
import Data.List as L
|
||||||
import Simulation.Data
|
import Simulation.Data
|
||||||
|
|
||||||
size = 10 -- TODO: Allow for variable board sizes
|
size = 5 -- TODO: Allow for variable board sizes
|
||||||
searchDepth = 5
|
searchDepth = 9
|
||||||
|
|
||||||
-- fromPlayerBoard :: Board -> BoardInternal
|
-- fromPlayerBoard :: Board -> BoardInternal
|
||||||
-- fromPlayerBoard pBoardInternal = fmap (fmap $ fromEnum) asVector
|
-- fromPlayerBoard pBoardInternal = fmap (fmap $ fromEnum) asVector
|
||||||
-- where asVector = V.fromList $ fmap V.fromList pBoardInternal
|
-- where asVector = V.fromList $ fmap V.fromList pBoardInternal
|
||||||
|
|
||||||
emptyBoard :: Board
|
|
||||||
emptyBoard = V.generate 9 (\_ -> V.replicate 9 Air)
|
|
||||||
|
|
||||||
-- All valid board positions are possible. For example the player could move
|
-- All valid board positions are possible. For example the player could move
|
||||||
-- back and forth between two fields infinitely
|
-- back and forth between two fields infinitely
|
||||||
-- Caution: if the player moved inside a Tavern or Mine he needs to be reset to his initial position afterwards
|
-- Caution: if the player moved inside a Tavern or Mine he needs to be reset to his initial position afterwards
|
||||||
-- TODO: Check if tailrec
|
-- TODO: Check if tailrec
|
||||||
simulate :: Board -> Pos -> GameState -> (Int, Pos)
|
simulate :: Board -> Pos -> GameState -> (Int, Pos)
|
||||||
simulate board pos = evalState sim
|
simulate board pos = simulateMove board pos (-1,-1) searchDepth
|
||||||
where sim = simulateMove board pos searchDepth (-1,-1)
|
|
||||||
|
|
||||||
simulateMove :: Board -> Pos -> Int -> Pos -> State GameState (Int, Pos)
|
simulateMove :: Board -> Pos -> Pos -> Int -> GameState -> (Int, Pos)
|
||||||
simulateMove board pos depth prevPos
|
simulateMove board pos prevPos depth gameState
|
||||||
| depth == 0 = do
|
| depth == 0 =
|
||||||
evalMove board pos
|
let gameState' = evalMove board pos gameState
|
||||||
gold <- evalGameState
|
in (evalGameState gameState', pos)
|
||||||
pure $ (gold, pos)
|
| otherwise =
|
||||||
| otherwise = do
|
let gameState' = evalMove board pos gameState
|
||||||
evalMove board pos
|
bPos = boardPos board pos
|
||||||
let bPos = boardPos board pos
|
-- pos' = if bPos == Tavern || bPos == Mine then prevPos else pos -- move back out of tavern/mine
|
||||||
let pos' = if bPos == Tavern || bPos == Mine then prevPos else pos -- move back out of tavern/mine
|
vals = fmap (\pos'' -> simulateMove board pos'' pos (depth-1) gameState') moves -- before pos'
|
||||||
vals <- S.mapM (\pos'' -> simulateMove board pos'' (depth-1) pos') moves
|
valsWithOldPos = if depth == searchDepth
|
||||||
-- let valsWithPos = zip (fmap fst vals) moves -- return poss of current move, not of submoves
|
|
||||||
-- pure $ L.maximumBy (\(v1, _) (v2, _) -> compare v1 v2) valsWithPos
|
|
||||||
let valsWithOldPos = if depth == searchDepth
|
|
||||||
then vals -- return position of submove on first level
|
then vals -- return position of submove on first level
|
||||||
else zip (fmap fst vals) (replicate 4 pos') -- return starting position otherwise
|
else zip (fmap fst vals) (replicate 4 pos) -- return starting position otherwise -- before pos'
|
||||||
pure $ L.maximumBy (\(v1, _) (v2, _) -> compare v1 v2) valsWithOldPos
|
in L.maximumBy (\(v1, _) (v2, _) -> compare v1 v2) valsWithOldPos
|
||||||
-- let maxVal = L.maximum valsWithOldPos
|
|
||||||
-- pure (maxVal, if depth == searchDepth then else pos)
|
|
||||||
where
|
where
|
||||||
moves :: [Pos]
|
moves :: [Pos]
|
||||||
moves = filter (posValid board) $ possibleMoves pos
|
moves = filter (posValid board) $ possibleMoves pos
|
||||||
|
|
||||||
-- update State according to hero position on board
|
-- update State according to hero position on board
|
||||||
-- executed every move
|
-- executed every move
|
||||||
evalMove :: Board -> Pos -> State GameState ()
|
evalMove :: Board -> Pos -> GameState -> GameState
|
||||||
evalMove board pos
|
evalMove board pos state@(gold, life, mines)
|
||||||
| entity == Air = modify (\(gold, life, mines) -> (gold + length mines, life-1, mines))
|
| entity == Air = (gold + length mines, life-1, mines)
|
||||||
| entity == SpawnPoint = modify (\(gold, life, mines) -> (gold + length mines, life-1, mines))
|
| entity == SpawnPoint = (gold + length mines, life-1, mines)
|
||||||
| entity == Tavern = modify ( \(gold, life, mines) -> (gold + length mines - 2, min 100 (life+50), mines) ) -- TODO: Check if life is +19
|
| entity == Tavern =
|
||||||
|
if gold >= 2 then
|
||||||
|
( gold + length mines - 2
|
||||||
|
, min 100 (life + 50) -- TODO: Check if life is +19
|
||||||
|
, mines
|
||||||
|
)
|
||||||
|
else
|
||||||
|
( gold + length mines
|
||||||
|
, life - 1
|
||||||
|
, mines
|
||||||
|
)
|
||||||
| entity == Mine =
|
| entity == Mine =
|
||||||
modify (\(gold, life, mines) ->
|
let addMine = pos `V.notElem` mines
|
||||||
let addMine = pos `V.notElem` mines
|
mines' = if addMine then V.cons pos mines else mines
|
||||||
mines' = if addMine then V.cons pos mines else mines
|
in
|
||||||
in
|
( gold + length mines'
|
||||||
( gold + 1 + length mines'
|
, life - 1
|
||||||
, life - 1
|
, mines'
|
||||||
, mines'
|
)
|
||||||
))
|
| entity == Wall = state -- should never happen
|
||||||
| entity == Wall = pure () -- should never happen
|
|
||||||
where
|
where
|
||||||
entity = boardPos board pos
|
entity = boardPos board pos
|
||||||
|
|
||||||
-- retuns the evalutaion of the current move
|
-- retuns the evalutaion of the current move
|
||||||
-- executed if maximum depth is reached
|
-- executed if maximum depth is reached
|
||||||
evalGameState :: State GameState Int
|
evalGameState :: GameState -> Int
|
||||||
evalGameState = do
|
evalGameState (gold, _, _) = gold
|
||||||
(gold, _, _) <- get
|
|
||||||
pure gold
|
|
||||||
|
|
||||||
-- get BoardInternalEntity Enum of Pos on BoardInternal
|
-- get BoardInternalEntity Enum of Pos on BoardInternal
|
||||||
boardPos :: Board -> Pos -> BoardEntity
|
boardPos :: Board -> Pos -> BoardEntity
|
||||||
boardPos board (x,y) = (board V.! x) V.! y
|
-- boardPos board (x,y) = (board V.! x) V.! y
|
||||||
|
boardPos board (x,y) = (board V.! y) V.! x
|
||||||
|
|
||||||
posValid :: Board -> Pos -> Bool
|
posValid :: Board -> Pos -> Bool
|
||||||
posValid board pos@(x,y) = onBoardInternal && boardPos' /= Wall
|
posValid board pos@(x,y) = onBoardInternal && boardPos' /= Wall
|
||||||
|
|||||||
@@ -1,2 +1,8 @@
|
|||||||
|
import Simulation.Board
|
||||||
|
import Simulation.Data
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = putStrLn "Test suite not yet implemented"
|
main = putStrLn "Test suite not yet implemented"
|
||||||
|
|
||||||
|
emptyBoard :: Board
|
||||||
|
emptyBoard = V.generate 9 (\_ -> V.replicate 9 Air)
|
||||||
|
|||||||
Reference in New Issue
Block a user