diff --git a/haskell/code-of-kutulu/.gitignore b/haskell/code-of-kutulu/.gitignore new file mode 100644 index 0000000..41182cb --- /dev/null +++ b/haskell/code-of-kutulu/.gitignore @@ -0,0 +1,3 @@ +.stack-work/ +*~ +/Bundled.hs diff --git a/haskell/code-of-kutulu/ChangeLog.md b/haskell/code-of-kutulu/ChangeLog.md new file mode 100644 index 0000000..c25eb4d --- /dev/null +++ b/haskell/code-of-kutulu/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for stackproject + +## Unreleased changes diff --git a/haskell/code-of-kutulu/LICENSE b/haskell/code-of-kutulu/LICENSE new file mode 100644 index 0000000..e637cde --- /dev/null +++ b/haskell/code-of-kutulu/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2020 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/haskell/code-of-kutulu/README.md b/haskell/code-of-kutulu/README.md new file mode 100644 index 0000000..01c7163 --- /dev/null +++ b/haskell/code-of-kutulu/README.md @@ -0,0 +1 @@ +# stackproject diff --git a/haskell/code-of-kutulu/Setup.hs b/haskell/code-of-kutulu/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/haskell/code-of-kutulu/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/haskell/code-of-kutulu/app/Main.hs b/haskell/code-of-kutulu/app/Main.hs new file mode 100644 index 0000000..35fc566 --- /dev/null +++ b/haskell/code-of-kutulu/app/Main.hs @@ -0,0 +1,41 @@ +module Main where + +import System.Environment +import Codingame +import Simulation.Board +import Simulation.Data +import Data.Vector as V + +main :: IO () +main = do + bundle + print $ sim1 (2,4) + --test + +test :: IO () +test = do + args <- getArgs + let simDepth = if Prelude.length args > 0 then read $ Prelude.head args :: Int else 3 + print $ Prelude.reverse $ loop1 (0,0) simDepth [] + +loop1 :: Pos -> Int -> [Pos] -> [Pos] +loop1 pos depth acc + | depth == 0 = acc + | otherwise = + let sim = snd $ sim1 pos + acc' = sim : 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)) + +board1 :: Board +board1 = fromList $ fmap 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/credentials.json b/haskell/code-of-kutulu/credentials.json new file mode 100644 index 0000000..b9ca7f4 --- /dev/null +++ b/haskell/code-of-kutulu/credentials.json @@ -0,0 +1,4 @@ +{ + "email": "arne.weiss@udo.edu", + "password": "53gGVlg@EpNl" +} \ No newline at end of file diff --git a/haskell/code-of-kutulu/package.yaml b/haskell/code-of-kutulu/package.yaml new file mode 100644 index 0000000..4392b34 --- /dev/null +++ b/haskell/code-of-kutulu/package.yaml @@ -0,0 +1,60 @@ +name: stackproject +version: 0.1.0.0 +github: "githubuser/stackproject" +license: BSD3 +author: "Author name here" +maintainer: "example@example.com" +copyright: "2020 Author name here" + +extra-source-files: +- README.md +- ChangeLog.md + +# Metadata used when publishing your package +# synopsis: Short description of your package +# category: Web + +# To avoid duplicated efforts in documentation and dealing with the +# complications of embedding Haddock markup inside cabal files, it is +# common to point users to the README.md file. +description: Please see the README on GitHub at + +dependencies: +- base >= 4.7 && < 5 +- aeson +- attoparsec +- bytestring +- codingame-hs +- directory +- filepath +- random +- containers >=0.5 && <0.7 +- haskell-src-exts +- vector +- mtl +- time + +library: + source-dirs: src + +executables: + stackproject-exe: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - stackproject + +tests: + stackproject-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - stackproject diff --git a/haskell/code-of-kutulu/src/BotRunner.hs b/haskell/code-of-kutulu/src/BotRunner.hs new file mode 100644 index 0000000..4a3a355 --- /dev/null +++ b/haskell/code-of-kutulu/src/BotRunner.hs @@ -0,0 +1,34 @@ +module BotRunner + ( Bot + , escapedInputInErrorPrefix + , runBot + ) where + +import Control.Monad +import System.IO +import Data.Time.Clock.POSIX + +-- A Codingame bot where input and output have been abstracted out. +type Bot = IO String -> (String -> IO ()) -> IO () + +escapedInputInErrorPrefix :: String +escapedInputInErrorPrefix = "#" + +-- Run a bot in the Codingame Arena (or IDE). +runBot + :: Bool -- Shall the bot’s input be echoed on stderr to be able to replay any game result? + -> Bot -- The bot. + -> IO () +runBot echoInput bot = do + hSetBuffering stdout NoBuffering + t1 <- getPOSIXTime + bot readLine writeLine + t2 <- getPOSIXTime + hPrint stderr $ t2 - t1 + where + readLine = do + line <- getLine + when echoInput $ + hPutStrLn stderr (escapedInputInErrorPrefix ++ line) + return line + writeLine = putStrLn \ No newline at end of file diff --git a/haskell/code-of-kutulu/src/Codingame.hs b/haskell/code-of-kutulu/src/Codingame.hs new file mode 100644 index 0000000..f662832 --- /dev/null +++ b/haskell/code-of-kutulu/src/Codingame.hs @@ -0,0 +1,36 @@ +module Codingame + ( bundle + ) where + +import Codingame.WebServices +import Codingame.SourcePackager +import Language.Haskell.Exts + +import BotRunner +import Player +import Debug + + +sourcePath = "src/Player.hs" + +parseMode :: ParseMode +parseMode = ParseMode { + parseFilename = ".hs", + baseLanguage = Haskell2010, + extensions = [EnableExtension ScopedTypeVariables, EnableExtension LambdaCase, EnableExtension MultiWayIf], + ignoreLanguagePragmas = False, + ignoreLinePragmas = True, + fixities = Just preludeFixities, + ignoreFunctionArity = False + } + +bundle :: IO () +bundle = do + source <- createMonolithicSourceWithMode parseMode sourcePath + credentials <- readCredentials "credentials.json" + + -- putStrLn source + + let file = "Bundled.hs" + writeFile file $ "{-# LANGUAGE ScopedTypeVariables, LambdaCase, MultiWayIf #-}\n" ++ source + diff --git a/haskell/code-of-kutulu/src/Debug.hs b/haskell/code-of-kutulu/src/Debug.hs new file mode 100644 index 0000000..475bcca --- /dev/null +++ b/haskell/code-of-kutulu/src/Debug.hs @@ -0,0 +1,21 @@ +module Debug + ( trace + , _trace + , traceList + ,_traceList + ) where + +import Data.List +import qualified Debug.Trace as Trace + +trace :: Show a => String -> a -> a +trace message x = Trace.trace (message ++ " = " ++ show x) x + +_trace :: String -> a -> a +_trace _ = id + +traceList :: Show a => String -> [a] -> [a] +traceList message xs = Trace.trace (message ++ " = [\n\t" ++ intercalate "\n\t" (map show xs) ++ "\n]") xs + +_traceList :: Show a => String -> [a] -> [a] +_traceList _ = id \ No newline at end of file diff --git a/haskell/code-of-kutulu/src/Graph.hs b/haskell/code-of-kutulu/src/Graph.hs new file mode 100644 index 0000000..0f47939 --- /dev/null +++ b/haskell/code-of-kutulu/src/Graph.hs @@ -0,0 +1,99 @@ +{-# 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 new file mode 100644 index 0000000..1d439bd --- /dev/null +++ b/haskell/code-of-kutulu/src/Player.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE ScopedTypeVariables, LambdaCase, MultiWayIf #-} +module Player + ( runMain + , Board + ) where + +import System.IO +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 +import Simulation.Data +import Simulation.Lib +import Simulation.Board + +runMain :: IO () +runMain = runBot True bot + +bot :: Bot +bot readLine writeLine = do + input_line <- getLine + let width = read input_line :: Int + input_line <- getLine + let height = read input_line :: Int + + board' <- V.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' + + input_line <- getLine + let input = words input_line + let sanitylosslonely = read (input!!0) :: Int -- how much sanity you lose every turn when alone, always 3 until wood 1 + let sanitylossgroup = read (input!!1) :: Int -- how much sanity you lose every turn when near another player, always 1 until wood 1 + let wandererspawntime = read (input!!2) :: Int -- how many turns the wanderer take to spawn, always 3 until wood 1 + let wandererlifetime = read (input!!3) :: Int -- how many turns the wanderer is on map after spawning, always 40 until wood 1 + + -- game loop + forever $ do + input_line <- getLine + let entitycount = read input_line :: Int -- the first given entity corresponds to your explorer + + entities <- V.replicateM entitycount $ do + input_line <- getLine + let input = words input_line + let entitytype = input!!0 + let id = read (input!!1) :: Int + let x = read (input!!2) :: Int + let y = read (input!!3) :: Int + let param0 = read (input!!4) :: Int + let param1 = read (input!!5) :: Int + let param2 = read (input!!6) :: Int + pure $ if entitytype == "WANDERER" + 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) + putStrLn cmd + +moveToPos :: Pos -> String +moveToPos (x, y) = "MOVE " <> (show x) <> " " <> (show y) + +isExplorer :: EntityInput -> Bool +isExplorer e@(ExplorerInput _ _ _ _) = True +isExplorer _ = False \ No newline at end of file diff --git a/haskell/code-of-kutulu/src/Simulation/Board.hs b/haskell/code-of-kutulu/src/Simulation/Board.hs new file mode 100644 index 0000000..681a8b8 --- /dev/null +++ b/haskell/code-of-kutulu/src/Simulation/Board.hs @@ -0,0 +1,93 @@ +module Simulation.Board + ( simulate + , evalGameState + ) where + +-- import Prelude +import qualified Data.Vector as V +import Control.Monad.State as S +import Control.Monad.State.Class +import Data.List as L +import Simulation.Data +import Simulation.Lib + +searchDepth = 6 + +-- TODO: Check if tailrec +simulate :: Board -> GameState -> (Int, GameState) +simulate = simulateMove searchDepth + +simulateMove :: Int -> Board -> GameState -> (Int, GameState) +simulateMove depth board state@(hero@(Explorer ownId pos sanity plans), enemies) + | depth == 0 = + let state' = evalMove board state + in (evalGameState state', state') + | otherwise = + let state' = evalMove board state + -- bPos = boardPos board pos + moves = V.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' + in L.maximumBy (\(v1, _) (v2, _) -> compare v1 v2) valsWithOldPos + +updatePos :: Pos -> GameState -> GameState +updatePos pos ((Explorer id _ sanity plans), enemies) = ((Explorer id pos sanity plans), enemies) + +-- 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 + where + evalSanity :: GameState + evalSanity + | any (< 3) $ fmap (dist pos) (fmap wandererPos enemies) = (Explorer id pos (sanity - 1) plans, enemies) + | otherwise = (Explorer id pos (sanity - 3) plans, enemies) + evalEffects :: GameState -> GameState + evalEffects state'@(hero'@(Explorer id' pos' sanity' plans'), enemies') + | entity == Empty = (hero', enemies') + | entity == SpawnWanderer = (hero', enemies') + | entity == Wall = state -- should never happen + where + entity = boardPos board pos' + -- TODO: Gegner verliert auch Leben + evalEnemies :: GameState -> GameState + evalEnemies state'@((Explorer id' pos' sanity' plans'), enemies') + | any (< 2) distFromWanderer = (Explorer id' pos' (sanity' - 20) plans', enemies') + | any (< 3) distFromWanderer = (Explorer id' pos' (sanity' - 10) plans', enemies') + | any (< 4) distFromWanderer = (Explorer id' pos' (sanity' - 5) plans', enemies') + | 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 +evalGameState :: GameState -> Int +evalGameState ((Explorer _ pos sanity plans), enemies) = + sanity + -- enemyDist + -- where + -- minMineDist = minimum $ fmap (dist hero) eMines + +-- get BoardInternalEntity Enum of Pos on BoardInternal +boardPos :: Board -> Pos -> BoardEntity +boardPos board (x,y) = (board V.! y) V.! x + +posValid :: Board -> GameState -> Pos -> Bool +posValid board (hero, enemies) pos@(x,y) = onBoardInternal && boardPos' /= Wall + where + width = length $ V.head 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) ] + + +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 new file mode 100644 index 0000000..2cd8f59 --- /dev/null +++ b/haskell/code-of-kutulu/src/Simulation/Data.hs @@ -0,0 +1,33 @@ +module Simulation.Data where + +import qualified Data.Vector as V +import qualified Data.Sequence as S + +data BoardEntity = SpawnWanderer | Wall | Empty deriving (Show, Eq) + +type Board = V.Vector (V.Vector BoardEntity) + +type Pos = (Int, Int) + +data EntityInput + = ExplorerInput Int Pos Int Int + | WandererInput Int Pos Int Int Int + deriving (Show) + +data Explorer = Explorer + { explorerId :: Int + , explorerPos :: Pos + , explorerSanity :: Int + , plansLeft :: Int + } + +data Wanderer = Wanderer + { wandererId :: Int + , wandererPos :: Pos + , wandererRecallTime :: Int -- time before recall + , wandererStatus :: Int -- 0: spawning ; 1=wandering + , wandererTarget :: Int + } + +-- (hero, enemies) +type GameState = (Explorer, V.Vector Wanderer) \ No newline at end of file diff --git a/haskell/code-of-kutulu/src/Simulation/Lib.hs b/haskell/code-of-kutulu/src/Simulation/Lib.hs new file mode 100644 index 0000000..d596dda --- /dev/null +++ b/haskell/code-of-kutulu/src/Simulation/Lib.hs @@ -0,0 +1,6 @@ +module Simulation.Lib where + +import Simulation.Data + +dist :: Pos -> Pos -> Int +dist (x1, y1) (x2, y2) = abs (x2 - x1) + abs (y2 - y1) \ No newline at end of file diff --git a/haskell/code-of-kutulu/stack.yaml b/haskell/code-of-kutulu/stack.yaml new file mode 100644 index 0000000..582aa91 --- /dev/null +++ b/haskell/code-of-kutulu/stack.yaml @@ -0,0 +1,68 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: lts-15.8 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# subdirs: +# - auto-update +# - wai +packages: +- . +- ../codingame-hs +# Dependency packages to be pulled from upstream that are not in the resolver. +# These entries can reference officially published versions as well as +# forks / in-progress versions pinned to a git hash. For example: +# +# extra-deps: +# - acme-missiles-0.3 +# - git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# +extra-deps: +- 'hpp-0.6.2' + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=2.1" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/haskell/code-of-kutulu/stack.yaml.lock b/haskell/code-of-kutulu/stack.yaml.lock new file mode 100644 index 0000000..f0d2841 --- /dev/null +++ b/haskell/code-of-kutulu/stack.yaml.lock @@ -0,0 +1,19 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: hpp-0.6.2@sha256:aa75b0471c0a8f68ccf823da37ea88b4187829972dc951651805a3722293a001,1969 + pantry-tree: + size: 1357 + sha256: c85fba4149618ab38a1eb2d369d46d78a58a2729cfcf9be93ff36936e6b9ffe5 + original: + hackage: hpp-0.6.2 +snapshots: +- completed: + size: 492015 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/8.yaml + sha256: 926bc3d70249dd0ba05277ff00943c0addb35b627cb641752669e7cf771310d0 + original: lts-15.8 diff --git a/haskell/code-of-kutulu/stackproject.cabal b/haskell/code-of-kutulu/stackproject.cabal new file mode 100644 index 0000000..c5dd978 --- /dev/null +++ b/haskell/code-of-kutulu/stackproject.cabal @@ -0,0 +1,105 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 417e6c9b6226b7bcecca4ed2838a83b02bcb813752e3a15911e72c73db470c74 + +name: stackproject +version: 0.1.0.0 +description: Please see the README on GitHub at +homepage: https://github.com/githubuser/stackproject#readme +bug-reports: https://github.com/githubuser/stackproject/issues +author: Author name here +maintainer: example@example.com +copyright: 2020 Author name here +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + +source-repository head + type: git + location: https://github.com/githubuser/stackproject + +library + exposed-modules: + BotRunner + Codingame + Debug + Graph + Player + Simulation.Board + Simulation.Data + Simulation.Lib + other-modules: + Paths_stackproject + hs-source-dirs: + src + build-depends: + aeson + , attoparsec + , base >=4.7 && <5 + , bytestring + , codingame-hs + , containers >=0.5 && <0.7 + , directory + , filepath + , haskell-src-exts + , mtl + , random + , time + , vector + default-language: Haskell2010 + +executable stackproject-exe + main-is: Main.hs + other-modules: + Paths_stackproject + hs-source-dirs: + app + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + aeson + , attoparsec + , base >=4.7 && <5 + , bytestring + , codingame-hs + , containers >=0.5 && <0.7 + , directory + , filepath + , haskell-src-exts + , mtl + , random + , stackproject + , time + , vector + default-language: Haskell2010 + +test-suite stackproject-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_stackproject + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + aeson + , attoparsec + , base >=4.7 && <5 + , bytestring + , codingame-hs + , containers >=0.5 && <0.7 + , directory + , filepath + , haskell-src-exts + , mtl + , random + , stackproject + , time + , vector + default-language: Haskell2010 diff --git a/haskell/code-of-kutulu/test/Spec.hs b/haskell/code-of-kutulu/test/Spec.hs new file mode 100644 index 0000000..1acef72 --- /dev/null +++ b/haskell/code-of-kutulu/test/Spec.hs @@ -0,0 +1,8 @@ +import Simulation.Board +import Simulation.Data + +main :: IO () +main = putStrLn "Test suite not yet implemented" + +emptyBoard :: Board +emptyBoard = V.generate 9 (\_ -> V.replicate 9 Air) diff --git a/haskell/code-of-kutulu/workspace.code-workspace b/haskell/code-of-kutulu/workspace.code-workspace new file mode 100644 index 0000000..c339064 --- /dev/null +++ b/haskell/code-of-kutulu/workspace.code-workspace @@ -0,0 +1,11 @@ +{ + "folders": [ + { + "path": "." + }, + { + "path": "..\\codingame-hs" + } + ], + "settings": {} +} \ No newline at end of file diff --git a/haskell/vindinium/app/Main.hs b/haskell/vindinium/app/Main.hs index d669ed3..726cea3 100644 --- a/haskell/vindinium/app/Main.hs +++ b/haskell/vindinium/app/Main.hs @@ -27,7 +27,7 @@ loop1 pos depth acc in loop1 sim (depth - 1) acc' sim1 :: Pos -> (Int, Pos) -sim1 pos = (\(val, (_,_, pos, _,_)) -> (val, pos)) (simulate board1 (0, 100, pos, singleton (0,4), empty)) +sim1 pos = (\(val, (_,_, pos, _,_,_)) -> (val, pos)) (simulate board1 (0, 100, pos, singleton (0,4), singleton (3,4), empty)) board1 :: Board board1 = fromList $ fmap fromList diff --git a/haskell/vindinium/src/Player.hs b/haskell/vindinium/src/Player.hs index 0329360..9cfbddc 100644 --- a/haskell/vindinium/src/Player.hs +++ b/haskell/vindinium/src/Player.hs @@ -76,22 +76,22 @@ bot readLine writeLine = do let enemies = V.filter (\e -> case e of EHero id _ _ _ -> id /= myId _ -> False) heroes - let mines = V.filter (\e -> case e of + let eMines = 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 minEMine = L.minimumBy (\e1 e2 -> compare (dist (posFromEntity e1) (posFromEntity hero)) (dist (posFromEntity e2) (posFromEntity hero))) eMines 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 = V.filter (\e -> case e of EMine oId _ -> oId == myId _ -> False) entities - let gs = gameState hero (fmap posFromEntity myMines) (fmap posFromEntity enemies) - let oldMines = length $ getMines gs + let gs = gameState hero (fmap posFromEntity myMines) (fmap posFromEntity eMines) (fmap posFromEntity enemies) + let oldMines = length $ getOwnMines gs let sim = simulate board gs - let newMines = length $ getMines $ snd sim + let newMines = length $ getOwnMines $ snd sim - let cmd = (\(_,(_,_,pos,_,_)) -> moveToPos pos) sim + let cmd = (\(_,(_,_,pos,_,_,_)) -> moveToPos pos) sim -- let cmd = if newMines - oldMines > 0 -- then (\(_,(_,_,pos,_,_)) -> moveToPos pos) sim @@ -100,12 +100,13 @@ bot readLine writeLine = do -- Nothing -> moveToEntity minEMine t2 <- getPOSIXTime - hPrint stderr $ newMines - oldMines - hPrint stderr $ round $ 1000 * (t2 - t1) + -- hPrint stderr $ newMines - oldMines + -- hPrint stderr $ round $ 1000 * (t2 - t1) + hPrint stderr $ minimum $ fmap (dist $ posFromEntity hero) (fmap posFromEntity eMines) putStrLn cmd -getMines :: GameState -> V.Vector Pos -getMines (_,_,_,m,_) = m +getOwnMines :: GameState -> V.Vector Pos +getOwnMines (_,_,_,m,_,_) = m moveToEntity :: Entity -> String moveToEntity e = case e of @@ -124,9 +125,9 @@ posFromEntity :: Entity -> (Int, Int) posFromEntity (EHero _ p _ _) = p posFromEntity (EMine _ p) = p -gameState :: Entity -> V.Vector Pos -> V.Vector Pos -> GameState -gameState (EHero _ pos l g) mines enemies = (g, l, pos, mines, enemies) -gameState (EMine _ pos) mines enemies = (-1, -1, pos, mines, enemies) +gameState :: Entity -> V.Vector Pos -> V.Vector Pos -> V.Vector Pos -> GameState +gameState (EHero _ pos l g) oMines eMines enemies = (g, l, pos, oMines, eMines, enemies) +gameState (EMine _ pos) oMines eMines enemies = (-1, -1, pos, oMines, eMines, enemies) isTavern :: BoardEntity -> Bool isTavern Tavern = True diff --git a/haskell/vindinium/src/Simulation/Board.hs b/haskell/vindinium/src/Simulation/Board.hs index 0cbfa92..f0d3d6d 100644 --- a/haskell/vindinium/src/Simulation/Board.hs +++ b/haskell/vindinium/src/Simulation/Board.hs @@ -25,7 +25,7 @@ simulate :: Board -> GameState -> (Int, GameState) simulate board = simulateMove board (-1,-1) searchDepth simulateMove :: Board -> Pos -> Int -> GameState -> (Int, GameState) -simulateMove board prevPos depth state@(_,_,pos,_,_) +simulateMove board prevPos depth state@(_,_,pos,_,_,_) | depth == 0 = let state' = evalMove board state in (evalGameState state', state') @@ -43,39 +43,42 @@ simulateMove board prevPos depth state@(_,_,pos,_,_) in L.maximumBy (\(v1, _) (v2, _) -> compare v1 v2) valsWithOldPos updatePos :: Pos -> GameState -> GameState -updatePos pos (gold, life, _, mines, enemies) = (gold, life, pos, mines, enemies) +updatePos pos (gold, life, _, oMines, eMines, enemies) = (gold, life, pos, oMines, eMines, enemies) -- update State according to hero position on board -- executed every move evalMove :: Board -> GameState -> GameState -evalMove board state@(gold, life, pos, mines, enemies) = evalDeath $ evalEnemies evalBuildings +evalMove board state@(gold, life, pos, oMines, eMines, enemies) = evalDeath $ evalEnemies evalBuildings where evalBuildings - | entity == Air = (gold + length mines, thirst life, pos, mines, enemies) - | entity == SpawnPoint = (gold + length mines, thirst life, pos, mines, enemies) + | entity == Air = (gold + length oMines, thirst life, pos, oMines, eMines, enemies) + | entity == SpawnPoint = (gold + length oMines, thirst life, pos, oMines, eMines, enemies) | entity == Tavern = if gold >= 2 then - ( gold + length mines - 2 + ( gold + length oMines - 2 , min 100 (life + 50) -- TODO: Check if life is +19 , pos - , mines + , oMines + , eMines , enemies ) else - ( gold + length mines + ( gold + length oMines , thirst life , pos - , mines + , oMines + , eMines , enemies ) | entity == Mine = - let addMine = pos `V.notElem` mines - mines' = if addMine then V.cons pos mines else mines + let addMine = pos `V.notElem` oMines + oMines' = if addMine then V.cons pos oMines else oMines in - ( gold + length mines' + ( gold + length oMines' , if addMine then thirst life - 20 else thirst life , pos - , mines' + , oMines' + , eMines , enemies ) | entity == Wall = state -- should never happen @@ -83,11 +86,11 @@ evalMove board state@(gold, life, pos, mines, enemies) = evalDeath $ evalEnemies entity = boardPos board pos -- TODO: Gegner verliert auch Leben evalEnemies :: GameState -> GameState - evalEnemies state'@(gold', life', pos', mines', enemies') - | any (<2) $ fmap (dist pos') enemies' = (gold', life' - 20, pos', mines', enemies') + evalEnemies state'@(gold', life', pos', oMines', eMines', enemies') + | any (<3) $ fmap (dist pos') enemies' = (gold', life' - 20, pos', oMines', eMines', enemies') | otherwise = state' - evalDeath state'@(gold', life', pos', mines', enemies') - | life' < 5 = (gold', 100, (0,0), V.empty, enemies') -- TODO: starting position is not 0,0 but spawnpoint + evalDeath state'@(gold', life', pos', oMines', eMines', enemies') + | life' < 5 = (gold', 100, (0,0), V.empty, eMines', enemies') -- TODO: starting position is not 0,0 but spawnpoint, enemy gets own mines | otherwise = state' thirst life = max 1 (life - 1) @@ -95,14 +98,20 @@ thirst life = max 1 (life - 1) -- retuns the evalutaion of the current move -- executed if maximum depth is reached evalGameState :: GameState -> Int -evalGameState (gold, life, _, mines, _) = gold + (life `div` 10) + length mines * 2 -- TODO: Warum macht nur mines quatsch? +evalGameState (gold, life, hero, oMines, eMines, _) = -- TODO: Warum macht nur mines quatsch? + gold + + (life `div` 10) + + length oMines + - minMineDist + where + minMineDist = minimum $ fmap (dist hero) eMines -- get BoardInternalEntity Enum of Pos on BoardInternal boardPos :: Board -> Pos -> BoardEntity boardPos board (x,y) = (board V.! y) V.! x posValid :: Board -> GameState -> Pos -> Bool -posValid board (_, _, _, mines, _) pos@(x,y) = onBoardInternal && boardPos' /= Wall && pos `notElem` mines +posValid board (_,_,_,mines,_,_) pos@(x,y) = onBoardInternal && boardPos' /= Wall && pos `notElem` mines where size = length board boardPos' = boardPos board pos diff --git a/haskell/vindinium/src/Simulation/Data.hs b/haskell/vindinium/src/Simulation/Data.hs index 88bf716..4222299 100644 --- a/haskell/vindinium/src/Simulation/Data.hs +++ b/haskell/vindinium/src/Simulation/Data.hs @@ -10,5 +10,5 @@ type IndexedBoard = V.Vector (Pos, BoardEntity) type Pos = (Int, Int) --- (gold, life, hero pos, own mines, enemies) -type GameState = (Int, Int, Pos, V.Vector Pos, V.Vector Pos) +-- (gold, life, hero pos, own mines, other mines, enemies) +type GameState = (Int, Int, Pos, V.Vector Pos, V.Vector Pos, V.Vector Pos)