- Seq instead of Vector
- fixed bugs - Wood 1
This commit is contained in:
@@ -4,7 +4,7 @@ import System.Environment
|
|||||||
import Codingame
|
import Codingame
|
||||||
import Simulation.Board
|
import Simulation.Board
|
||||||
import Simulation.Data
|
import Simulation.Data
|
||||||
import Data.Vector as V
|
import qualified Data.Sequence as S
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
@@ -27,15 +27,12 @@ loop1 pos depth acc
|
|||||||
in loop1 sim (depth - 1) acc'
|
in loop1 sim (depth - 1) acc'
|
||||||
|
|
||||||
sim1 :: Pos -> (Int, Pos)
|
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 :: 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],
|
[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)
|
|
||||||
|
|||||||
@@ -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
|
|
||||||
@@ -7,12 +7,12 @@ module Player
|
|||||||
import System.IO
|
import System.IO
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import System.Random
|
import System.Random
|
||||||
|
import Data.Maybe
|
||||||
import Data.Char (digitToInt)
|
import Data.Char (digitToInt)
|
||||||
import Data.List as L
|
import Data.List as L
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Sequence as S
|
||||||
|
|
||||||
import BotRunner
|
import BotRunner
|
||||||
import Graph
|
|
||||||
import Simulation.Data
|
import Simulation.Data
|
||||||
import Simulation.Lib
|
import Simulation.Lib
|
||||||
import Simulation.Board
|
import Simulation.Board
|
||||||
@@ -27,11 +27,11 @@ bot readLine writeLine = do
|
|||||||
input_line <- getLine
|
input_line <- getLine
|
||||||
let height = read input_line :: Int
|
let height = read input_line :: Int
|
||||||
|
|
||||||
board' <- V.replicateM height getLine
|
board' <- S.replicateM height getLine
|
||||||
let board :: Board = fmap (\br -> fmap (\se -> if
|
let board :: Board = fmap (\br -> fmap (\se -> if
|
||||||
| se == '.' -> Empty
|
| se == '.' -> Empty
|
||||||
| se == '#' -> Wall
|
| 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
|
input_line <- getLine
|
||||||
let input = words input_line
|
let input = words input_line
|
||||||
@@ -45,7 +45,7 @@ bot readLine writeLine = do
|
|||||||
input_line <- getLine
|
input_line <- getLine
|
||||||
let entitycount = read input_line :: Int -- the first given entity corresponds to your explorer
|
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
|
input_line <- getLine
|
||||||
let input = words input_line
|
let input = words input_line
|
||||||
let entitytype = input!!0
|
let entitytype = input!!0
|
||||||
@@ -59,16 +59,15 @@ bot readLine writeLine = do
|
|||||||
then WandererInput id (x,y) param0 param1 param2
|
then WandererInput id (x,y) param0 param1 param2
|
||||||
else ExplorerInput id (x,y) param0 param1
|
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 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) $ V.filter (not . isExplorer) entities
|
let wanderers = fmap (\(WandererInput a b c d e) -> Wanderer a b c d e) $ S.filter (not . isExplorer) entities
|
||||||
let hero = V.head explorers'
|
let explorers = S.drop 1 explorers'
|
||||||
let explorers = V.tail explorers'
|
let cmd = case S.lookup 1 explorers' of
|
||||||
|
Just hero ->
|
||||||
let cmd = if (all (> 6) $ fmap ((dist $ explorerPos hero) . wandererPos) wanderers) && explorerSanity hero `div` plansLeft hero < 100
|
if (all (> 6) $ fmap ((dist $ explorerPos hero) . wandererPos) wanderers) && plansLeft hero > 0 && explorerSanity hero `div` plansLeft hero < 100
|
||||||
then "PLAN"
|
then "PLAN"
|
||||||
else (\(_,(Explorer _ pos _ _, w)) -> moveToPos pos) $ simulate board (hero, wanderers)
|
else (\(_,(Explorer _ pos _ _, w)) -> moveToPos pos) $ simulate board (hero, wanderers)
|
||||||
|
Nothing -> "WAIT"
|
||||||
-- hPrint stderr $ minimum $ fmap (dist $ posFromEntity hero) (fmap posFromEntity eMines)
|
|
||||||
putStrLn cmd
|
putStrLn cmd
|
||||||
|
|
||||||
moveToPos :: Pos -> String
|
moveToPos :: Pos -> String
|
||||||
|
|||||||
@@ -4,14 +4,15 @@ module Simulation.Board
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
-- import Prelude
|
-- import Prelude
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Sequence as S
|
||||||
import Control.Monad.State as S
|
import Control.Monad.State as State
|
||||||
import Control.Monad.State.Class
|
import Control.Monad.State.Class
|
||||||
import Data.List as L
|
import Data.List as L
|
||||||
|
import Data.Maybe
|
||||||
import Simulation.Data
|
import Simulation.Data
|
||||||
import Simulation.Lib
|
import Simulation.Lib
|
||||||
|
|
||||||
searchDepth = 6
|
searchDepth = 11
|
||||||
|
|
||||||
-- TODO: Check if tailrec
|
-- TODO: Check if tailrec
|
||||||
simulate :: Board -> GameState -> (Int, GameState)
|
simulate :: Board -> GameState -> (Int, GameState)
|
||||||
@@ -25,11 +26,11 @@ simulateMove depth board state@(hero@(Explorer ownId pos sanity plans), enemies)
|
|||||||
| otherwise =
|
| otherwise =
|
||||||
let state' = evalMove board state
|
let state' = evalMove board state
|
||||||
-- bPos = boardPos board pos
|
-- 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
|
vals = fmap (\pos' -> simulateMove (depth - 1) board (updatePos pos' state')) moves
|
||||||
valsWithOldPos = if depth == searchDepth
|
valsWithOldPos = if depth == searchDepth
|
||||||
then vals -- return position of submove on first level
|
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
|
in L.maximumBy (\(v1, _) (v2, _) -> compare v1 v2) valsWithOldPos
|
||||||
|
|
||||||
updatePos :: Pos -> GameState -> GameState
|
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
|
-- update State according to hero position on board
|
||||||
-- executed every move
|
-- executed every move
|
||||||
evalMove :: Board -> GameState -> GameState
|
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
|
where
|
||||||
evalSanity :: GameState
|
evalSanity :: GameState
|
||||||
evalSanity
|
evalSanity
|
||||||
@@ -60,10 +61,6 @@ evalMove board state@(hero@(Explorer id pos sanity plans), enemies) = evalDeath
|
|||||||
| otherwise = state'
|
| otherwise = state'
|
||||||
where
|
where
|
||||||
distFromWanderer = fmap (dist $ pos') (fmap wandererPos enemies')
|
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
|
-- retuns the evalutaion of the current move
|
||||||
-- executed if maximum depth is reached
|
-- executed if maximum depth is reached
|
||||||
@@ -76,18 +73,18 @@ evalGameState ((Explorer _ pos sanity plans), enemies) =
|
|||||||
|
|
||||||
-- get BoardInternalEntity Enum of Pos on BoardInternal
|
-- get BoardInternalEntity Enum of Pos on BoardInternal
|
||||||
boardPos :: Board -> Pos -> BoardEntity
|
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 -> GameState -> Pos -> Bool
|
||||||
posValid board (hero, enemies) pos@(x,y) = onBoardInternal && boardPos' /= Wall
|
posValid board (hero, enemies) pos@(x,y) = onBoardInternal && boardPos' /= Wall
|
||||||
where
|
where
|
||||||
width = length $ V.head board
|
width = length $ fromJust $ S.lookup 1 board
|
||||||
height = length board
|
height = length board
|
||||||
boardPos' = boardPos board pos
|
boardPos' = boardPos board pos
|
||||||
onBoardInternal = x >= 0 && x < width && y >= 0 && y < height
|
onBoardInternal = x >= 0 && x < width && y >= 0 && y < height
|
||||||
|
|
||||||
possibleMoves :: Pos -> V.Vector Pos
|
possibleMoves :: Pos -> S.Seq Pos
|
||||||
possibleMoves (x,y) = V.fromList [ (x+1, y), (x, y+1), (x-1, y), (x, y-1) ]
|
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
|
data Tree v = Node v (Tree v) | Leaf v
|
||||||
@@ -5,7 +5,7 @@ import qualified Data.Sequence as S
|
|||||||
|
|
||||||
data BoardEntity = SpawnWanderer | Wall | Empty deriving (Show, Eq)
|
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)
|
type Pos = (Int, Int)
|
||||||
|
|
||||||
@@ -30,4 +30,4 @@ data Wanderer = Wanderer
|
|||||||
}
|
}
|
||||||
|
|
||||||
-- (hero, enemies)
|
-- (hero, enemies)
|
||||||
type GameState = (Explorer, V.Vector Wanderer)
|
type GameState = (Explorer, S.Seq Wanderer)
|
||||||
@@ -4,7 +4,7 @@ cabal-version: 1.12
|
|||||||
--
|
--
|
||||||
-- see: https://github.com/sol/hpack
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: 417e6c9b6226b7bcecca4ed2838a83b02bcb813752e3a15911e72c73db470c74
|
-- hash: 096c830a31336278e5c3292a5054113e49f2a2cb8e27884b9eb8c5aa35f34d3e
|
||||||
|
|
||||||
name: stackproject
|
name: stackproject
|
||||||
version: 0.1.0.0
|
version: 0.1.0.0
|
||||||
@@ -30,7 +30,6 @@ library
|
|||||||
BotRunner
|
BotRunner
|
||||||
Codingame
|
Codingame
|
||||||
Debug
|
Debug
|
||||||
Graph
|
|
||||||
Player
|
Player
|
||||||
Simulation.Board
|
Simulation.Board
|
||||||
Simulation.Data
|
Simulation.Data
|
||||||
|
|||||||
Reference in New Issue
Block a user