diff --git a/haskell/vindinium/app/Main.hs b/haskell/vindinium/app/Main.hs index 8a0cedc..874416a 100644 --- a/haskell/vindinium/app/Main.hs +++ b/haskell/vindinium/app/Main.hs @@ -1,16 +1,22 @@ module Main where +import System.Environment import Codingame import Simulation.Board import Simulation.Data import Data.Vector as V main :: IO () --- main = test -main = bundle +main = do + bundle + print $ sim1 (2,4) + --test 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 depth acc @@ -21,7 +27,7 @@ loop1 pos depth acc in loop1 sim (depth - 1) acc' 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 = fromList $ fmap fromList diff --git a/haskell/vindinium/src/Player.hs b/haskell/vindinium/src/Player.hs index 233b8c0..32bf9e7 100644 --- a/haskell/vindinium/src/Player.hs +++ b/haskell/vindinium/src/Player.hs @@ -14,13 +14,15 @@ import qualified Data.Vector as V import BotRunner import Graph import Simulation.Data -import Simulation.Board (simulate) +import Simulation.Lib +import Simulation.Board -- Id, Pos, life, gold data Entity = EHero Int Pos Int Int | EMine Int Pos + deriving (Show) runMain :: IO () runMain = runBot True bot @@ -41,7 +43,7 @@ bot readLine writeLine = do | se == 'M' -> Mine | otherwise -> SpawnPoint) $ V.fromList br) board' -- TODO: $ digitToInt se) br) board' 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 @@ -69,25 +71,33 @@ bot readLine writeLine = do let hero = V.head $ V.filter (\e -> case e of EHero id _ _ _ -> id == myId _ -> False) heroes - -- let mines = V.filter (\e -> case e of - -- EMine oId _ -> oId /= myId - -- _ -> False) entities - -- 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 mines = V.filter (\e -> case e of + EMine oId _ -> oId /= myId + _ -> False) entities + 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 myMines = V.filter (\e -> case e of EMine oId _ -> oId == myId _ -> False) entities - let st = (gameState hero $ fmap posFromEntity myMines) - hPrint stderr st - let (val, pos) = simulate board st - -- hPrint stderr (gameState hero $ fmap posFromEntity myMines) -- (val, pos) - putStrLn $ moveToPos pos - - -- putStrLn $ case life hero of - -- Just lp -> if lp < 30 then moveToPos minTavernPos else moveToEntity minEMine - -- Nothing -> moveToEntity minEMine + let gs = gameState hero $ fmap posFromEntity myMines + let oldMines = length $ getMines gs + let sim = simulate board gs + let newMines = length $ getMines $ snd sim + + let cmd = if newMines - oldMines > 0 + then (\(_,(_,_,pos,_)) -> moveToPos pos) sim + 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 e = case e of @@ -98,9 +108,6 @@ moveToEntity e = case e of moveToPos :: (Int, Int) -> String 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 (EHero _ _ l _) = Just l life _ = Nothing diff --git a/haskell/vindinium/src/Simulation/Board.hs b/haskell/vindinium/src/Simulation/Board.hs index 1737340..e924148 100644 --- a/haskell/vindinium/src/Simulation/Board.hs +++ b/haskell/vindinium/src/Simulation/Board.hs @@ -1,5 +1,6 @@ module Simulation.Board ( simulate + , evalGameState ) where -- import Prelude @@ -9,7 +10,7 @@ import Control.Monad.State.Class import Data.List as L import Simulation.Data -searchDepth = 8 +searchDepth = 9 -- fromPlayerBoard :: Board -> BoardInternal -- fromPlayerBoard pBoardInternal = fmap (fmap $ fromEnum) asVector @@ -19,28 +20,27 @@ searchDepth = 8 -- 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 -> GameState -> (Int, Pos) +simulate :: Board -> GameState -> (Int, GameState) 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,_) | depth == 0 = let state' = evalMove board state - in (evalGameState state', pos) + in (evalGameState state', state') | otherwise = let state' = evalMove board state bPos = boardPos board pos -- 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. - --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' = if bPos == Tavern || bPos == Mine then prevPos else pos -- move back out of tavern/mine + -- 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 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 - where - moves :: [Pos] - moves = filter (posValid board state) $ possibleMoves pos updatePos :: Pos -> GameState -> GameState 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 -- executed every move evalMove :: Board -> GameState -> GameState -evalMove board state@(gold, life, pos, mines) = evalBuildings +evalMove board state@(gold, life, pos, mines) = evalDeath evalBuildings where evalBuildings - | entity == Air = (gold + length mines, life-1, pos, mines) - | entity == SpawnPoint = (gold + length mines, life-1, pos, mines) + | entity == Air = (gold + length mines, thirst life, pos, mines) + | entity == SpawnPoint = (gold + length mines, thirst life, pos, mines) | entity == Tavern = if gold >= 2 then ( gold + length mines - 2 @@ -62,7 +62,7 @@ evalMove board state@(gold, life, pos, mines) = evalBuildings ) else ( gold + length mines - , life - 1 + , thirst life , pos , mines ) @@ -71,25 +71,30 @@ evalMove board state@(gold, life, pos, mines) = evalBuildings mines' = if addMine then V.cons pos mines else mines in ( gold + length mines' - , life - 1 + , if addMine then thirst life - 20 else thirst life , pos , mines' ) | entity == Wall = state -- should never happen where 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 -- executed if maximum depth is reached 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 boardPos :: Board -> Pos -> BoardEntity boardPos board (x,y) = (board V.! y) V.! x 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 size = length board boardPos' = boardPos board pos diff --git a/haskell/vindinium/src/Simulation/Lib.hs b/haskell/vindinium/src/Simulation/Lib.hs new file mode 100644 index 0000000..d596dda --- /dev/null +++ b/haskell/vindinium/src/Simulation/Lib.hs @@ -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) \ No newline at end of file diff --git a/haskell/vindinium/stackproject.cabal b/haskell/vindinium/stackproject.cabal index f6c74c4..d1bc234 100644 --- a/haskell/vindinium/stackproject.cabal +++ b/haskell/vindinium/stackproject.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 817a86041a7dd560036682aca70efb443076dda509e4bb85d122ed1d611907a1 +-- hash: a40eac4da8b91ec478d65b8403d0b4c79040e0e5d0ae95d897222ea2c05cb732 name: stackproject version: 0.1.0.0 @@ -34,6 +34,7 @@ library Player Simulation.Board Simulation.Data + Simulation.Lib other-modules: Paths_stackproject hs-source-dirs: