arne/codingame
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

broken state monad

Browse Source
This commit is contained in:
weiss
2020-04-22 15:35:03 +02:00
parent fbe7b56be0
commit afc2af5cdb
4 changed files with 76 additions and 69 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
haskell/vindinium/src/Codingame.hs
View File

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

71
haskell/vindinium/src/Player.hs
View File

@@ -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 _ = []
-- 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 _ = []

59
haskell/vindinium/src/Simulation/Board.hs
View File

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

13
haskell/vindinium/src/Simulation/Data.hs
View File

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