diff --git a/haskell/code-of-kutulu/app/Main.hs b/haskell/code-of-kutulu/app/Main.hs index 35fc566..45d3999 100644 --- a/haskell/code-of-kutulu/app/Main.hs +++ b/haskell/code-of-kutulu/app/Main.hs @@ -4,7 +4,7 @@ import System.Environment import Codingame import Simulation.Board import Simulation.Data -import Data.Vector as V +import qualified Data.Sequence as S main :: IO () main = do @@ -27,15 +27,12 @@ loop1 pos depth acc in loop1 sim (depth - 1) acc' sim1 :: Pos -> (Int, Pos) -sim1 pos = (\(val, (Explorer _ pos _ _, _)) -> (val, pos)) (simulate board1 (Explorer 0 (0,0) 100 2, V.empty)) +sim1 pos = (\(val, (Explorer _ pos _ _, _)) -> (val, pos)) (simulate board1 (Explorer 0 (0,0) 100 2, S.empty)) board1 :: Board -board1 = fromList $ fmap fromList +board1 = S.fromList $ fmap S.fromList [[Empty, Empty, Empty, Empty, Empty], [Empty, Empty, Empty, Empty, Empty], [Empty, Empty, Empty, Empty, Empty], [Empty, Empty, Empty, Empty, Empty], [Empty, Empty, Empty, Empty, Empty]] - -emptyBoard :: Board -emptyBoard = V.generate 5 (\_ -> V.replicate 5 Empty) diff --git a/haskell/code-of-kutulu/src/Graph.hs b/haskell/code-of-kutulu/src/Graph.hs deleted file mode 100644 index 0f47939..0000000 --- a/haskell/code-of-kutulu/src/Graph.hs +++ /dev/null @@ -1,99 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -module Graph where - -import Prelude -import qualified Data.Map as M -import qualified Data.Set as S -import Data.Maybe -import qualified Data.Sequence as Seq - -newtype Graph v = Graph (M.Map v (Seq.Seq v)) - -empty :: forall v. Graph v -empty = Graph M.empty - -addNode :: forall v. Ord v => Graph v -> v -> Graph v -addNode (Graph m) v = Graph $ M.insert v Seq.empty m - --- adds an Edge from Node "from" to Node "to" --- returns the graph unmodified if "to" does not exist -addEdge :: forall v. Ord v => Graph v -> v -> v -> Graph v -addEdge g@(Graph m) from to = Graph $ M.update updateVal from m - where - updateVal :: Seq.Seq v -> Maybe (Seq.Seq v) - updateVal nodes - | g `contains` to = Just $ to Seq.<| nodes - | otherwise = Just nodes - -toMap :: forall v. Graph v -> M.Map v (Seq.Seq v) -toMap (Graph m) = m - -adjacentEdges :: forall v. Ord v => Graph v -> v -> Seq.Seq v -adjacentEdges (Graph m) nodeId = fromMaybe Seq.empty $ M.lookup nodeId m - -contains :: forall v. Ord v => Graph v -> v -> Bool -contains (Graph m) key = case M.lookup key m of - Just _ -> True - Nothing -> False - --- shortestPath :: forall v. Ord v => Graph v -> v -> v -> Seq v --- shortestPath g@(Graph m) from to = reverse $ shortestPath' (from, Seq.empty) Seq.empty S.empty --- where --- shortestPath' :: (v, Seq v) -> [(v, Seq v)] -> S.Set v-> Seq v --- shortestPath' from queue visited --- | fst from == to = snd from --- | length newQueue == 0 = Seq.empty --- | otherwise = shortestPath' (head newQueue) newQueue (S.insert (fst from) visited) --- where --- adjacent :: S.Set v --- adjacent = S.fromList $ adjacentEdges g (fst from) --- newQueue :: [(v, Seq v)] --- newQueue = drop 1 queue <> ( map (\x -> (x, fst from : snd from)) (S.toList $ S.difference adjacent visited) ) - -shortestPathList :: forall v. Ord v => Graph v -> v -> v -> Seq.Seq v -shortestPathList g@(Graph m) from to = Seq.reverse $ shortestPath' (from, Seq.empty) Seq.empty Seq.empty - where - shortestPath' :: (v, Seq.Seq v) -> Seq.Seq (v, Seq.Seq v) -> Seq.Seq v-> Seq.Seq v - shortestPath' from queue visited - | fst from == to = snd from - | otherwise = case Seq.viewl newQueue of - n Seq.:< _ -> shortestPath' n newQueue (fst from Seq.<| visited) - Seq.EmptyL -> Seq.empty - where - adjacent :: Seq.Seq v - adjacent = adjacentEdges g (fst from) - newQueue :: Seq.Seq (v, Seq.Seq v) - newQueue = Seq.drop 1 queue <> (fmap (\x -> (x, fst from Seq.<| snd from)) (adjacent `without` visited) ) - -without :: Eq a => Seq.Seq a -> Seq.Seq a -> Seq.Seq a -without seq1 seq2 = Seq.filter (\e -> all ((/=) e) seq2) seq1 - -with :: Eq a => Seq.Seq a -> Seq.Seq a -> Seq.Seq a -with seq1 seq2 = seq1 <> (seq2 `without` seq1) - --- pathExists :: forall v. Ord v => Graph v -> v -> v -> Bool --- pathExists g@(Graph m) from to = shortestPath' from Seq.empty Seq.empty --- where --- shortestPath' :: v -> Seq v -> Seq v -> Bool --- shortestPath' from queue visited --- | from == to = True --- | otherwise = case head $ newQueue of --- Just n -> shortestPath' n newQueue (from : visited) --- Nothing -> False --- where --- adjacent :: Seq v --- adjacent = adjacentEdges g from --- newQueue :: Seq v --- newQueue = drop 1 queue <> (adjacent \\ visited) - -dfs :: forall v. Ord v => Graph v -> v -> v -> Bool -dfs g@(Graph m) from to = dfs' g from to Seq.empty - -dfs' :: forall v. Ord v => Graph v -> v -> v -> Seq.Seq v -> Bool -dfs' g@(Graph m) from to visited - | from == to = True - | otherwise = any ((==) True) $ subcalls (adjacent `without` visited) - where - subcalls = fmap (\f -> dfs' g f to visited') - visited' = with visited adjacent - adjacent = adjacentEdges g from \ No newline at end of file diff --git a/haskell/code-of-kutulu/src/Player.hs b/haskell/code-of-kutulu/src/Player.hs index 1d439bd..15ca915 100644 --- a/haskell/code-of-kutulu/src/Player.hs +++ b/haskell/code-of-kutulu/src/Player.hs @@ -7,12 +7,12 @@ module Player import System.IO import Control.Monad import System.Random +import Data.Maybe import Data.Char (digitToInt) import Data.List as L -import qualified Data.Vector as V +import qualified Data.Sequence as S import BotRunner -import Graph import Simulation.Data import Simulation.Lib import Simulation.Board @@ -27,11 +27,11 @@ bot readLine writeLine = do input_line <- getLine let height = read input_line :: Int - board' <- V.replicateM height getLine + board' <- S.replicateM height getLine let board :: Board = fmap (\br -> fmap (\se -> if | se == '.' -> Empty | se == '#' -> Wall - | otherwise -> SpawnWanderer) $ V.fromList br) board' -- TODO: $ digitToInt se) br) board' + | otherwise -> SpawnWanderer) $ S.fromList br) board' -- TODO: $ digitToInt se) br) board' input_line <- getLine let input = words input_line @@ -45,7 +45,7 @@ bot readLine writeLine = do input_line <- getLine let entitycount = read input_line :: Int -- the first given entity corresponds to your explorer - entities <- V.replicateM entitycount $ do + entities <- S.replicateM entitycount $ do input_line <- getLine let input = words input_line let entitytype = input!!0 @@ -59,16 +59,15 @@ bot readLine writeLine = do then WandererInput id (x,y) param0 param1 param2 else ExplorerInput id (x,y) param0 param1 - let explorers' = fmap (\(ExplorerInput a b c d) -> Explorer a b c d) $ V.filter isExplorer entities - let wanderers = fmap (\(WandererInput a b c d e) -> Wanderer a b c d e) $ V.filter (not . isExplorer) entities - let hero = V.head explorers' - let explorers = V.tail explorers' - - let cmd = if (all (> 6) $ fmap ((dist $ explorerPos hero) . wandererPos) wanderers) && explorerSanity hero `div` plansLeft hero < 100 - then "PLAN" - else (\(_,(Explorer _ pos _ _, w)) -> moveToPos pos) $ simulate board (hero, wanderers) - - -- hPrint stderr $ minimum $ fmap (dist $ posFromEntity hero) (fmap posFromEntity eMines) + let explorers' = fmap (\(ExplorerInput a b c d) -> Explorer a b c d) $ S.filter isExplorer entities + let wanderers = fmap (\(WandererInput a b c d e) -> Wanderer a b c d e) $ S.filter (not . isExplorer) entities + let explorers = S.drop 1 explorers' + let cmd = case S.lookup 1 explorers' of + Just hero -> + if (all (> 6) $ fmap ((dist $ explorerPos hero) . wandererPos) wanderers) && plansLeft hero > 0 && explorerSanity hero `div` plansLeft hero < 100 + then "PLAN" + else (\(_,(Explorer _ pos _ _, w)) -> moveToPos pos) $ simulate board (hero, wanderers) + Nothing -> "WAIT" putStrLn cmd moveToPos :: Pos -> String diff --git a/haskell/code-of-kutulu/src/Simulation/Board.hs b/haskell/code-of-kutulu/src/Simulation/Board.hs index 681a8b8..c9cd60e 100644 --- a/haskell/code-of-kutulu/src/Simulation/Board.hs +++ b/haskell/code-of-kutulu/src/Simulation/Board.hs @@ -4,14 +4,15 @@ module Simulation.Board ) where -- import Prelude -import qualified Data.Vector as V -import Control.Monad.State as S +import qualified Data.Sequence as S +import Control.Monad.State as State import Control.Monad.State.Class import Data.List as L +import Data.Maybe import Simulation.Data import Simulation.Lib -searchDepth = 6 +searchDepth = 11 -- TODO: Check if tailrec simulate :: Board -> GameState -> (Int, GameState) @@ -25,11 +26,11 @@ simulateMove depth board state@(hero@(Explorer ownId pos sanity plans), enemies) | otherwise = let state' = evalMove board state -- bPos = boardPos board pos - moves = V.filter (posValid board state) $ possibleMoves pos + moves = S.filter (posValid board state) $ possibleMoves pos vals = fmap (\pos' -> simulateMove (depth - 1) board (updatePos pos' state')) moves valsWithOldPos = if depth == searchDepth then vals -- return position of submove on first level - else V.zip (fmap fst vals) $ fmap (updatePos pos . snd) vals -- return starting position otherwise -- pos' + else S.zip (fmap fst vals) $ fmap (updatePos pos . snd) vals -- return starting position otherwise -- pos' in L.maximumBy (\(v1, _) (v2, _) -> compare v1 v2) valsWithOldPos updatePos :: Pos -> GameState -> GameState @@ -38,7 +39,7 @@ updatePos pos ((Explorer id _ sanity plans), enemies) = ((Explorer id pos sanity -- update State according to hero position on board -- executed every move evalMove :: Board -> GameState -> GameState -evalMove board state@(hero@(Explorer id pos sanity plans), enemies) = evalDeath $ evalEnemies $ evalEffects evalSanity +evalMove board state@(hero@(Explorer id pos sanity plans), enemies) = evalEnemies $ evalEffects evalSanity where evalSanity :: GameState evalSanity @@ -60,10 +61,6 @@ evalMove board state@(hero@(Explorer id pos sanity plans), enemies) = evalDeath | otherwise = state' where distFromWanderer = fmap (dist $ pos') (fmap wandererPos enemies') - evalDeath :: GameState -> GameState - evalDeath state'@((Explorer id' pos' sanity' plans'), enemies') - | sanity' < 1 = ((Explorer id' pos' (-999) plans'), enemies') -- TODO: starting position is not 0,0 but spawnpoint, enemy gets own mines - | otherwise = state' -- retuns the evalutaion of the current move -- executed if maximum depth is reached @@ -76,18 +73,18 @@ evalGameState ((Explorer _ pos sanity plans), enemies) = -- get BoardInternalEntity Enum of Pos on BoardInternal boardPos :: Board -> Pos -> BoardEntity -boardPos board (x,y) = (board V.! y) V.! x +boardPos board (x,y) = fromJust $ (fromJust $ board S.!? y) S.!? x posValid :: Board -> GameState -> Pos -> Bool posValid board (hero, enemies) pos@(x,y) = onBoardInternal && boardPos' /= Wall where - width = length $ V.head board + width = length $ fromJust $ S.lookup 1 board height = length board boardPos' = boardPos board pos onBoardInternal = x >= 0 && x < width && y >= 0 && y < height -possibleMoves :: Pos -> V.Vector Pos -possibleMoves (x,y) = V.fromList [ (x+1, y), (x, y+1), (x-1, y), (x, y-1) ] +possibleMoves :: Pos -> S.Seq Pos +possibleMoves (x,y) = S.fromList [ (x+1, y), (x, y+1), (x-1, y), (x, y-1) ] data Tree v = Node v (Tree v) | Leaf v \ No newline at end of file diff --git a/haskell/code-of-kutulu/src/Simulation/Data.hs b/haskell/code-of-kutulu/src/Simulation/Data.hs index 2cd8f59..ce3b1db 100644 --- a/haskell/code-of-kutulu/src/Simulation/Data.hs +++ b/haskell/code-of-kutulu/src/Simulation/Data.hs @@ -5,7 +5,7 @@ import qualified Data.Sequence as S data BoardEntity = SpawnWanderer | Wall | Empty deriving (Show, Eq) -type Board = V.Vector (V.Vector BoardEntity) +type Board = S.Seq (S.Seq BoardEntity) type Pos = (Int, Int) @@ -30,4 +30,4 @@ data Wanderer = Wanderer } -- (hero, enemies) -type GameState = (Explorer, V.Vector Wanderer) \ No newline at end of file +type GameState = (Explorer, S.Seq Wanderer) \ No newline at end of file diff --git a/haskell/code-of-kutulu/stackproject.cabal b/haskell/code-of-kutulu/stackproject.cabal index c5dd978..58fc114 100644 --- a/haskell/code-of-kutulu/stackproject.cabal +++ b/haskell/code-of-kutulu/stackproject.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 417e6c9b6226b7bcecca4ed2838a83b02bcb813752e3a15911e72c73db470c74 +-- hash: 096c830a31336278e5c3292a5054113e49f2a2cb8e27884b9eb8c5aa35f34d3e name: stackproject version: 0.1.0.0 @@ -30,7 +30,6 @@ library BotRunner Codingame Debug - Graph Player Simulation.Board Simulation.Data