- some enhancements
- started graph module
This commit is contained in:
2
code_royal/.vscode/tasks.json
vendored
2
code_royal/.vscode/tasks.json
vendored
@@ -6,7 +6,7 @@
|
||||
{
|
||||
"label": "build_purescript",
|
||||
"type": "shell",
|
||||
"command": "spago bundle-app",
|
||||
"command": "spago bundle-app && uglifyjs index.js --mangle --output index.min.js",
|
||||
"presentation": {
|
||||
"echo": true,
|
||||
"focus": true,
|
||||
|
||||
@@ -4,7 +4,14 @@ You can edit this file as you like.
|
||||
-}
|
||||
{ name = "code_royal"
|
||||
, dependencies =
|
||||
[ "arrays", "console", "effect", "integers", "js-date", "math", "random" ]
|
||||
[ "arrays"
|
||||
, "console"
|
||||
, "effect"
|
||||
, "integers"
|
||||
, "js-date"
|
||||
, "math"
|
||||
, "ordered-collections"
|
||||
]
|
||||
, packages = ./packages.dhall
|
||||
, sources = [ "src/**/*.purs", "test/**/*.purs" ]
|
||||
}
|
||||
|
||||
54
code_royal/src/Graph.purs
Normal file
54
code_royal/src/Graph.purs
Normal file
@@ -0,0 +1,54 @@
|
||||
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) )
|
||||
@@ -8,15 +8,14 @@ module Main where
|
||||
import Prelude
|
||||
|
||||
import Control.Monad.State (State, gets, modify_, runState)
|
||||
import Control.MonadZero (guard)
|
||||
import Data.Array (any, filter, foldl, head, length, reverse, sort, sortBy)
|
||||
import Data.DateTime (time)
|
||||
import Data.Foldable (sum)
|
||||
import Control.MonadZero (empty, guard)
|
||||
import Data.Array (any, concatMap, filter, foldl, head, length, sort, sortBy, (..))
|
||||
import Data.Maybe (Maybe(..), fromJust)
|
||||
import Data.Tuple (fst, snd)
|
||||
import Effect (Effect)
|
||||
import Effect.Console (error, log)
|
||||
import GameInput (Minion, Site, SiteInfo, ProtoSite, parseInitInput, parseInput)
|
||||
import Graph as G
|
||||
import Lib (dist)
|
||||
import Partial.Unsafe (unsafePartial)
|
||||
|
||||
@@ -32,12 +31,27 @@ type GameState =
|
||||
main :: Effect Unit
|
||||
main = do
|
||||
initInput <- parseInitInput
|
||||
nextRound initInput.numSites initInput.sites Nothing
|
||||
--error $ show $ concatMap nodeConnections nodes
|
||||
nextRound initInput.numSites initInput.sites Nothing G.empty
|
||||
where
|
||||
-- graph :: G.Graph String
|
||||
-- graph = unsafePartial $ fromJust $ foldl G.addNode graph' [ ["[1,1]", "[2,2]"], ["[3,4]", "[4,4]"], ["[2,2]", "[4,4]"] ]
|
||||
graph' = foldl G.addNode G.empty sNodes
|
||||
sNodes :: Array String
|
||||
sNodes = map (\n -> show n) nodes
|
||||
nodes = do
|
||||
x <- (1..4)
|
||||
y <- (1..4)
|
||||
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 _ = []
|
||||
|
||||
nextRound :: Int -> Array SiteInfo -> Maybe GameState -> Effect Unit
|
||||
nextRound numSites siteInfo gameState = do
|
||||
nextRound :: Int -> Array SiteInfo -> Maybe GameState -> G.Graph String -> Effect Unit
|
||||
nextRound numSites siteInfo gameState graph = do
|
||||
input <- parseInput numSites
|
||||
error $ show input
|
||||
-- error $ show $ G.shortestPath "[4,4]" "[1,1]" graph
|
||||
|
||||
-- do we start on the left side of the map?
|
||||
let leftSide' = case gameState of
|
||||
@@ -57,7 +71,7 @@ nextRound numSites siteInfo gameState = do
|
||||
let state = snd res
|
||||
let val = fst res
|
||||
log $ val
|
||||
nextRound state.numSites (toSiteInfo <$> state.sites) (Just state)
|
||||
nextRound state.numSites (toSiteInfo <$> state.sites) (Just state) graph
|
||||
|
||||
where
|
||||
-- combine sites with siteInfo and old state
|
||||
|
||||
@@ -5,7 +5,7 @@ exports.readline = readline
|
||||
exports.parseInitInput = function() {
|
||||
var sites = []
|
||||
var numSites = parseInt(readline());
|
||||
for (let i = 0; i < numSites; i++) {
|
||||
for (var i = 0; i < numSites; i++) {
|
||||
var inputs = readline().split(' ');
|
||||
var siteId = parseInt(inputs[0]);
|
||||
var x = parseInt(inputs[1]);
|
||||
@@ -13,13 +13,14 @@ exports.parseInitInput = function() {
|
||||
var radius = parseInt(inputs[3]);
|
||||
sites.push({
|
||||
id: siteId,
|
||||
x, y,
|
||||
radius,
|
||||
x: x,
|
||||
y: y,
|
||||
radius: radius,
|
||||
})
|
||||
}
|
||||
return {
|
||||
numSites,
|
||||
sites,
|
||||
numSites: numSites,
|
||||
sites: sites,
|
||||
}
|
||||
};
|
||||
|
||||
@@ -29,7 +30,7 @@ exports.parseInput = function(numSites) {
|
||||
var gold = parseInt(inputs[0]);
|
||||
var touchedSite = parseInt(inputs[1]); // -1 if none
|
||||
var sites = []
|
||||
for (let i = 0; i < numSites; i++) {
|
||||
for (var i = 0; i < numSites; i++) {
|
||||
var inputs = readline().split(' ');
|
||||
var siteId = parseInt(inputs[0]);
|
||||
var mineGold = parseInt(inputs[1]); // The total number of gold remaining to be mined from this site (-1 if unknown)
|
||||
@@ -41,16 +42,16 @@ exports.parseInput = function(numSites) {
|
||||
sites.push({
|
||||
id: siteId,
|
||||
gold: mineGold,
|
||||
maxMineSize,
|
||||
structureType,
|
||||
owner,
|
||||
param1,
|
||||
param2,
|
||||
maxMineSize: maxMineSize,
|
||||
structureType: structureType,
|
||||
owner: owner,
|
||||
param1: param1,
|
||||
param2: param2,
|
||||
})
|
||||
}
|
||||
var numUnits = parseInt(readline());
|
||||
var units = []
|
||||
for (let i = 0; i < numUnits; i++) {
|
||||
for (var i = 0; i < numUnits; i++) {
|
||||
var inputs = readline().split(' ');
|
||||
var x = parseInt(inputs[0]);
|
||||
var y = parseInt(inputs[1]);
|
||||
@@ -58,18 +59,19 @@ exports.parseInput = function(numSites) {
|
||||
var unitType = parseInt(inputs[3]); // -1 = QUEEN, 0 = KNIGHT, 1 = ARCHER
|
||||
var health = parseInt(inputs[4]);
|
||||
units.push({
|
||||
x, y,
|
||||
owner,
|
||||
unitType,
|
||||
health
|
||||
x: x,
|
||||
y: y,
|
||||
owner: owner,
|
||||
unitType: unitType,
|
||||
health: health
|
||||
})
|
||||
}
|
||||
|
||||
return {
|
||||
gold,
|
||||
touchedSite,
|
||||
sites,
|
||||
units,
|
||||
gold: gold,
|
||||
touchedSite: touchedSite,
|
||||
sites: sites,
|
||||
units: units
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
@@ -2,18 +2,57 @@ module Test.Main where
|
||||
|
||||
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.Map (Map, showTree)
|
||||
import Data.Maybe (fromJust)
|
||||
import Effect (Effect)
|
||||
import Effect.Console (log)
|
||||
import Graph (Graph(..), addEdge, addNode, empty, shortestPath, toMap, (<+>))
|
||||
import Partial.Unsafe (unsafePartial)
|
||||
|
||||
|
||||
main :: Effect Unit
|
||||
main = do
|
||||
let input = {
|
||||
x: 20,
|
||||
y: 20,
|
||||
width: 100,
|
||||
height: 100,
|
||||
turns: 50
|
||||
}
|
||||
-- loop input $ calcWindows input
|
||||
log "hi"
|
||||
test "graph" testCreateGraph
|
||||
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
|
||||
let t0 = getTime d0
|
||||
_ <- fn
|
||||
d1 <- now
|
||||
log $ "execution time of " <> tName <> ": " <> (show $ unsafePartial $ fromJust $ fromNumber $ getTime d1 - t0) <> "ms"
|
||||
|
||||
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
|
||||
|
||||
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..360)
|
||||
y <- (1..250)
|
||||
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 _ = []
|
||||
Reference in New Issue
Block a user