- Seq instead of Vector

- fixed bugs
- Wood 1
This commit is contained in:
weiss
2020-04-28 08:47:34 +02:00
parent 947b25d41a
commit 6710080467
6 changed files with 31 additions and 138 deletions

View File

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

View File

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

View File

@@ -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
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)
-- hPrint stderr $ minimum $ fmap (dist $ posFromEntity hero) (fmap posFromEntity eMines)
Nothing -> "WAIT"
putStrLn cmd
moveToPos :: Pos -> String

View File

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

View File

@@ -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)
type GameState = (Explorer, S.Seq Wanderer)

View File

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