code of kutulu init

haskell/code-of-kutulu/.gitignore

@@ -0,0 +1,3 @@
+.stack-work/
+*~
+/Bundled.hs

haskell/code-of-kutulu/ChangeLog.md

@@ -0,0 +1,3 @@
+# Changelog for stackproject
+
+## Unreleased changes

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.

haskell/code-of-kutulu/README.md

@@ -0,0 +1 @@
+# stackproject

haskell/code-of-kutulu/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

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) 

haskell/code-of-kutulu/credentials.json

@@ -0,0 +1,4 @@
+{
+    "email": "arne.weiss@udo.edu",
+    "password": "53gGVlg@EpNl"
+}

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 <https://github.com/githubuser/stackproject#readme>
+
+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

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

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 = "<unknown>.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
+

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

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

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

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

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)

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)

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

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

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 <https://github.com/githubuser/stackproject#readme>
+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

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) 

haskell/code-of-kutulu/workspace.code-workspace

@@ -0,0 +1,11 @@
+{
+	"folders": [
+        {
+            "path": "."
+        },
+        {
+            "path": "..\\codingame-hs"
+        }
+    ],
+    "settings": {}
+}

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

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 gs = gameState hero (fmap posFromEntity myMines) (fmap posFromEntity eMines) (fmap posFromEntity enemies)
-        let oldMines = length $ getMines gs
+        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 $ newMines - oldMines
-        hPrint stderr $ round $ 1000 * (t2 - t1)
+        -- hPrint stderr $ round $ 1000 * (t2 - t1)
+        hPrint stderr $ minimum $ fmap (dist $ posFromEntity hero) (fmap posFromEntity eMines)
         putStrLn cmd
 
-getMines :: GameState -> V.Vector Pos
+getOwnMines :: GameState -> V.Vector Pos
-getMines (_,_,_,m,_) = m
+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 :: Entity -> V.Vector Pos -> V.Vector Pos -> V.Vector Pos -> GameState
-gameState (EHero _ pos l g) mines enemies = (g, l, pos, mines, enemies)
+gameState (EHero _ pos l g) oMines eMines enemies = (g, l, pos, oMines, eMines, enemies)
-gameState (EMine _ pos) mines enemies = (-1, -1, pos, mines, enemies)
+gameState (EMine _ pos) oMines eMines enemies = (-1, -1, pos, oMines, eMines, enemies)
 
 isTavern :: BoardEntity -> Bool
 isTavern Tavern = True

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 == Air = (gold + length oMines, thirst life, pos, oMines, eMines, enemies)
-            | entity == SpawnPoint = (gold + length mines, thirst life, pos, mines, 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
+                let addMine = pos `V.notElem` oMines
-                    mines' = if addMine then V.cons pos mines else mines
+                    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')
+        evalEnemies state'@(gold', life', pos', oMines', eMines', enemies')
-            | any (<2) $ fmap (dist pos') enemies' = (gold', life' - 20, pos', mines', enemies')
+            | any (<3) $ fmap (dist pos') enemies' = (gold', life' - 20, pos', oMines', eMines', enemies')
             | otherwise = state'
-        evalDeath state'@(gold', life', pos', mines', enemies')
+        evalDeath state'@(gold', life', pos', oMines', eMines', enemies')
-            | life' < 5 = (gold', 100, (0,0), V.empty, enemies')   -- TODO: starting position is not 0,0 but spawnpoint
+            | 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

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)
+-- (gold, life, hero pos, own mines, other mines, enemies)
-type GameState = (Int, Int, Pos, V.Vector Pos, V.Vector Pos)
+type GameState = (Int, Int, Pos, V.Vector Pos, V.Vector Pos, V.Vector Pos)