simulation working

This commit is contained in:
weiss
2020-04-23 09:58:18 +02:00
parent afc2af5cdb
commit aef5584f15
4 changed files with 80 additions and 46 deletions

View File

@@ -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)

View File

@@ -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

View File

@@ -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

View File

@@ -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)