- haskell version of vindinium
This commit is contained in:
1
code_royal/index.min.js
vendored
Normal file
1
code_royal/index.min.js
vendored
Normal file
File diff suppressed because one or more lines are too long
@@ -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) )
|
|
||||||
@@ -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
|
||||||
@@ -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
29
graphtest/package-lock.json
generated
Normal 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
15
graphtest/package.json
Normal 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
96
lib/Graph.purs
Normal 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
3
vindinium_hs/.gitignore
vendored
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
.stack-work/
|
||||||
|
*~
|
||||||
|
/Bundled.hs
|
||||||
3
vindinium_hs/ChangeLog.md
Normal file
3
vindinium_hs/ChangeLog.md
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
# Changelog for stackproject
|
||||||
|
|
||||||
|
## Unreleased changes
|
||||||
30
vindinium_hs/LICENSE
Normal file
30
vindinium_hs/LICENSE
Normal 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
1
vindinium_hs/README.md
Normal file
@@ -0,0 +1 @@
|
|||||||
|
# stackproject
|
||||||
2
vindinium_hs/Setup.hs
Normal file
2
vindinium_hs/Setup.hs
Normal file
@@ -0,0 +1,2 @@
|
|||||||
|
import Distribution.Simple
|
||||||
|
main = defaultMain
|
||||||
6
vindinium_hs/app/Main.hs
Normal file
6
vindinium_hs/app/Main.hs
Normal file
@@ -0,0 +1,6 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import Codingame
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = bundle
|
||||||
4
vindinium_hs/credentials.json
Normal file
4
vindinium_hs/credentials.json
Normal file
@@ -0,0 +1,4 @@
|
|||||||
|
{
|
||||||
|
"email": "arne.weiss@udo.edu",
|
||||||
|
"password": "53gGVlg@EpNl"
|
||||||
|
}
|
||||||
57
vindinium_hs/package.yaml
Normal file
57
vindinium_hs/package.yaml
Normal 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
|
||||||
30
vindinium_hs/src/BotRunner.hs
Normal file
30
vindinium_hs/src/BotRunner.hs
Normal 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 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
|
||||||
|
bot readLine writeLine
|
||||||
|
where
|
||||||
|
readLine = do
|
||||||
|
line <- getLine
|
||||||
|
when echoInput $
|
||||||
|
hPutStrLn stderr (escapedInputInErrorPrefix ++ line)
|
||||||
|
return line
|
||||||
|
writeLine = putStrLn
|
||||||
36
vindinium_hs/src/Codingame.hs
Normal file
36
vindinium_hs/src/Codingame.hs
Normal 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
21
vindinium_hs/src/Debug.hs
Normal 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
99
vindinium_hs/src/Graph.hs
Normal 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
137
vindinium_hs/src/Player.hs
Normal 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
68
vindinium_hs/stack.yaml
Normal 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
|
||||||
19
vindinium_hs/stack.yaml.lock
Normal file
19
vindinium_hs/stack.yaml.lock
Normal 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
|
||||||
93
vindinium_hs/stackproject.cabal
Normal file
93
vindinium_hs/stackproject.cabal
Normal 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
|
||||||
2
vindinium_hs/test/Spec.hs
Normal file
2
vindinium_hs/test/Spec.hs
Normal file
@@ -0,0 +1,2 @@
|
|||||||
|
main :: IO ()
|
||||||
|
main = putStrLn "Test suite not yet implemented"
|
||||||
11
vindinium_hs/workspace.code-workspace
Normal file
11
vindinium_hs/workspace.code-workspace
Normal file
@@ -0,0 +1,11 @@
|
|||||||
|
{
|
||||||
|
"folders": [
|
||||||
|
{
|
||||||
|
"path": "."
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"path": "..\\codingame-hs"
|
||||||
|
}
|
||||||
|
],
|
||||||
|
"settings": {}
|
||||||
|
}
|
||||||
10
vindinium_purs/.gitignore
vendored
Normal file
10
vindinium_purs/.gitignore
vendored
Normal 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
28
vindinium_purs/.vscode/tasks.json
vendored
Normal 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
1
vindinium_purs/index.min.js
vendored
Normal file
File diff suppressed because one or more lines are too long
128
vindinium_purs/packages.dhall
Normal file
128
vindinium_purs/packages.dhall
Normal 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
|
||||||
18
vindinium_purs/spago.dhall
Normal file
18
vindinium_purs/spago.dhall
Normal 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" ]
|
||||||
|
}
|
||||||
55
vindinium_purs/src/Main.purs
Normal file
55
vindinium_purs/src/Main.purs
Normal 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"
|
||||||
26
vindinium_purs/src/Ruler.purs
Normal file
26
vindinium_purs/src/Ruler.purs
Normal 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)
|
||||||
52
vindinium_purs/src/ffi/GameInput.js
Normal file
52
vindinium_purs/src/ffi/GameInput.js
Normal 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
|
||||||
|
}
|
||||||
|
}
|
||||||
|
};
|
||||||
34
vindinium_purs/src/ffi/GameInput.purs
Normal file
34
vindinium_purs/src/ffi/GameInput.purs
Normal 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
|
||||||
57
vindinium_purs/test/Main.purs
Normal file
57
vindinium_purs/test/Main.purs
Normal 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 _ = []
|
||||||
10
vindinium_purs/workspace.code-workspace
Normal file
10
vindinium_purs/workspace.code-workspace
Normal file
@@ -0,0 +1,10 @@
|
|||||||
|
{
|
||||||
|
"folders": [
|
||||||
|
{
|
||||||
|
"path": "."
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"path": "..\\lib"
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
Reference in New Issue
Block a user