From aef5584f150d415761e3af73f1c3ac57be8dbd8b Mon Sep 17 00:00:00 2001 From: weiss Date: Thu, 23 Apr 2020 09:58:18 +0200 Subject: [PATCH] simulation working --- haskell/vindinium/app/Main.hs | 31 +++++++- haskell/vindinium/src/Player.hs | 2 +- haskell/vindinium/src/Simulation/Board.hs | 87 +++++++++++------------ haskell/vindinium/test/Spec.hs | 6 ++ 4 files changed, 80 insertions(+), 46 deletions(-) diff --git a/haskell/vindinium/app/Main.hs b/haskell/vindinium/app/Main.hs index f623f54..495030c 100644 --- a/haskell/vindinium/app/Main.hs +++ b/haskell/vindinium/app/Main.hs @@ -1,6 +1,35 @@ module Main where import Codingame +import Simulation.Board +import Simulation.Data +import Data.Vector as V main :: IO () -main = bundle \ No newline at end of file +-- 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) diff --git a/haskell/vindinium/src/Player.hs b/haskell/vindinium/src/Player.hs index 525fc2c..fa6243b 100644 --- a/haskell/vindinium/src/Player.hs +++ b/haskell/vindinium/src/Player.hs @@ -80,7 +80,7 @@ bot readLine writeLine = do _ -> False) entities 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 $ case life hero of diff --git a/haskell/vindinium/src/Simulation/Board.hs b/haskell/vindinium/src/Simulation/Board.hs index 1b607f2..7b78633 100644 --- a/haskell/vindinium/src/Simulation/Board.hs +++ b/haskell/vindinium/src/Simulation/Board.hs @@ -9,77 +9,76 @@ import Control.Monad.State.Class import Data.List as L import Simulation.Data -size = 10 -- TODO: Allow for variable board sizes -searchDepth = 5 +size = 5 -- TODO: Allow for variable board sizes +searchDepth = 9 -- fromPlayerBoard :: Board -> BoardInternal -- fromPlayerBoard pBoardInternal = fmap (fmap $ fromEnum) asVector -- 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 -- 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 -- TODO: Check if tailrec simulate :: Board -> Pos -> GameState -> (Int, Pos) -simulate board pos = evalState sim - where sim = simulateMove board pos searchDepth (-1,-1) +simulate board pos = simulateMove board pos (-1,-1) searchDepth -simulateMove :: Board -> Pos -> Int -> Pos -> State GameState (Int, Pos) -simulateMove board pos depth prevPos - | depth == 0 = do - evalMove board pos - gold <- evalGameState - pure $ (gold, pos) - | otherwise = do - evalMove board pos - let bPos = boardPos board pos - let pos' = if bPos == Tavern || bPos == Mine then prevPos else pos -- move back out of tavern/mine - vals <- S.mapM (\pos'' -> simulateMove board pos'' (depth-1) pos') moves - -- 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 +simulateMove :: Board -> Pos -> Pos -> Int -> GameState -> (Int, Pos) +simulateMove board pos prevPos depth gameState + | depth == 0 = + let gameState' = evalMove board pos gameState + in (evalGameState gameState', pos) + | otherwise = + let gameState' = evalMove board pos gameState + bPos = boardPos board pos + -- 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' + valsWithOldPos = if depth == searchDepth then vals -- return position of submove on first level - else zip (fmap fst vals) (replicate 4 pos') -- return starting position otherwise - pure $ L.maximumBy (\(v1, _) (v2, _) -> compare v1 v2) valsWithOldPos - -- let maxVal = L.maximum valsWithOldPos - -- pure (maxVal, if depth == searchDepth then else pos) + else zip (fmap fst vals) (replicate 4 pos) -- return starting position otherwise -- before pos' + in L.maximumBy (\(v1, _) (v2, _) -> compare v1 v2) valsWithOldPos where moves :: [Pos] moves = filter (posValid board) $ possibleMoves pos -- update State according to hero position on board -- executed every move -evalMove :: Board -> Pos -> State GameState () -evalMove board pos - | entity == Air = modify (\(gold, life, mines) -> (gold + length mines, life-1, mines)) - | entity == SpawnPoint = modify (\(gold, life, mines) -> (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 +evalMove :: Board -> Pos -> GameState -> GameState +evalMove board pos state@(gold, life, mines) + | entity == Air = (gold + length mines, life-1, mines) + | entity == SpawnPoint = (gold + length mines, life-1, mines) + | 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 = - modify (\(gold, life, mines) -> - let addMine = pos `V.notElem` mines - mines' = if addMine then V.cons pos mines else mines - in - ( gold + 1 + length mines' - , life - 1 - , mines' - )) - | entity == Wall = pure () -- should never happen + let addMine = pos `V.notElem` mines + mines' = if addMine then V.cons pos mines else mines + in + ( gold + length mines' + , life - 1 + , mines' + ) + | entity == Wall = state -- should never happen where entity = boardPos board pos -- retuns the evalutaion of the current move -- executed if maximum depth is reached -evalGameState :: State GameState Int -evalGameState = do - (gold, _, _) <- get - pure gold +evalGameState :: GameState -> Int +evalGameState (gold, _, _) = gold -- get BoardInternalEntity Enum of Pos on BoardInternal 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@(x,y) = onBoardInternal && boardPos' /= Wall diff --git a/haskell/vindinium/test/Spec.hs b/haskell/vindinium/test/Spec.hs index cd4753f..1acef72 100644 --- a/haskell/vindinium/test/Spec.hs +++ b/haskell/vindinium/test/Spec.hs @@ -1,2 +1,8 @@ +import Simulation.Board +import Simulation.Data + main :: IO () main = putStrLn "Test suite not yet implemented" + +emptyBoard :: Board +emptyBoard = V.generate 9 (\_ -> V.replicate 9 Air)