From afc2af5cdb356d292d219be82dfc57e7eebd427a Mon Sep 17 00:00:00 2001 From: weiss Date: Wed, 22 Apr 2020 15:35:03 +0200 Subject: [PATCH] broken state monad --- haskell/vindinium/src/Codingame.hs | 2 +- haskell/vindinium/src/Player.hs | 71 ++++++++++++----------- haskell/vindinium/src/Simulation/Board.hs | 59 ++++++++++--------- haskell/vindinium/src/Simulation/Data.hs | 13 ++--- 4 files changed, 76 insertions(+), 69 deletions(-) diff --git a/haskell/vindinium/src/Codingame.hs b/haskell/vindinium/src/Codingame.hs index fa5f18e..f662832 100644 --- a/haskell/vindinium/src/Codingame.hs +++ b/haskell/vindinium/src/Codingame.hs @@ -29,7 +29,7 @@ bundle = do source <- createMonolithicSourceWithMode parseMode sourcePath credentials <- readCredentials "credentials.json" - putStrLn source + -- putStrLn source let file = "Bundled.hs" writeFile file $ "{-# LANGUAGE ScopedTypeVariables, LambdaCase, MultiWayIf #-}\n" ++ source diff --git a/haskell/vindinium/src/Player.hs b/haskell/vindinium/src/Player.hs index 4b5bb52..525fc2c 100644 --- a/haskell/vindinium/src/Player.hs +++ b/haskell/vindinium/src/Player.hs @@ -9,6 +9,7 @@ import Control.Monad import System.Random import Data.Char (digitToInt) import Data.List as L +import qualified Data.Vector as V import BotRunner import Graph @@ -32,15 +33,15 @@ bot readLine writeLine = do input_line <- getLine let size = read input_line :: Int - board' <- replicateM size getLine + board' <- V.replicateM size getLine let board :: Board = fmap (\br -> fmap (\se -> if | se == '.' -> Air | se == '#' -> Wall | se == 'T' -> Tavern | se == 'M' -> Mine - | otherwise -> SpawnPoint) br) board' -- TODO: $ digitToInt se) br) board' + | 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) $ zip [0..9] $ map (zip [0..9]) board + -- 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 myId = read input_line :: Int -- ID of your hero @@ -49,7 +50,7 @@ bot readLine writeLine = do input_line <- getLine let entitycount = read input_line :: Int -- the number of entities - entities <- replicateM entitycount $ do + entities <- V.replicateM entitycount $ do input_line <- getLine let input = words input_line let entitytype = input!!0 -- HERO or MINE @@ -62,24 +63,24 @@ bot readLine writeLine = do then EHero id (x,y) life gold else EMine id (x,y) - let heroes = filter (\e -> case e of + let heroes = V.filter (\e -> case e of EHero _ _ _ _ -> True _ -> False) entities - let hero = head $ filter (\e -> case e of + let hero = V.head $ V.filter (\e -> case e of EHero id _ _ _ -> id == myId _ -> False) heroes - let mines = 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))) $ map (\(p, be) -> p) $ 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 = filter (\e -> case e of + let myMines = V.filter (\e -> case e of EMine oId _ -> oId == myId _ -> False) entities - let (val, pos) = simulate board (posFromEntity hero) (gameState hero $ length myMines) - hPrint stderr val + let (val, pos) = simulate board (posFromEntity hero) (gameState hero $ fmap posFromEntity myMines) + hPrint stderr (val, pos) putStrLn $ moveToPos pos -- putStrLn $ case life hero of @@ -106,7 +107,7 @@ posFromEntity :: Entity -> (Int, Int) posFromEntity (EHero _ p _ _) = p posFromEntity (EMine _ p) = p -gameState :: Entity -> Int -> (Int, Int, Int) +gameState :: Entity -> V.Vector Pos -> GameState gameState (EHero _ _ l g) mines = (g, l, mines) gameState (EMine _ _) mines = (-1, -1, mines) @@ -114,23 +115,23 @@ isTavern :: BoardEntity -> Bool isTavern Tavern = True isTavern _ = False -addEdge' :: Ord v => Graph v -> [v] -> Graph v -addEdge' g v = addEdge'' g v - where - addEdge'' :: Ord v => Graph v -> [v] -> Graph v - addEdge'' g [a,b] = addEdge g a b - -graph' = foldl addNode empty sNodes - -sNodes :: [String] -sNodes = map (\n -> show n) nodes - -nodes = do - x <- [0..9] - y <- [0..9] - return [x, y] - -nodeConnections :: [Int] -> [[String]] -nodeConnections [x, y] = [ [o, show [x-1,y]], [o, show [x+1,y]], [o, show [x,y-1]], [o, show [x,y+1]] ] - where o = show [x, y] -nodeConnections _ = [] \ No newline at end of file +-- addEdge' :: Ord v => Graph v -> [v] -> Graph v +-- addEdge' g v = addEdge'' g v +-- where +-- addEdge'' :: Ord v => Graph v -> [v] -> Graph v +-- addEdge'' g [a,b] = addEdge g a b +-- +-- graph' = foldl addNode empty sNodes +-- +-- sNodes :: [String] +-- sNodes = map (\n -> show n) nodes +-- +-- nodes = do +-- x <- [0..9] +-- y <- [0..9] +-- return [x, y] +-- +-- nodeConnections :: [Int] -> [[String]] +-- nodeConnections [x, y] = [ [o, show [x-1,y]], [o, show [x+1,y]], [o, show [x,y-1]], [o, show [x,y+1]] ] +-- where o = show [x, y] +-- nodeConnections _ = [] \ No newline at end of file diff --git a/haskell/vindinium/src/Simulation/Board.hs b/haskell/vindinium/src/Simulation/Board.hs index ff57843..1b607f2 100644 --- a/haskell/vindinium/src/Simulation/Board.hs +++ b/haskell/vindinium/src/Simulation/Board.hs @@ -9,21 +9,15 @@ import Control.Monad.State.Class import Data.List as L import Simulation.Data -spawnPoint = fromEnum SpawnPoint -wall = fromEnum Wall -tavern = fromEnum Tavern -mine = fromEnum Mine -air = fromEnum Air - size = 10 -- TODO: Allow for variable board sizes -searchDepth = 6 +searchDepth = 5 -fromPlayerBoard :: Board -> BoardInternal -fromPlayerBoard pBoardInternal = fmap (fmap $ fromEnum) asVector - where asVector = V.fromList $ fmap V.fromList pBoardInternal +-- fromPlayerBoard :: Board -> BoardInternal +-- fromPlayerBoard pBoardInternal = fmap (fmap $ fromEnum) asVector +-- where asVector = V.fromList $ fmap V.fromList pBoardInternal -emptyBoard :: BoardInternal -emptyBoard = V.generate 9 (\_ -> V.replicate 9 air) +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 @@ -31,9 +25,9 @@ emptyBoard = V.generate 9 (\_ -> V.replicate 9 air) -- TODO: Check if tailrec simulate :: Board -> Pos -> GameState -> (Int, Pos) simulate board pos = evalState sim - where sim = simulateMove (fromPlayerBoard board) pos searchDepth (-1,-1) + where sim = simulateMove board pos searchDepth (-1,-1) -simulateMove :: BoardInternal -> Pos -> Int -> Pos -> State GameState (Int, Pos) +simulateMove :: Board -> Pos -> Int -> Pos -> State GameState (Int, Pos) simulateMove board pos depth prevPos | depth == 0 = do evalMove board pos @@ -42,26 +36,39 @@ simulateMove board pos depth prevPos | 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 + 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 - pure $ L.maximumBy (\(v1, _) (v2, _) -> compare v1 v2) vals + let 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) where moves :: [Pos] moves = filter (posValid board) $ possibleMoves pos -- update State according to hero position on board -- executed every move -evalMove :: BoardInternal -> Pos -> State GameState () +evalMove :: Board -> Pos -> State GameState () evalMove board pos - | entity == Air = modify (\(gold, life, mines) -> (gold+mines, life-1, mines)) - | entity == SpawnPoint = modify (\(gold, life, mines) -> (gold+mines, life-1, mines)) - | entity == Tavern = modify ( \(gold, life, mines) -> (gold+mines-2, min 100 (life+50), mines) ) -- TODO: Check if life is +19 - | entity == Mine = modify (\(gold, life, mines) -> (gold+mines, life-1, mines)) + | 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 + | 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 where - entity = toEnum $ boardPos board pos + entity = boardPos board pos -- retuns the evalutaion of the current move -- executed if maximum depth is reached @@ -71,11 +78,11 @@ evalGameState = do pure gold -- get BoardInternalEntity Enum of Pos on BoardInternal -boardPos :: BoardInternal -> Pos -> BoardEntityEnum -boardPos board (x,y) = fromEnum $ (board V.! x) V.! y +boardPos :: Board -> Pos -> BoardEntity +boardPos board (x,y) = (board V.! x) V.! y -posValid :: BoardInternal -> Pos -> Bool -posValid board pos@(x,y) = onBoardInternal && boardPos' /= wall +posValid :: Board -> Pos -> Bool +posValid board pos@(x,y) = onBoardInternal && boardPos' /= Wall where boardPos' = boardPos board pos onBoardInternal = x >= 0 && x < size && y >= 0 && y < size diff --git a/haskell/vindinium/src/Simulation/Data.hs b/haskell/vindinium/src/Simulation/Data.hs index 4168724..0986847 100644 --- a/haskell/vindinium/src/Simulation/Data.hs +++ b/haskell/vindinium/src/Simulation/Data.hs @@ -1,15 +1,14 @@ module Simulation.Data where import qualified Data.Vector as V +import qualified Data.Sequence as S -data BoardEntity = SpawnPoint | Wall | Tavern | Mine | Air deriving (Show, Eq, Enum) -type BoardEntityEnum = Int +data BoardEntity = SpawnPoint | Wall | Tavern | Mine | Air deriving (Show, Eq) -type Board = [[BoardEntity]] -type IndexedBoard = [(Pos, BoardEntity)] +type Board = V.Vector (V.Vector BoardEntity) +type IndexedBoard = V.Vector (Pos, BoardEntity) -type BoardInternal = V.Vector (V.Vector BoardEntityEnum) type Pos = (Int, Int) --- (gold, life, numMines) -type GameState = (Int, Int, Int) +-- (gold, life, own mines) +type GameState = (Int, Int, V.Vector Pos)