broken state monad

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

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
+        -- 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))) $ map (\(p, be) -> p) $ 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 = 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)
+        let (val, pos) = simulate board (posFromEntity hero) (gameState hero $ fmap posFromEntity myMines)
-        hPrint stderr val
+        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' :: Ord v => Graph v -> [v] -> Graph v
-addEdge' g v = addEdge'' g v
+-- addEdge' g v = addEdge'' g v
-    where
+--     where
-        addEdge'' :: Ord v => Graph v -> [v] -> Graph v
+--         addEdge'' :: Ord v => Graph v -> [v] -> Graph v
-        addEdge'' g [a,b] = addEdge g a b
+--         addEdge'' g [a,b] = addEdge g a b
-
+-- 
-graph' = foldl addNode empty sNodes
+-- graph' = foldl addNode empty sNodes
-
+-- 
-sNodes :: [String]
+-- sNodes :: [String]
-sNodes = map (\n -> show n) nodes
+-- sNodes = map (\n -> show n) nodes
-
+-- 
-nodes = do
+-- nodes = do
-    x <- [0..9]
+--     x <- [0..9]
-    y <- [0..9]
+--     y <- [0..9]
-    return [x, y]
+--     return [x, y]
-
+-- 
-nodeConnections :: [Int] -> [[String]]
+-- 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]] ]
+-- 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]
+--     where o = show [x, y]
-nodeConnections _ = []
+-- nodeConnections _ = []

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 :: Board -> BoardInternal
-fromPlayerBoard pBoardInternal = fmap (fmap $ fromEnum) asVector
+-- fromPlayerBoard pBoardInternal = fmap (fmap $ fromEnum) asVector
-    where asVector = V.fromList $ fmap V.fromList pBoardInternal
+--     where asVector = V.fromList $ fmap V.fromList pBoardInternal
 
-emptyBoard :: BoardInternal
+emptyBoard :: Board
-emptyBoard = V.generate 9 (\_ -> V.replicate 9 air) 
+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 == Air = modify (\(gold, life, mines) -> (gold + length mines, life-1, mines))
-    | entity == SpawnPoint = modify (\(gold, life, mines) -> (gold+mines, life-1, mines))
+    | entity == SpawnPoint = modify (\(gold, life, mines) -> (gold + length 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 == 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) -> (gold+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
     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 -> Pos -> BoardEntity
-boardPos board (x,y) = fromEnum $ (board V.! x) V.! y
+boardPos board (x,y) = (board V.! x) V.! y
 
-posValid :: BoardInternal -> Pos -> Bool
+posValid :: Board -> Pos -> Bool
-posValid board pos@(x,y) = onBoardInternal && boardPos' /= wall
+posValid board pos@(x,y) = onBoardInternal && boardPos' /= Wall
     where
         boardPos' = boardPos board pos
         onBoardInternal = x >= 0 && x < size && y >= 0 && y < size

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)
+data BoardEntity = SpawnPoint | Wall | Tavern | Mine | Air deriving (Show, Eq)
-type BoardEntityEnum = Int
 
-type Board = [[BoardEntity]]
+type Board = V.Vector (V.Vector BoardEntity)
-type IndexedBoard = [(Pos, BoardEntity)]
+type IndexedBoard = V.Vector (Pos, BoardEntity)
 
-type BoardInternal = V.Vector (V.Vector BoardEntityEnum)
 type Pos = (Int, Int)
 
--- (gold, life, numMines)
+-- (gold, life, own mines)
-type GameState = (Int, Int, Int)
+type GameState = (Int, Int, V.Vector Pos)