- haskell version of vindinium
This commit is contained in:
1 parent
9c39c1c0d5
commit
7dfe85a5fd
36 files changed
+1240
-76
No files matched your search
Vendored
+1
@@ -0,0 +1 @@
|
||||
var PS={};(function(n){"use strict";n.arrayMap=function(e){return function(n){var t=n.length;var r=new Array(t);for(var a=0;a<t;a++){r[a]=e(n[a])}return r}}})(PS["Data.Functor"]=PS["Data.Functor"]||{});(function(n){"use strict";n["Control.Semigroupoid"]=n["Control.Semigroupoid"]||{};var t=n["Control.Semigroupoid"];var r=function(n){this.compose=n};var a=new r(function(r){return function(t){return function(n){return r(t(n))}}});var e=function(n){return n.compose};t["compose"]=e;t["semigroupoidFn"]=a})(PS);(function(n){"use strict";n["Data.Functor"]=n["Data.Functor"]||{};var t=n["Data.Functor"];var r=n["Data.Functor"];var a=n["Control.Semigroupoid"];var e=function(n){this.map=n};var u=function(n){return n.map};var i=new e(a.compose(a.semigroupoidFn));var o=new e(r.arrayMap);t["Functor"]=e;t["map"]=u;t["functorFn"]=i;t["functorArray"]=o})(PS);(function(n){"use strict";n.concatArray=function(t){return function(n){if(t.length===0)return n;if(n.length===0)return t;return t.concat(n)}}})(PS["Data.Semigroup"]=PS["Data.Semigroup"]||{});(function(n){"use strict";n["Data.Semigroup"]=n["Data.Semigroup"]||{};var t=n["Data.Semigroup"];var r=n["Data.Semigroup"];var a=function(n){this.append=n};var e=new a(r.concatArray);var u=function(n){return n.append};t["Semigroup"]=a;t["append"]=u;t["semigroupArray"]=e})(PS);(function(n){"use strict";n["Control.Alt"]=n["Control.Alt"]||{};var t=n["Control.Alt"];var r=n["Data.Functor"];var a=n["Data.Semigroup"];var e=function(n,t){this.Functor0=n;this.alt=t};var u=new e(function(){return r.functorArray},a.append(a.semigroupArray));t["altArray"]=u})(PS);(function(n){"use strict";n.arrayApply=function(c){return function(n){var t=c.length;var r=n.length;var a=new Array(t*r);var e=0;for(var u=0;u<t;u++){var i=c[u];for(var o=0;o<r;o++){a[e++]=i(n[o])}}return a}}})(PS["Control.Apply"]=PS["Control.Apply"]||{});(function(n){"use strict";n["Control.Apply"]=n["Control.Apply"]||{};var t=n["Control.Apply"];var r=n["Control.Apply"];var a=n["Data.Functor"];var e=function(n,t){this.Functor0=n;this.apply=t};var u=new e(function(){return a.functorArray},r.arrayApply);t["Apply"]=e;t["applyArray"]=u})(PS);(function(n){"use strict";n["Control.Applicative"]=n["Control.Applicative"]||{};var t=n["Control.Applicative"];var r=n["Control.Apply"];var a=function(n,t){this.Apply0=n;this.pure=t};var e=function(n){return n.pure};var u=new a(function(){return r.applyArray},function(n){return[n]});t["Applicative"]=a;t["pure"]=e;t["applicativeArray"]=u})(PS);(function(n){"use strict";n["Control.Plus"]=n["Control.Plus"]||{};var t=n["Control.Plus"];var r=n["Control.Alt"];var a=function(n,t){this.Alt0=n;this.empty=t};var e=new a(function(){return r.altArray},[]);var u=function(n){return n.empty};t["empty"]=u;t["plusArray"]=e})(PS);(function(n){"use strict";n["Control.Alternative"]=n["Control.Alternative"]||{};var t=n["Control.Alternative"];var r=n["Control.Applicative"];var a=n["Control.Plus"];var e=function(n,t){this.Applicative0=n;this.Plus1=t};var u=new e(function(){return r.applicativeArray},function(){return a.plusArray});t["alternativeArray"]=u})(PS);(function(n){"use strict";n.arrayBind=function(e){return function(n){var t=[];for(var r=0,a=e.length;r<a;r++){Array.prototype.push.apply(t,n(e[r]))}return t}}})(PS["Control.Bind"]=PS["Control.Bind"]||{});(function(n){"use strict";n["Control.Bind"]=n["Control.Bind"]||{};var t=n["Control.Bind"];var r=n["Control.Bind"];var a=n["Control.Apply"];var e=function(n){this.discard=n};var u=function(n,t){this.Apply0=n;this.bind=t};var i=function(n){return n.discard};var o=new u(function(){return a.applyArray},r.arrayBind);var c=function(n){return n.bind};var l=new e(function(n){return c(n)});t["Bind"]=u;t["bind"]=c;t["discard"]=i;t["bindArray"]=o;t["discardUnit"]=l})(PS);(function(n){"use strict";n["Control.Monad"]=n["Control.Monad"]||{};var t=n["Control.Monad"];var a=n["Control.Applicative"];var e=n["Control.Bind"];var r=function(n,t){this.Applicative0=n;this.Bind1=t};var u=new r(function(){return a.applicativeArray},function(){return e.bindArray});var i=function(r){return function(t){return function(n){return e.bind(r.Bind1())(t)(function(t){return e.bind(r.Bind1())(n)(function(n){return a.pure(r.Applicative0())(t(n))})})}}};t["Monad"]=r;t["ap"]=i;t["monadArray"]=u})(PS);(function(n){"use strict";n.boolConj=function(t){return function(n){return t&&n}};n.boolDisj=function(t){return function(n){return t||n}};n.boolNot=function(n){return!n}})(PS["Data.HeytingAlgebra"]=PS["Data.HeytingAlgebra"]||{});(function(n){"use strict";n["Data.HeytingAlgebra"]=n["Data.HeytingAlgebra"]||{};var t=n["Data.HeytingAlgebra"];var r=n["Data.HeytingAlgebra"];var e=function(n,t,r,a,e,u){this.conj=n;this.disj=t;this.ff=r;this.implies=a;this.not=e;this.tt=u};var u=function(n){return n.tt};var i=function(n){return n.not};var o=function(n){return n.implies};var c=function(n){return n.ff};var l=function(n){return n.disj};var a=new e(r.boolConj,r.boolDisj,false,function(t){return function(n){return l(a)(i(a)(Line truncated
|
||||
@@ -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 Data.Int (fromNumber, pow, toNumber)
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Maybe (Maybe(..), fromJust)
|
||||
import Math as M
|
||||
import Partial.Unsafe (unsafePartial)
|
||||
import Range (Area(..), Pos(..), Range(..))
|
||||
@@ -33,4 +33,14 @@ dist p1 p2 = sqrt $ a2 + b2
|
||||
b2 = abs (p2.y - p1.y) `pow` 2
|
||||
|
||||
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
|
||||
+46
-20
@@ -5,36 +5,62 @@ import Prelude
|
||||
import Data.Array (concatMap, (..))
|
||||
import Data.Foldable (foldl)
|
||||
import Data.Int (fromNumber)
|
||||
import Data.JSDate (getTime, now)
|
||||
import Data.List (List)
|
||||
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, shortestPath, toMap, (<+>))
|
||||
import Graph (Graph(..), addEdge, addNode, dfs, empty, pathExists, shortestPath, shortestPathList, toMap, (<+>))
|
||||
import Partial.Unsafe (unsafePartial)
|
||||
|
||||
|
||||
main :: Effect Unit
|
||||
main = do
|
||||
test "graph" testCreateGraph
|
||||
let f2 = log $ show $ shortestPath graph "[1,1]" "[8,8]"
|
||||
test "search" f2
|
||||
let graph = foldl addEdge' graph' $ concatMap nodeConnections nodes
|
||||
|
||||
--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
|
||||
let t0 = getTime d0
|
||||
_ <- fn
|
||||
d1 <- now
|
||||
log $ "execution time of " <> tName <> ": " <> (show $ unsafePartial $ fromJust $ fromNumber $ getTime d1 - t0) <> "ms"
|
||||
-- log $ show $ shortestPathList graph "[1,1]" "[7,7]"
|
||||
-- log $ show $ shortestPathList graph "[1,1]" "[7,7]"
|
||||
-- log $ show $ shortestPathList graph "[1,1]" "[7,7]"
|
||||
-- d1 <- now
|
||||
-- test "list search" d0 d1
|
||||
|
||||
graph :: Graph String
|
||||
-- graph = foldl addEdge' graph' [ ["[1,1]", "[2,2]"], ["[3,4]", "[4,4]"], ["[2,2]", "[4,4]"] ]
|
||||
graph = foldl addEdge' graph' $ concatMap nodeConnections nodes
|
||||
-- log ""
|
||||
|
||||
-- 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' g v = unsafePartial $ addEdge'' v
|
||||
@@ -48,8 +74,8 @@ sNodes :: Array String
|
||||
sNodes = map (\n -> show n) nodes
|
||||
|
||||
nodes = do
|
||||
x <- (1..360)
|
||||
y <- (1..250)
|
||||
x <- (1..9)
|
||||
y <- (1..9)
|
||||
pure $ [x, y]
|
||||
|
||||
nodeConnections :: Array Int -> Array (Array String)
|
||||
|
||||
Generated
+29
@@ -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=="
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -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"
|
||||
}
|
||||
}
|
||||
@@ -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
|
||||
@@ -0,0 +1,3 @@
|
||||
.stack-work/
|
||||
*~
|
||||
/Bundled.hs
|
||||
@@ -0,0 +1,3 @@
|
||||
# Changelog for stackproject
|
||||
|
||||
## Unreleased changes
|
||||
@@ -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.
|
||||
@@ -0,0 +1 @@
|
||||
# stackproject
|
||||
@@ -0,0 +1,2 @@
|
||||
import Distribution.Simple
|
||||
main = defaultMain
|
||||
@@ -0,0 +1,6 @@
|
||||
module Main where
|
||||
|
||||
import Codingame
|
||||
|
||||
main :: IO ()
|
||||
main = bundle
|
||||
@@ -0,0 +1,4 @@
|
||||
{
|
||||
"email": "arne.weiss@udo.edu",
|
||||
"password": "53gGVlg@EpNl"
|
||||
}
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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 _ = []
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -0,0 +1,2 @@
|
||||
main :: IO ()
|
||||
main = putStrLn "Test suite not yet implemented"
|
||||
@@ -0,0 +1,11 @@
|
||||
{
|
||||
"folders": [
|
||||
{
|
||||
"path": "."
|
||||
},
|
||||
{
|
||||
"path": "..\\codingame-hs"
|
||||
}
|
||||
],
|
||||
"settings": {}
|
||||
}
|
||||
@@ -0,0 +1,10 @@
|
||||
/bower_components/
|
||||
/node_modules/
|
||||
/.pulp-cache/
|
||||
/output/
|
||||
/generated-docs/
|
||||
/.psc-package/
|
||||
/.psc*
|
||||
/.purs*
|
||||
/.psa*
|
||||
/.spago
|
||||
Vendored
+28
@@ -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"
|
||||
}
|
||||
]
|
||||
}
|
||||
Vendored
+1
@@ -0,0 +1 @@
|
||||
var PS={};(function(t){"use strict";t["Control.Applicative"]=t["Control.Applicative"]||{};var n=t["Control.Applicative"];var r=function(t,n){this.Apply0=t;this.pure=n};var a=function(t){return t.pure};n["Applicative"]=r;n["pure"]=a})(PS);(function(t){"use strict";t["Control.Apply"]=t["Control.Apply"]||{};var n=t["Control.Apply"];var r=function(t,n){this.Functor0=t;this.apply=n};n["Apply"]=r})(PS);(function(t){"use strict";t["Control.Bind"]=t["Control.Bind"]||{};var n=t["Control.Bind"];var r=function(t,n){this.Apply0=t;this.bind=n};var a=function(t){return t.bind};n["Bind"]=r;n["bind"]=a})(PS);(function(t){"use strict";t["Control.Semigroupoid"]=t["Control.Semigroupoid"]||{};var n=t["Control.Semigroupoid"];var r=function(t){this.compose=t};var a=new r(function(r){return function(n){return function(t){return r(n(t))}}});n["semigroupoidFn"]=a})(PS);(function(t){"use strict";t["Control.Category"]=t["Control.Category"]||{};var n=t["Control.Category"];var r=t["Control.Semigroupoid"];var a=function(t,n){this.Semigroupoid0=t;this.identity=n};var o=function(t){return t.identity};var e=new a(function(){return r.semigroupoidFn},function(t){return t});n["identity"]=o;n["categoryFn"]=e})(PS);(function(t){"use strict";t["Control.Monad"]=t["Control.Monad"]||{};var n=t["Control.Monad"];var a=t["Control.Applicative"];var o=t["Control.Bind"];var r=function(t,n){this.Applicative0=t;this.Bind1=n};var e=function(r){return function(n){return function(t){return o.bind(r.Bind1())(n)(function(n){return o.bind(r.Bind1())(t)(function(t){return a.pure(r.Applicative0())(n(t))})})}}};n["Monad"]=r;n["ap"]=e})(PS);(function(t){"use strict";t["Data.Functor"]=t["Data.Functor"]||{};var n=t["Data.Functor"];var r=function(t){this.map=t};var a=function(t){return t.map};n["Functor"]=r;n["map"]=a})(PS);(function(t){"use strict";t["Data.Newtype"]=t["Data.Newtype"]||{};var n=t["Data.Newtype"];var r=function(t,n){this.unwrap=t;this.wrap=n};var a=function(t){return t.unwrap};n["unwrap"]=a;n["Newtype"]=r})(PS);(function(t){"use strict";t["Data.Identity"]=t["Data.Identity"]||{};var n=t["Data.Identity"];var r=t["Control.Applicative"];var a=t["Control.Apply"];var o=t["Control.Bind"];var e=t["Control.Monad"];var u=t["Data.Functor"];var i=t["Data.Newtype"];var c=function(t){return t};var f=new i.Newtype(function(t){return t},c);var v=new u.Functor(function(n){return function(t){return n(t)}});var s=new a.Apply(function(){return v},function(n){return function(t){return n(t)}});var l=new o.Bind(function(){return s},function(n){return function(t){return t(n)}});var p=new r.Applicative(function(){return s},c);var d=new e.Monad(function(){return p},function(){return l});n["newtypeIdentity"]=f;n["monadIdentity"]=d})(PS);(function(t){"use strict";t["Control.Monad.State"]=t["Control.Monad.State"]||{};var n=t["Control.Monad.State"];var a=t["Data.Identity"];var o=t["Data.Newtype"];var r=function(n){var r=o.unwrap(a.newtypeIdentity);return function(t){return r(n(t))}};n["runState"]=r})(PS);(function(t){"use strict";t["Data.Tuple"]=t["Data.Tuple"]||{};var n=t["Data.Tuple"];var r=function(){function r(t,n){this.value0=t;this.value1=n}r.create=function(n){return function(t){return new r(n,t)}};return r}();var a=function(t){return t.value1};var o=function(t){return t.value0};n["Tuple"]=r;n["fst"]=o;n["snd"]=a})(PS);(function(t){"use strict";t["Control.Monad.State.Trans"]=t["Control.Monad.State.Trans"]||{};var n=t["Control.Monad.State.Trans"];var a=t["Control.Applicative"];var r=t["Control.Apply"];var o=t["Control.Bind"];var e=t["Control.Monad"];var u=t["Data.Functor"];var i=t["Data.Tuple"];var c=function(a){return new u.Functor(function(r){return function(n){return function(t){return u.map(a)(function(t){return new i.Tuple(r(t.value0),t.value1)})(n(t))}}})};var f=function(t){return new e.Monad(function(){return l(t)},function(){return v(t)})};var v=function(a){return new o.Bind(function(){return s(a)},function(n){return function(r){return function(t){return o.bind(a.Bind1())(n(t))(function(t){var n=r(t.value0);return n(t.value1)})}}})};var s=function(t){return new r.Apply(function(){return c(t.Bind1().Apply0().Functor0())},e.ap(f(t)))};var l=function(r){return new a.Applicative(function(){return s(r)},function(n){return function(t){return a.pure(r.Applicative0())(new i.Tuple(n,t))}})};n["applicativeStateT"]=l})(PS);(function(t){"use strict";t["Data.Boolean"]=t["Data.Boolean"]||{};var n=t["Data.Boolean"];var r=true;n["otherwise"]=r})(PS);(function(t){"use strict";t.topInt=2147483647;t.bottomInt=-2147483648})(PS["Data.Bounded"]=PS["Data.Bounded"]||{});(function(t){"use strict";var n=function(o){return function(a){return function(r){return function(n){return function(t){return n<t?o:n===t?a:r}}}}};t.ordIntImpl=n})(PS["Data.Ord"]=PS["Data.Ord"]||{});(function(t){"use strict";var n=function(n){return function(t){return n===t}};t.eqIntImpl=n})(PS["Data.Eq"]=PS["Data.Eq"]||{});(function(t){"use strict";t["Data.Eq"]=t["Data.Eq"]||{};var n=t["Data.Eq"];var r=t["Data.Eq"];var a=fuLine truncated
|
||||
@@ -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
|
||||
@@ -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" ]
|
||||
}
|
||||
@@ -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"
|
||||
@@ -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)
|
||||
@@ -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
|
||||
}
|
||||
}
|
||||
};
|
||||
@@ -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
|
||||
@@ -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 _ = []
|
||||
@@ -0,0 +1,10 @@
|
||||
{
|
||||
"folders": [
|
||||
{
|
||||
"path": "."
|
||||
},
|
||||
{
|
||||
"path": "..\\lib"
|
||||
}
|
||||
]
|
||||
}
|
||||
Reference in new issue
Block a user