- haskell version of vindinium

This commit is contained in:
weiss
2020-04-19 05:44:41 +02:00
parent 9c39c1c0d5
commit 7dfe85a5fd
36 changed files with 1240 additions and 76 deletions

1
code_royal/index.min.js vendored Normal file

File diff suppressed because one or more lines are too long

View File

@@ -1,54 +0,0 @@
module Graph where
import Prelude
import Data.List (List(..), drop, head, reverse, (:), fromFoldable, (\\))
import Data.Map as M
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Set as S
import Data.Tuple (Tuple(..), fst, snd)
newtype Graph v = Graph (M.Map v (List 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 Nil m
infixl 5 addNode as <+>
-- 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 :: List v -> Maybe (List v)
updateVal nodes
| g `contains` to = Just $ to : nodes
| otherwise = Just nodes
toMap :: forall v. Graph v -> M.Map v (List v)
toMap (Graph m) = m
adjacentEdges :: forall v. Ord v => Graph v -> v -> List v
adjacentEdges (Graph m) nodeId = fromMaybe Nil $ M.lookup nodeId m
contains :: forall v. Ord v => Graph v -> v -> Boolean
contains (Graph m) key = case M.lookup key m of
Just _ -> true
Nothing -> false
shortestPath :: forall v. Ord v => Graph v -> v -> v -> List v
shortestPath g@(Graph m) from to = reverse $ shortestPath' (Tuple from Nil) Nil S.empty
where
shortestPath' :: (Tuple v (List v)) -> List (Tuple v (List v)) -> S.Set v-> List v
shortestPath' from queue visited
| fst from == to = snd from
| otherwise = case head $ newQueue of
Just n -> shortestPath' n newQueue (S.insert (fst from) visited)
Nothing -> Nil
where
adjacent :: S.Set v
adjacent = S.fromFoldable $ adjacentEdges g (fst from)
newQueue :: List (Tuple v (List v))
newQueue = drop 1 queue <> ( map (\x -> Tuple x $ fst from : snd from) (fromFoldable $ S.difference adjacent visited) )

View File

@@ -3,7 +3,7 @@ module Lib where
import Prelude import Prelude
import Data.Int (fromNumber, pow, toNumber) import Data.Int (fromNumber, pow, toNumber)
import Data.Maybe (fromJust) import Data.Maybe (Maybe(..), fromJust)
import Math as M import Math as M
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Range (Area(..), Pos(..), Range(..)) import Range (Area(..), Pos(..), Range(..))
@@ -33,4 +33,14 @@ dist p1 p2 = sqrt $ a2 + b2
b2 = abs (p2.y - p1.y) `pow` 2 b2 = abs (p2.y - p1.y) `pow` 2
toPos :: forall e. { x :: Int, y :: Int | e } -> Pos toPos :: forall e. { x :: Int, y :: Int | e } -> Pos
toPos p = Pos p.x p.y toPos p = Pos p.x p.y
-- addNode :: forall k. Ord k => G.Graph k k -> k -> G.Graph k k
-- addNode g v = G.insertVertex v v g
-- infixl 5 addNode as <+>
--
-- addEdge :: forall k v. Ord k => Maybe (G.Graph k v) -> Array k -> Maybe (G.Graph k v)
-- addEdge (Just g) [a,b] = case G.insertEdge a b g of
-- Just g' -> Just g'
-- Nothing -> Just g
-- addEdge _ _ = Nothing

View File

@@ -5,36 +5,62 @@ import Prelude
import Data.Array (concatMap, (..)) import Data.Array (concatMap, (..))
import Data.Foldable (foldl) import Data.Foldable (foldl)
import Data.Int (fromNumber) import Data.Int (fromNumber)
import Data.JSDate (getTime, now) import Data.JSDate (JSDate, getTime, now)
import Data.List (List)
import Data.Map (Map, showTree) import Data.Map (Map, showTree)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Effect (Effect) import Effect (Effect)
import Effect.Console (log) import Effect.Console (log)
import Graph (Graph(..), addEdge, addNode, empty, shortestPath, toMap, (<+>)) import Graph (Graph(..), addEdge, addNode, dfs, empty, pathExists, shortestPath, shortestPathList, toMap, (<+>))
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
main :: Effect Unit main :: Effect Unit
main = do main = do
test "graph" testCreateGraph let graph = foldl addEdge' graph' $ concatMap nodeConnections nodes
let f2 = log $ show $ shortestPath graph "[1,1]" "[8,8]"
test "search" f2
--testCreateGraph :: forall v. Effect (Map v (List v))
testCreateGraph = pure $ toMap $ graph
test :: forall a. String -> Effect a -> Effect Unit
test tName fn = do
d0 <- now d0 <- now
let t0 = getTime d0 -- log $ show $ shortestPathList graph "[1,1]" "[7,7]"
_ <- fn -- log $ show $ shortestPathList graph "[1,1]" "[7,7]"
d1 <- now -- log $ show $ shortestPathList graph "[1,1]" "[7,7]"
log $ "execution time of " <> tName <> ": " <> (show $ unsafePartial $ fromJust $ fromNumber $ getTime d1 - t0) <> "ms" -- d1 <- now
-- test "list search" d0 d1
graph :: Graph String -- log ""
-- graph = foldl addEdge' graph' [ ["[1,1]", "[2,2]"], ["[3,4]", "[4,4]"], ["[2,2]", "[4,4]"] ]
graph = foldl addEdge' graph' $ concatMap nodeConnections nodes -- d2 <- now
-- log $ show $ shortestPath graph "[1,1]" "[7,7]"
-- log $ show $ shortestPath graph "[1,1]" "[7,7]"
-- log $ show $ shortestPath graph "[1,1]" "[7,7]"
-- d3 <- now
-- test "set search" d2 d3
-- log ""
-- d4 <- now
-- log $ show $ pathExists graph "[1,1]" "[7,7]"
-- log $ show $ pathExists graph "[1,1]" "[7,7]"
-- log $ show $ pathExists graph "[1,1]" "[7,7]"
-- d5 <- now
-- test "exists test" d4 d5
-- log ""
d6 <- now
log $ show $ dfs graph "[1,1]" "[1,2]"
log $ show $ dfs graph "[1,1]" "[1,2]"
log $ show $ dfs graph "[1,1]" "[1,2]"
d7 <- now
test "dfs test" d6 d7
log ""
log $ "execution time of ALL: " <> (show $ (getTime d7 - getTime d0) / 3000.0) <> "s"
test :: String -> JSDate -> JSDate -> Effect Unit
test tName d0 d1 = do
let t0 = getTime d0
let t1 = getTime d1
log $ "execution time of " <> tName <> ": " <> (show $ (t1 - t0) / 3000.0) <> "s"
addEdge' :: forall v. Ord v => Graph v -> Array v -> Graph v addEdge' :: forall v. Ord v => Graph v -> Array v -> Graph v
addEdge' g v = unsafePartial $ addEdge'' v addEdge' g v = unsafePartial $ addEdge'' v
@@ -48,8 +74,8 @@ sNodes :: Array String
sNodes = map (\n -> show n) nodes sNodes = map (\n -> show n) nodes
nodes = do nodes = do
x <- (1..360) x <- (1..9)
y <- (1..250) y <- (1..9)
pure $ [x, y] pure $ [x, y]
nodeConnections :: Array Int -> Array (Array String) nodeConnections :: Array Int -> Array (Array String)

29
graphtest/package-lock.json generated Normal file
View File

@@ -0,0 +1,29 @@
{
"name": "graphtest",
"version": "1.0.0",
"lockfileVersion": 1,
"requires": true,
"dependencies": {
"@dagrejs/graphlib": {
"version": "2.1.4",
"resolved": "https://registry.npmjs.org/@dagrejs/graphlib/-/graphlib-2.1.4.tgz",
"integrity": "sha512-QCg9sL4uhjn468FDEsb/S9hS2xUZSrv/+dApb1Ze5VKO96pTXKNJZ6MGhIpgWkc1TVhbVGH9/7rq/Mf8/jWicw==",
"requires": {
"lodash": "^4.11.1"
}
},
"graphlib": {
"version": "2.1.8",
"resolved": "https://registry.npmjs.org/graphlib/-/graphlib-2.1.8.tgz",
"integrity": "sha512-jcLLfkpoVGmH7/InMC/1hIvOPSUh38oJtGhvrOFGzioE1DZ+0YW16RgmOJhHiuWTvGiJQ9Z1Ik43JvkRPRvE+A==",
"requires": {
"lodash": "^4.17.15"
}
},
"lodash": {
"version": "4.17.15",
"resolved": "https://registry.npmjs.org/lodash/-/lodash-4.17.15.tgz",
"integrity": "sha512-8xOcRHvCjnocdS5cpwXQXVzmmh5e5+saE2QGoeQmbKmRS6J3VQppPOIt0MnmE+4xlZoumy0GPG0D0MVIQbNA1A=="
}
}
}

15
graphtest/package.json Normal file
View File

@@ -0,0 +1,15 @@
{
"name": "graphtest",
"version": "1.0.0",
"description": "",
"main": "index.js",
"scripts": {
"test": "echo \"Error: no test specified\" && exit 1"
},
"author": "",
"license": "ISC",
"dependencies": {
"@dagrejs/graphlib": "^2.1.4",
"graphlib": "^2.1.8"
}
}

96
lib/Graph.purs Normal file
View File

@@ -0,0 +1,96 @@
module Graph where
import Prelude
import Data.List (List(..), any, drop, foldl, fromFoldable, head, reverse, union, (:), (\\))
import Data.Map as M
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Set as S
import Data.Tuple (Tuple(..), fst, snd)
newtype Graph v = Graph (M.Map v (List 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 Nil m
infixl 5 addNode as <+>
-- 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 :: List v -> Maybe (List v)
updateVal nodes
| g `contains` to = Just $ to : nodes
| otherwise = Just nodes
toMap :: forall v. Graph v -> M.Map v (List v)
toMap (Graph m) = m
adjacentEdges :: forall v. Ord v => Graph v -> v -> List v
adjacentEdges (Graph m) nodeId = fromMaybe Nil $ M.lookup nodeId m
contains :: forall v. Ord v => Graph v -> v -> Boolean
contains (Graph m) key = case M.lookup key m of
Just _ -> true
Nothing -> false
shortestPath :: forall v. Ord v => Graph v -> v -> v -> List v
shortestPath g@(Graph m) from to = reverse $ shortestPath' (Tuple from Nil) Nil S.empty
where
shortestPath' :: (Tuple v (List v)) -> List (Tuple v (List v)) -> S.Set v-> List v
shortestPath' from queue visited
| fst from == to = snd from
| otherwise = case head $ newQueue of
Just n -> shortestPath' n newQueue (S.insert (fst from) visited)
Nothing -> Nil
where
adjacent :: S.Set v
adjacent = S.fromFoldable $ adjacentEdges g (fst from)
newQueue :: List (Tuple v (List v))
newQueue = drop 1 queue <> ( map (\x -> Tuple x $ fst from : snd from) (fromFoldable $ S.difference adjacent visited) )
shortestPathList :: forall v. Ord v => Graph v -> v -> v -> List v
shortestPathList g@(Graph m) from to = reverse $ shortestPath' (Tuple from Nil) Nil Nil
where
shortestPath' :: (Tuple v (List v)) -> List (Tuple v (List v)) -> List v-> List v
shortestPath' from queue visited
| fst from == to = snd from
| otherwise = case head $ newQueue of
Just n -> shortestPath' n newQueue (fst from : visited)
Nothing -> Nil
where
adjacent :: List v
adjacent = adjacentEdges g (fst from)
newQueue :: List (Tuple v (List v))
newQueue = drop 1 queue <> ( map (\x -> Tuple x $ fst from : snd from) (adjacent \\ visited) )
pathExists :: forall v. Ord v => Graph v -> v -> v -> Boolean
pathExists g@(Graph m) from to = shortestPath' from Nil Nil
where
shortestPath' :: v -> List v -> List v -> Boolean
shortestPath' from queue visited
| from == to = true
| otherwise = case head $ newQueue of
Just n -> shortestPath' n newQueue (from : visited)
Nothing -> false
where
adjacent :: List v
adjacent = adjacentEdges g from
newQueue :: List v
newQueue = drop 1 queue <> (adjacent \\ visited)
dfs :: forall v. Ord v => Graph v -> v -> v -> Boolean
dfs g@(Graph m) from to = dfs' g from to Nil
dfs' :: forall v. Ord v => Graph v -> v -> v -> List v -> Boolean
dfs' g@(Graph m) from to visited
| from == to = true
| otherwise = any ((==) true) $ subcalls (adjacent \\ visited)
where
subcalls = map (\f -> dfs' g f to visited')
visited' = union visited adjacent
adjacent = adjacentEdges g from

3
vindinium_hs/.gitignore vendored Normal file
View File

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

View File

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

30
vindinium_hs/LICENSE Normal file
View File

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

1
vindinium_hs/README.md Normal file
View File

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

2
vindinium_hs/Setup.hs Normal file
View File

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

6
vindinium_hs/app/Main.hs Normal file
View File

@@ -0,0 +1,6 @@
module Main where
import Codingame
main :: IO ()
main = bundle

View File

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

57
vindinium_hs/package.yaml Normal file
View File

@@ -0,0 +1,57 @@
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
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

View File

@@ -0,0 +1,30 @@
module BotRunner
( Bot
, escapedInputInErrorPrefix
, runBot
) where
import Control.Monad
import System.IO
-- 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 bots input be echoed on stderr to be able to replay any game result?
-> Bot -- The bot.
-> IO ()
runBot echoInput bot = do
hSetBuffering stdout NoBuffering
bot readLine writeLine
where
readLine = do
line <- getLine
when echoInput $
hPutStrLn stderr (escapedInputInErrorPrefix ++ line)
return line
writeLine = putStrLn

View File

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

21
vindinium_hs/src/Debug.hs Normal file
View File

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

99
vindinium_hs/src/Graph.hs Normal file
View File

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

137
vindinium_hs/src/Player.hs Normal file
View File

@@ -0,0 +1,137 @@
{-# LANGUAGE ScopedTypeVariables, LambdaCase, MultiWayIf #-}
module Player
( runMain
) where
import System.IO
import Control.Monad
import System.Random
import Data.Char (digitToInt)
import Data.List (minimumBy)
import BotRunner
import Graph
data BoardEntity = BSpawnPoint Int | BWall | BTavern | BMine | BEmpty deriving (Show, Eq)
type Board = [[BoardEntity]]
type IndexedBoard = [(Pos, BoardEntity)]
type Pos = (Int, Int)
-- Id, Pos, life, gold
data Entity
= Hero Int Pos Int Int
| Mine Int Pos
runMain :: IO ()
runMain = runBot True bot
bot :: Bot
bot readLine writeLine = do
-- let graph = foldl addEdge' graph' $ concatMap nodeConnections nodes
-- hPrint stderr $ shortestPathList graph "[0,0]" "[6,5]"
input_line <- getLine
let size = read input_line :: Int
board' <- replicateM size getLine
let board :: Board = map (\br -> map (\se -> if
| se == '.' -> BEmpty
| se == '#' -> BWall
| se == 'T' -> BTavern
| se == 'M' -> BMine
| otherwise -> BSpawnPoint $ digitToInt se) br) board'
input_line <- getLine
let iBoard :: IndexedBoard = concatMap (\(i_r, br) -> map (\(i_c, bc) -> ((i_c, i_r), bc)) br) $ zip [0..9] $ map (zip [0..9]) board
let myId = read input_line :: Int -- ID of your hero
-- game loop
forever $ do
input_line <- getLine
let entitycount = read input_line :: Int -- the number of entities
entities <- replicateM entitycount $ do
input_line <- getLine
let input = words input_line
let entitytype = input!!0 -- HERO or MINE
let id = read (input!!1) :: Int -- the ID of a hero or the owner of a mine
let x = read (input!!2) :: Int -- the x position of the entity
let y = read (input!!3) :: Int -- the y position of the entity
let life = read (input!!4) :: Int -- the life of a hero (-1 for mines)
let gold = read (input!!5) :: Int -- the gold of a hero (-1 for mines)
pure $ if entitytype == "HERO"
then Hero id (x,y) life gold
else Mine id (x,y)
let heroes = filter (\e -> case e of
Hero _ _ _ _ -> True
_ -> False) entities
let hero = head $ filter (\e -> case e of
Hero id _ _ _ -> id == myId
_ -> False) heroes
let mines = filter (\e -> case e of
Mine oId _ -> oId /= myId
_ -> False) entities
let minMine = minimumBy (\e1 e2 -> compare (dist (posFromEntity e1) (posFromEntity hero)) (dist (posFromEntity e2) (posFromEntity hero))) mines
let minTavernPos = minimumBy (\p1 p2 -> compare (dist p1 (posFromEntity hero)) (dist p2 (posFromEntity hero))) $ map (\(p, be) -> p) $ filter (\(p, be) -> isTavern be) iBoard
-- hPrint stderr minMine
-- WAIT | NORTH | EAST | SOUTH | WEST
r <- randomRIO (0,3) :: IO Int
let dir = if r == 0
then "NORTH"
else if r == 1
then "EAST"
else if r == 2
then "SOUTH"
else
"WEST"
putStrLn $ case life hero of
Just lp -> if lp < 30 then moveToPos minTavernPos else moveToEntity minMine
Nothing -> moveToEntity minMine
moveToEntity :: Entity -> String
moveToEntity e = case e of
Hero _ p _ _ -> cout p
Mine _ p -> cout p
where cout (x,y) = "MOVE " <> (show x) <> " " <> (show y)
moveToPos :: (Int, Int) -> String
moveToPos (x, y) = "MOVE " <> (show x) <> " " <> (show y)
dist :: Pos -> Pos -> Int
dist (x1, y1) (x2, y2) = abs (x2 - x1) + abs (y2 - y1)
life :: Entity -> Maybe Int
life (Hero _ _ l _) = Just l
life _ = Nothing
posFromEntity :: Entity -> (Int, Int)
posFromEntity (Hero _ p _ _) = p
posFromEntity (Mine _ p) = p
isTavern :: BoardEntity -> Bool
isTavern BTavern = True
isTavern _ = False
addEdge' :: Ord v => Graph v -> [v] -> Graph v
addEdge' g v = addEdge'' g v
where
addEdge'' :: Ord v => Graph v -> [v] -> Graph v
addEdge'' g [a,b] = addEdge g a b
graph' = foldl addNode empty sNodes
sNodes :: [String]
sNodes = map (\n -> show n) nodes
nodes = do
x <- [0..9]
y <- [0..9]
return [x, y]
nodeConnections :: [Int] -> [[String]]
nodeConnections [x, y] = [ [o, show [x-1,y]], [o, show [x+1,y]], [o, show [x,y-1]], [o, show [x,y+1]] ]
where o = show [x, y]
nodeConnections _ = []

68
vindinium_hs/stack.yaml Normal file
View File

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

View File

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

View File

@@ -0,0 +1,93 @@
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: 830ab1dfe911ba97d355d8cb635f3c8cb20a911f05b8cbcb68139e102b99cfd5
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
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
, random
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
, random
, stackproject
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
, random
, stackproject
default-language: Haskell2010

View File

@@ -0,0 +1,2 @@
main :: IO ()
main = putStrLn "Test suite not yet implemented"

View File

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

10
vindinium_purs/.gitignore vendored Normal file
View File

@@ -0,0 +1,10 @@
/bower_components/
/node_modules/
/.pulp-cache/
/output/
/generated-docs/
/.psc-package/
/.psc*
/.purs*
/.psa*
/.spago

28
vindinium_purs/.vscode/tasks.json vendored Normal file
View File

@@ -0,0 +1,28 @@
{
// See https://go.microsoft.com/fwlink/?LinkId=733558
// for the documentation about the tasks.json format
"version": "2.0.0",
"tasks": [
{
"label": "build_purescript",
"type": "shell",
"command": "spago bundle-app && uglifyjs index.js --mangle --output index.min.js",
"presentation": {
"echo": true,
"focus": true,
"reveal": "silent"
},
"group": {
"kind": "build",
"isDefault": true
},
"problemMatcher": []
},
{
"label": "build_purescript_old",
"type": "shell",
"command": "spago bundle-app && uglifyjs index.js --compress --mangle --output index.js",
"group": "build"
}
]
}

1
vindinium_purs/index.min.js vendored Normal file

File diff suppressed because one or more lines are too long

View File

@@ -0,0 +1,128 @@
{-
Welcome to your new Dhall package-set!
Below are instructions for how to edit this file for most use
cases, so that you don't need to know Dhall to use it.
## Warning: Don't Move This Top-Level Comment!
Due to how `dhall format` currently works, this comment's
instructions cannot appear near corresponding sections below
because `dhall format` will delete the comment. However,
it will not delete a top-level comment like this one.
## Use Cases
Most will want to do one or both of these options:
1. Override/Patch a package's dependency
2. Add a package not already in the default package set
This file will continue to work whether you use one or both options.
Instructions for each option are explained below.
### Overriding/Patching a package
Purpose:
- Change a package's dependency to a newer/older release than the
default package set's release
- Use your own modified version of some dependency that may
include new API, changed API, removed API by
using your custom git repo of the library rather than
the package set's repo
Syntax:
Replace the overrides' "{=}" (an empty record) with the following idea
The "//" or "⫽" means "merge these two records and
when they have the same value, use the one on the right:"
-------------------------------
let overrides =
{ packageName =
upstream.packageName // { updateEntity1 = "new value", updateEntity2 = "new value" }
, packageName =
upstream.packageName // { version = "v4.0.0" }
, packageName =
upstream.packageName // { repo = "https://www.example.com/path/to/new/repo.git" }
}
-------------------------------
Example:
-------------------------------
let overrides =
{ halogen =
upstream.halogen // { version = "master" }
, halogen-vdom =
upstream.halogen-vdom // { version = "v4.0.0" }
}
-------------------------------
### Additions
Purpose:
- Add packages that aren't already included in the default package set
Syntax:
Replace the additions' "{=}" (an empty record) with the following idea:
-------------------------------
let additions =
{ package-name =
{ dependencies =
[ "dependency1"
, "dependency2"
]
, repo =
"https://example.com/path/to/git/repo.git"
, version =
"tag ('v4.0.0') or branch ('master')"
}
, package-name =
{ dependencies =
[ "dependency1"
, "dependency2"
]
, repo =
"https://example.com/path/to/git/repo.git"
, version =
"tag ('v4.0.0') or branch ('master')"
}
, etc.
}
-------------------------------
Example:
-------------------------------
let additions =
{ benchotron =
{ dependencies =
[ "arrays"
, "exists"
, "profunctor"
, "strings"
, "quickcheck"
, "lcg"
, "transformers"
, "foldable-traversable"
, "exceptions"
, "node-fs"
, "node-buffer"
, "node-readline"
, "datetime"
, "now"
]
, repo =
"https://github.com/hdgarrood/purescript-benchotron.git"
, version =
"v7.0.0"
}
}
-------------------------------
-}
let upstream =
https://github.com/purescript/package-sets/releases/download/psc-0.13.6-20200404/packages.dhall sha256:f239f2e215d0cbd5c203307701748581938f74c4c78f4aeffa32c11c131ef7b6
let overrides = {=}
let additions = {=}
in upstream // overrides // additions

View File

@@ -0,0 +1,18 @@
{-
Welcome to a Spago project!
You can edit this file as you like.
-}
{ name = "vinidium"
, dependencies =
[ "arrays"
, "console"
, "effect"
, "integers"
, "js-date"
, "math"
, "ordered-collections"
, "random"
]
, packages = ./packages.dhall
, sources = [ "src/**/*.purs", "test/**/*.purs", "../lib/**/*.purs" ]
}

View File

@@ -0,0 +1,55 @@
module Main where
import Prelude
import Control.Monad.State (State, gets, modify_, runState)
import Data.Maybe (Maybe(..))
import Data.Tuple (fst, snd)
import Effect (Effect)
import Effect.Console (log, error)
import Effect.Random (randomInt)
import GameInput (parseInitInput, parseInput, GameInitInput, Board, Entity)
import Graph
type GameState =
{ boardSize :: Int
, heroId :: Int
, board :: Board
, entityCount :: Int
, entities :: Array Entity
}
main :: Effect Unit
main = do
initInput <- parseInitInput
error $ show $ initInput.board
nextRound initInput Nothing
nextRound :: GameInitInput -> Maybe GameState -> Effect Unit
nextRound initInput gameState = do
input <- parseInput
-- error $ show $ G.shortestPath "[4,4]" "[1,1]" graph
-- do we start on the left side of the map?
let gameState' =
{ boardSize: initInput.boardSize
, heroId: initInput.heroId
, board: initInput.board
, entityCount: input.entityCount
, entities: input.entities
}
rand <- randomInt 0 3
let res = runState (loop rand) gameState'
let state = snd res
let val = fst res
log $ val
nextRound initInput (Just state)
loop :: Int -> State GameState String
loop rand
| rand == 0 = pure "NORTH"
| rand == 1 = pure "EAST"
| rand == 2 = pure "SOUTH"
| otherwise = pure "WEST"

View File

@@ -0,0 +1,26 @@
module Range
( Area(..)
, Pos(..)
, Range(..)
, range
) where
import Prelude
-- data Building = Building Int Int
data Pos = Pos Int Int
data Area = Area Range Range
instance showPos :: Show Pos where
show (Pos x y) = show x <> " " <> show y
instance showRange :: Show Range where
show (Range x y) = show x <> "-" <> show y
instance showArea :: Show Area where
show (Area r1 r2) = show r1 <> " / " <> show r2
data Range = Range Int Int
range :: Int -> Int -> Range
range x y = Range (min x y) (max x y)

View File

@@ -0,0 +1,52 @@
"use strict";
exports.readline = readline
exports.parseInitInput = function() {
var size = parseInt(readline());
var board = []
for (var i = 0; i < size; i++) {
var inner = []
var line = readline();
for (var l=0; l < line.length; l++) {
inner.push(line[l])
}
board.push(inner)
}
var myId = parseInt(readline()); // ID of your hero
return {
boardSize: size,
heroId: myId,
board: board
}
};
exports.parseInput = function(numSites) {
return function() {
var entityCount = parseInt(readline()); // the number of entities
var entities = []
for (var i = 0; i < entityCount; i++) {
var inputs = readline().split(' ');
var entityType = inputs[0]; // HERO or MINE
var id = parseInt(inputs[1]); // the ID of a hero or the owner of a mine
var x = parseInt(inputs[2]); // the x position of the entity
var y = parseInt(inputs[3]); // the y position of the entity
var life = parseInt(inputs[4]); // the life of a hero (-1 for mines)
var gold = parseInt(inputs[5]); // the gold of a hero (-1 for mines)
entities.push({
entityType: entityType,
id: id,
x: x,
y: y,
life: life,
gold: gold,
})
}
return {
entityCount: entityCount,
entities: entities
}
}
};

View File

@@ -0,0 +1,34 @@
module GameInput where
import Effect (Effect)
-- TODO: Convert to proper types
data BoardElement = Spawn Int | Wall | Tavern | Mine | Empty
type Board = Array (Array String)
type GameInitInput =
{ boardSize :: Int
, heroId :: Int
, board :: Board
}
type Entity =
{ type :: String
, id :: Int
, x :: Int
, y :: Int
, life :: Int
, gold :: Int
}
type GameInput =
{ entityCount :: Int
, entities :: Array Entity
}
foreign import parseInitInput :: Effect GameInitInput
foreign import parseInput :: Effect GameInput
foreign import readline :: Effect String

View File

@@ -0,0 +1,57 @@
module Test.Main where
import Prelude
import Data.Array (concatMap, (..))
import Data.Foldable (foldl)
import Data.Int (fromNumber)
import Data.JSDate (JSDate, getTime, now)
import Data.Map (Map, showTree)
import Data.Maybe (fromJust)
import Effect (Effect)
import Effect.Console (log)
import Graph (Graph(..), addEdge, addNode, empty, pathExists, shortestPath)
import Partial.Unsafe (unsafePartial)
main :: Effect Unit
main = do
let graph = foldl addEdge' graph' $ concatMap nodeConnections nodes
d0 <- now
log $ show $ shortestPath graph "[2,2]" "[9,9]"
log $ show $ shortestPath graph "[2,2]" "[9,9]"
log $ show $ shortestPath graph "[2,2]" "[9,9]"
d1 <- now
test "exists test" d0 d1
log ""
-- log $ "execution time of ALL: " <> (show $ (getTime d7 - getTime d0) / 3000.0) <> "s"
test :: String -> JSDate -> JSDate -> Effect Unit
test tName d0 d1 = do
let t0 = getTime d0
let t1 = getTime d1
log $ "execution time of " <> tName <> ": " <> (show $ (t1 - t0) / 3.0) <> "ms"
addEdge' :: forall v. Ord v => Graph v -> Array v -> Graph v
addEdge' g v = unsafePartial $ addEdge'' v
where
addEdge'' :: Partial => Array v -> Graph v
addEdge'' [a,b] = addEdge g a b
graph' = foldl addNode empty sNodes
sNodes :: Array String
sNodes = map (\n -> show n) nodes
nodes = do
x <- (1..10)
y <- (1..10)
pure $ [x, y]
nodeConnections :: Array Int -> Array (Array String)
nodeConnections [x, y] = [ [o, show [x-1,y]], [o, show [x+1,y]], [o, show [x,y-1]], [o, show [x,y+1]] ]
where o = show [x, y]
nodeConnections _ = []

View File

@@ -0,0 +1,10 @@
{
"folders": [
{
"path": "."
},
{
"path": "..\\lib"
}
]
}