diff --git a/code_royal/.vscode/tasks.json b/code_royal/.vscode/tasks.json index 800ccc9..3c90899 100644 --- a/code_royal/.vscode/tasks.json +++ b/code_royal/.vscode/tasks.json @@ -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, diff --git a/code_royal/spago.dhall b/code_royal/spago.dhall index 39d7b45..22fe3a1 100644 --- a/code_royal/spago.dhall +++ b/code_royal/spago.dhall @@ -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" ] } diff --git a/code_royal/src/Graph.purs b/code_royal/src/Graph.purs new file mode 100644 index 0000000..cf7b323 --- /dev/null +++ b/code_royal/src/Graph.purs @@ -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) ) \ No newline at end of file diff --git a/code_royal/src/Main.purs b/code_royal/src/Main.purs index fb0f8df..1ef4e50 100644 --- a/code_royal/src/Main.purs +++ b/code_royal/src/Main.purs @@ -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 diff --git a/code_royal/src/ffi/GameInput.js b/code_royal/src/ffi/GameInput.js index 162b028..d3f4b6c 100644 --- a/code_royal/src/ffi/GameInput.js +++ b/code_royal/src/ffi/GameInput.js @@ -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 } } }; diff --git a/code_royal/test/Main.purs b/code_royal/test/Main.purs index 2074377..a117744 100644 --- a/code_royal/test/Main.purs +++ b/code_royal/test/Main.purs @@ -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" \ No newline at end of file + 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 _ = [] \ No newline at end of file