This commit is contained in:
weiss
2020-04-25 20:00:03 +02:00
parent f0ab6ad122
commit f41d806029
5 changed files with 66 additions and 41 deletions

View File

@@ -1,16 +1,22 @@
module Main where module Main where
import System.Environment
import Codingame import Codingame
import Simulation.Board import Simulation.Board
import Simulation.Data import Simulation.Data
import Data.Vector as V import Data.Vector as V
main :: IO () main :: IO ()
-- main = test main = do
main = bundle bundle
print $ sim1 (2,4)
--test
test :: IO () test :: IO ()
test = print $ Prelude.reverse $ loop1 (0,0) 10 [] test = do
args <- getArgs
let simDepth = if Prelude.length args > 0 then read $ Prelude.head args :: Int else 3
print $ Prelude.reverse $ loop1 (0,0) simDepth []
loop1 :: Pos -> Int -> [Pos] -> [Pos] loop1 :: Pos -> Int -> [Pos] -> [Pos]
loop1 pos depth acc loop1 pos depth acc
@@ -21,7 +27,7 @@ loop1 pos depth acc
in loop1 sim (depth - 1) acc' in loop1 sim (depth - 1) acc'
sim1 :: Pos -> (Int, Pos) sim1 :: Pos -> (Int, Pos)
sim1 pos = simulate board1 (0, 100, pos, singleton (0,4)) sim1 pos = (\(val, (_,_, pos, _)) -> (val, pos)) (simulate board1 (0, 100, pos, singleton (0,4)))
board1 :: Board board1 :: Board
board1 = fromList $ fmap fromList board1 = fromList $ fmap fromList

View File

@@ -14,13 +14,15 @@ import qualified Data.Vector as V
import BotRunner import BotRunner
import Graph import Graph
import Simulation.Data import Simulation.Data
import Simulation.Board (simulate) import Simulation.Lib
import Simulation.Board
-- Id, Pos, life, gold -- Id, Pos, life, gold
data Entity data Entity
= EHero Int Pos Int Int = EHero Int Pos Int Int
| EMine Int Pos | EMine Int Pos
deriving (Show)
runMain :: IO () runMain :: IO ()
runMain = runBot True bot runMain = runBot True bot
@@ -41,7 +43,7 @@ bot readLine writeLine = do
| se == 'M' -> Mine | se == 'M' -> Mine
| otherwise -> SpawnPoint) $ V.fromList br) board' -- TODO: $ digitToInt se) br) board' | otherwise -> SpawnPoint) $ V.fromList br) board' -- TODO: $ digitToInt se) br) board'
input_line <- getLine input_line <- getLine
-- let iBoard :: IndexedBoard = Prelude.concatMap (\(i_r, br) -> fmap (\(i_c, bc) -> ((i_c, i_r), bc)) br) $ V.zip [0..9] $ fmap (V.zip [0..9]) board let iBoard :: IndexedBoard = V.concatMap (\(i_r, br) -> fmap (\(i_c, bc) -> ((i_c, i_r), bc)) br) $ V.zip (V.fromList [0..size]) $ fmap (V.zip $ V.fromList [0..size]) board
let myId = read input_line :: Int -- ID of your hero let myId = read input_line :: Int -- ID of your hero
@@ -69,25 +71,33 @@ bot readLine writeLine = do
let hero = V.head $ V.filter (\e -> case e of let hero = V.head $ V.filter (\e -> case e of
EHero id _ _ _ -> id == myId EHero id _ _ _ -> id == myId
_ -> False) heroes _ -> False) heroes
-- let mines = V.filter (\e -> case e of let mines = V.filter (\e -> case e of
-- EMine oId _ -> oId /= myId EMine oId _ -> oId /= myId
-- _ -> False) entities _ -> False) entities
-- let minEMine = L.minimumBy (\e1 e2 -> compare (dist (posFromEntity e1) (posFromEntity hero)) (dist (posFromEntity e2) (posFromEntity hero))) mines let minEMine = L.minimumBy (\e1 e2 -> compare (dist (posFromEntity e1) (posFromEntity hero)) (dist (posFromEntity e2) (posFromEntity hero))) mines
-- let minTavernPos = L.minimumBy (\p1 p2 -> compare (dist p1 (posFromEntity hero)) (dist p2 (posFromEntity hero))) $ fmap (\(p, be) -> p) $ V.filter (\(p, be) -> isTavern be) iBoard let minTavernPos = L.minimumBy (\p1 p2 -> compare (dist p1 (posFromEntity hero)) (dist p2 (posFromEntity hero))) $ fmap (\(p, be) -> p) $ V.filter (\(p, be) -> isTavern be) iBoard
let myMines = V.filter (\e -> case e of let myMines = V.filter (\e -> case e of
EMine oId _ -> oId == myId EMine oId _ -> oId == myId
_ -> False) entities _ -> False) entities
let st = (gameState hero $ fmap posFromEntity myMines) let gs = gameState hero $ fmap posFromEntity myMines
hPrint stderr st let oldMines = length $ getMines gs
let (val, pos) = simulate board st let sim = simulate board gs
-- hPrint stderr (gameState hero $ fmap posFromEntity myMines) -- (val, pos) let newMines = length $ getMines $ snd sim
putStrLn $ moveToPos pos
-- putStrLn $ case life hero of let cmd = if newMines - oldMines > 0
-- Just lp -> if lp < 30 then moveToPos minTavernPos else moveToEntity minEMine then (\(_,(_,_,pos,_)) -> moveToPos pos) sim
-- Nothing -> moveToEntity minEMine else case life hero of
Just lp -> if lp < 30 then moveToPos minTavernPos else moveToEntity minEMine
Nothing -> moveToEntity minEMine
-- hPrint stderr $ newMines - oldMines
-- hPrint stderr minEMine
putStrLn cmd
getMines :: GameState -> V.Vector Pos
getMines (_,_,_,m) = m
moveToEntity :: Entity -> String moveToEntity :: Entity -> String
moveToEntity e = case e of moveToEntity e = case e of
@@ -98,9 +108,6 @@ moveToEntity e = case e of
moveToPos :: (Int, Int) -> String moveToPos :: (Int, Int) -> String
moveToPos (x, y) = "MOVE " <> (show x) <> " " <> (show y) moveToPos (x, y) = "MOVE " <> (show x) <> " " <> (show y)
dist :: Pos -> Pos -> Int
dist (x1, y1) (x2, y2) = abs (x2 - x1) + abs (y2 - y1)
life :: Entity -> Maybe Int life :: Entity -> Maybe Int
life (EHero _ _ l _) = Just l life (EHero _ _ l _) = Just l
life _ = Nothing life _ = Nothing

View File

@@ -1,5 +1,6 @@
module Simulation.Board module Simulation.Board
( simulate ( simulate
, evalGameState
) where ) where
-- import Prelude -- import Prelude
@@ -9,7 +10,7 @@ import Control.Monad.State.Class
import Data.List as L import Data.List as L
import Simulation.Data import Simulation.Data
searchDepth = 8 searchDepth = 9
-- fromPlayerBoard :: Board -> BoardInternal -- fromPlayerBoard :: Board -> BoardInternal
-- fromPlayerBoard pBoardInternal = fmap (fmap $ fromEnum) asVector -- fromPlayerBoard pBoardInternal = fmap (fmap $ fromEnum) asVector
@@ -19,28 +20,27 @@ searchDepth = 8
-- 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 -> GameState -> (Int, Pos) simulate :: Board -> GameState -> (Int, GameState)
simulate board = simulateMove board (-1,-1) searchDepth simulate board = simulateMove board (-1,-1) searchDepth
simulateMove :: Board -> Pos -> Int -> GameState -> (Int, Pos) simulateMove :: Board -> Pos -> Int -> GameState -> (Int, GameState)
simulateMove board prevPos depth state@(_,_,pos,_) simulateMove board prevPos depth state@(_,_,pos,_)
| depth == 0 = | depth == 0 =
let state' = evalMove board state let state' = evalMove board state
in (evalGameState state', pos) in (evalGameState state', state')
| otherwise = | otherwise =
let state' = evalMove board state let state' = evalMove board state
bPos = boardPos board pos bPos = boardPos board pos
-- der Trick: in einem Zug muss die Minenposition zurueckgegeben werden, die Position des Helden -- der Trick: in einem Zug muss die Minenposition zurueckgegeben werden, die Position des Helden
-- aendert sich aber nicht. Im naechsten Zug will der Held dann nicht mehr die Mine erobern. -- aendert sich aber nicht. Im naechsten Zug will der Held dann nicht mehr die Mine erobern.
--pos' = if bPos == Tavern || bPos == Mine then prevPos else pos -- move back out of tavern/mine pos' = if bPos == Tavern || bPos == Mine then prevPos else pos -- move back out of tavern/mine
vals = fmap (\pos' -> simulateMove board pos (depth-1) (updatePos pos' state')) moves -- before pos' -- pos wird nicht benutzt. Pos ist aber der Wert, der zurueckgegeben werden muss, damit sich der Held in die Taverne bewegt
moves = filter (posValid board state) $ possibleMoves pos'
vals = fmap (\pos'' -> simulateMove board pos' (depth-1) (updatePos pos'' state')) moves
valsWithOldPos = if depth == searchDepth 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 -- before pos' else zip (fmap fst vals) $ fmap (updatePos pos . snd) vals -- return starting position otherwise -- pos'
in L.maximumBy (\(v1, _) (v2, _) -> compare v1 v2) valsWithOldPos in L.maximumBy (\(v1, _) (v2, _) -> compare v1 v2) valsWithOldPos
where
moves :: [Pos]
moves = filter (posValid board state) $ possibleMoves pos
updatePos :: Pos -> GameState -> GameState updatePos :: Pos -> GameState -> GameState
updatePos pos (gold, life, _, mines) = (gold, life, pos, mines) updatePos pos (gold, life, _, mines) = (gold, life, pos, mines)
@@ -48,11 +48,11 @@ updatePos pos (gold, life, _, mines) = (gold, life, pos, mines)
-- update State according to hero position on board -- update State according to hero position on board
-- executed every move -- executed every move
evalMove :: Board -> GameState -> GameState evalMove :: Board -> GameState -> GameState
evalMove board state@(gold, life, pos, mines) = evalBuildings evalMove board state@(gold, life, pos, mines) = evalDeath evalBuildings
where where
evalBuildings evalBuildings
| entity == Air = (gold + length mines, life-1, pos, mines) | entity == Air = (gold + length mines, thirst life, pos, mines)
| entity == SpawnPoint = (gold + length mines, life-1, pos, mines) | entity == SpawnPoint = (gold + length mines, thirst life, pos, mines)
| entity == Tavern = | entity == Tavern =
if gold >= 2 then if gold >= 2 then
( gold + length mines - 2 ( gold + length mines - 2
@@ -62,7 +62,7 @@ evalMove board state@(gold, life, pos, mines) = evalBuildings
) )
else else
( gold + length mines ( gold + length mines
, life - 1 , thirst life
, pos , pos
, mines , mines
) )
@@ -71,25 +71,30 @@ evalMove board state@(gold, life, pos, mines) = evalBuildings
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 + length mines'
, life - 1 , if addMine then thirst life - 20 else thirst life
, pos , pos
, mines' , mines'
) )
| entity == Wall = state -- should never happen | entity == Wall = state -- should never happen
where where
entity = boardPos board pos entity = boardPos board pos
evalDeath state'@(gold', life', pos', mines')
| life' < 5 = (gold', 100, (0,0), V.empty) -- TODO: starting position is not 0,0 but spawnpoint
| otherwise = state'
thirst life = max 1 (life - 1)
-- 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 :: GameState -> Int evalGameState :: GameState -> Int
evalGameState (gold, _, _, mines) = gold + length mines * 10 evalGameState (gold, life, _, mines) = gold + (life `div` 10) + length mines * 2
-- 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.! y) V.! x boardPos board (x,y) = (board V.! y) V.! x
posValid :: Board -> GameState -> Pos -> Bool posValid :: Board -> GameState -> Pos -> Bool
posValid board (_, _, _, mines) pos@(x,y) = onBoardInternal && boardPos' /= Wall && boardPos' /= Tavern && pos `notElem` mines posValid board (_, _, _, mines) pos@(x,y) = onBoardInternal && boardPos' /= Wall && pos `notElem` mines
where where
size = length board size = length board
boardPos' = boardPos board pos boardPos' = boardPos board pos

View File

@@ -0,0 +1,6 @@
module Simulation.Lib where
import Simulation.Data
dist :: Pos -> Pos -> Int
dist (x1, y1) (x2, y2) = abs (x2 - x1) + abs (y2 - y1)

View File

@@ -4,7 +4,7 @@ cabal-version: 1.12
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: 817a86041a7dd560036682aca70efb443076dda509e4bb85d122ed1d611907a1 -- hash: a40eac4da8b91ec478d65b8403d0b4c79040e0e5d0ae95d897222ea2c05cb732
name: stackproject name: stackproject
version: 0.1.0.0 version: 0.1.0.0
@@ -34,6 +34,7 @@ library
Player Player
Simulation.Board Simulation.Board
Simulation.Data Simulation.Data
Simulation.Lib
other-modules: other-modules:
Paths_stackproject Paths_stackproject
hs-source-dirs: hs-source-dirs: