From 42d4e5479746c555539a9246799dcd108176b04f Mon Sep 17 00:00:00 2001 From: Karl Ostmo Date: Sat, 27 Jan 2024 17:02:08 -0800 Subject: [PATCH] volume command (#1747) Measures the volume of an enclosed space. A useful alternative to the `path` command for goal checking. ## Demo scripts/play.sh -i data/scenarios/Testing/1747-volume-command.yaml --autoplay --speed 2 --- data/scenarios/Testing/00-ORDER.txt | 3 +- .../Testing/1747-volume-command.yaml | 56 +++++++++ editors/emacs/swarm-mode.el | 1 + editors/vim/swarm.vim | 2 +- editors/vscode/syntaxes/swarm.tmLanguage.json | 2 +- src/swarm-engine/Swarm/Game/Step/Const.hs | 19 +++ src/swarm-engine/Swarm/Game/Step/Flood.hs | 110 ++++++++++++++++++ src/swarm-lang/Swarm/Language/Capability.hs | 3 + src/swarm-lang/Swarm/Language/Syntax.hs | 27 +++++ src/swarm-lang/Swarm/Language/Typecheck.hs | 1 + swarm.cabal | 2 + test/integration/Main.hs | 1 + 12 files changed, 224 insertions(+), 3 deletions(-) create mode 100644 data/scenarios/Testing/1747-volume-command.yaml create mode 100644 src/swarm-engine/Swarm/Game/Step/Flood.hs diff --git a/data/scenarios/Testing/00-ORDER.txt b/data/scenarios/Testing/00-ORDER.txt index 7a2df9a25..d7d06b4b6 100644 --- a/data/scenarios/Testing/00-ORDER.txt +++ b/data/scenarios/Testing/00-ORDER.txt @@ -53,4 +53,5 @@ Achievements 1575-structure-recognizer 1631-tags.yaml 1634-message-colors.yaml -1681-pushable-entity.yaml \ No newline at end of file +1681-pushable-entity.yaml +1747-volume-command.yaml diff --git a/data/scenarios/Testing/1747-volume-command.yaml b/data/scenarios/Testing/1747-volume-command.yaml new file mode 100644 index 000000000..22e5c5d4a --- /dev/null +++ b/data/scenarios/Testing/1747-volume-command.yaml @@ -0,0 +1,56 @@ +version: 1 +name: Demo volume command +description: | + Measure volume of enclosed space +creative: true +objectives: + - goal: + - | + Make an enclosed volume of 14 cells + condition: | + as base { + let targetVolume = 14 in + vol <- volume targetVolume; + return $case vol (\_. false) (\x. x == targetVolume); + } +solution: | + move; + push; + turn left; + move; + turn right; + move; + turn right; + push; +robots: + - name: base + dir: east + devices: + - ADT calculator + - treads + - dozer blade + - logger + - branch predictor + - comparator +entities: + - name: monolith + display: + char: '@' + description: + - Pushable rock + properties: [known, unwalkable, pickable] +known: [mountain] +world: + dsl: | + {grass} + palette: + 'B': [grass, null, base] + '.': [grass] + 'A': [stone, mountain] + '@': [grass, monolith] + upperleft: [-1, 1] + map: | + AAAAAAAAA + A.......A + AB.@....A + AAAA.AAAA diff --git a/editors/emacs/swarm-mode.el b/editors/emacs/swarm-mode.el index a7dfe12b3..b7629a91d 100644 --- a/editors/emacs/swarm-mode.el +++ b/editors/emacs/swarm-mode.el @@ -55,6 +55,7 @@ "selfdestruct" "move" "backup" + "volume" "path" "push" "stride" diff --git a/editors/vim/swarm.vim b/editors/vim/swarm.vim index f6e4a7f9f..af3ed61b6 100644 --- a/editors/vim/swarm.vim +++ b/editors/vim/swarm.vim @@ -1,6 +1,6 @@ syn keyword Keyword def end let in require syn keyword Builtins self parent base if inl inr case fst snd force undefined fail not format chars split charat tochar key -syn keyword Command noop wait selfdestruct move backup path push stride turn grab harvest ignite place ping give equip unequip make has equipped count drill use build salvage reprogram say listen log view appear create halt time scout whereami waypoint structure floorplan hastag tagmembers detect resonate density sniff chirp watch surveil heading blocked scan upload ishere isempty meet meetall whoami setname random run return try swap atomic instant installkeyhandler teleport as robotnamed robotnumbered knows +syn keyword Command noop wait selfdestruct move backup volume path push stride turn grab harvest ignite place ping give equip unequip make has equipped count drill use build salvage reprogram say listen log view appear create halt time scout whereami waypoint structure floorplan hastag tagmembers detect resonate density sniff chirp watch surveil heading blocked scan upload ishere isempty meet meetall whoami setname random run return try swap atomic instant installkeyhandler teleport as robotnamed robotnumbered knows syn keyword Direction east north west south down forward left back right syn keyword Type int text dir bool cmd void unit actor diff --git a/editors/vscode/syntaxes/swarm.tmLanguage.json b/editors/vscode/syntaxes/swarm.tmLanguage.json index 840efa27b..96a0381ec 100644 --- a/editors/vscode/syntaxes/swarm.tmLanguage.json +++ b/editors/vscode/syntaxes/swarm.tmLanguage.json @@ -58,7 +58,7 @@ }, { "name": "keyword.other", - "match": "\\b(?i)(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|chars|split|charat|tochar|key|noop|wait|selfdestruct|move|backup|path|push|stride|turn|grab|harvest|ignite|place|ping|give|equip|unequip|make|has|equipped|count|drill|use|build|salvage|reprogram|say|listen|log|view|appear|create|halt|time|scout|whereami|waypoint|structure|floorplan|hastag|tagmembers|detect|resonate|density|sniff|chirp|watch|surveil|heading|blocked|scan|upload|ishere|isempty|meet|meetall|whoami|setname|random|run|return|try|swap|atomic|instant|installkeyhandler|teleport|as|robotnamed|robotnumbered|knows)\\b" + "match": "\\b(?i)(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|chars|split|charat|tochar|key|noop|wait|selfdestruct|move|backup|volume|path|push|stride|turn|grab|harvest|ignite|place|ping|give|equip|unequip|make|has|equipped|count|drill|use|build|salvage|reprogram|say|listen|log|view|appear|create|halt|time|scout|whereami|waypoint|structure|floorplan|hastag|tagmembers|detect|resonate|density|sniff|chirp|watch|surveil|heading|blocked|scan|upload|ishere|isempty|meet|meetall|whoami|setname|random|run|return|try|swap|atomic|instant|installkeyhandler|teleport|as|robotnamed|robotnumbered|knows)\\b" } ] }, diff --git a/src/swarm-engine/Swarm/Game/Step/Const.hs b/src/swarm-engine/Swarm/Game/Step/Const.hs index 5839b2eea..c7f742acc 100644 --- a/src/swarm-engine/Swarm/Game/Step/Const.hs +++ b/src/swarm-engine/Swarm/Game/Step/Const.hs @@ -72,6 +72,7 @@ import Swarm.Game.State.Robot import Swarm.Game.State.Substate import Swarm.Game.Step.Arithmetic import Swarm.Game.Step.Combustion qualified as Combustion +import Swarm.Game.Step.Flood import Swarm.Game.Step.Path.Finding import Swarm.Game.Step.Path.Type import Swarm.Game.Step.Path.Walkability @@ -157,6 +158,24 @@ execConst runChildProg c vs s k = do Backup -> do orientation <- use robotOrientation moveInDirection $ applyTurn (DRelative $ DPlanar DBack) $ orientation ? zero + Volume -> case vs of + [VInt limit] -> do + when (limit > globalMaxVolume) $ + throwError $ + CmdFailed + Volume + ( T.unwords + [ "Can only measure up to" + , T.pack $ show globalMaxVolume + , "cells." + ] + ) + Nothing + + robotLoc <- use robotLocation + maybeResult <- floodFill robotLoc $ fromIntegral limit + return $ mkReturn maybeResult + _ -> badConst Path -> case vs of [VInj hasLimit limitVal, VInj findEntity goalVal] -> do maybeLimit <- diff --git a/src/swarm-engine/Swarm/Game/Step/Flood.hs b/src/swarm-engine/Swarm/Game/Step/Flood.hs new file mode 100644 index 000000000..65febaa84 --- /dev/null +++ b/src/swarm-engine/Swarm/Game/Step/Flood.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- SPDX-License-Identifier: BSD-3-Clause +-- +-- Implementation of the 'Swarm.Language.Syntax.Volume' command for robots. +-- +-- Note: If the robot is currently on an unwalkable cell (which may happen in +-- the case of teleportation or if an entity is placed or pushed into its cell), +-- the volume shall be zero. +module Swarm.Game.Step.Flood ( + floodFill, +) where + +import Control.Effect.Lens +import Control.Lens (makeLenses, (%~), (&)) +import Data.HashSet (HashSet) +import Data.HashSet qualified as HashSet +import Swarm.Game.Location +import Swarm.Game.Step.RobotStepState +import Swarm.Game.Step.Util (checkMoveFailureUnprivileged) +import Swarm.Game.Step.Util.Inspect (getNeighborLocs) +import Swarm.Game.Universe + +data FloodParms = FloodParms + { theSubworld :: SubworldName + , maxVisits :: Int + } + +data Tracking = Tracking + { visited :: HashSet Location + , floodPartition :: FloodPartition + } + +-- | We annotate each visited cell as +-- being part of the boundary or the interior. +-- This lets us: +-- +-- 1. Use the interior cell count as a termination condition +-- 2. Handle (eventual) cache invalidation differently for boundary +-- members than interior members. +data FloodPartition = FloodPartition + { _boundary :: HashSet Location + , _interior :: HashSet Location + } + +makeLenses ''FloodPartition + +-- | +-- == Algorithm +-- +-- Explore via DFS using a list as a stack. +-- Each iteration examines a single cell. +-- +-- 1. Mark the popped cell as visited, regardless of walkability. +-- 2. Check popped cell for walkability +-- 3. Add all neighbors that aren't already visited, regardless of walkability, to the stack. +-- But unwalkable cells shall not produce neighbors and shall be marked with a boundary/interior distinction. +floodRecursive :: + HasRobotStepState sig m => + Tracking -> + [Location] -> + FloodParms -> + m (Maybe Int) +floodRecursive tracking pending params = + case pending of + nextLoc : otherLocs -> + if interiorCount > maxVisits params + then return Nothing + else checkNeighbors nextLoc otherLocs + [] -> return $ Just interiorCount + where + interiorCount = HashSet.size $ _interior $ floodPartition tracking + checkNeighbors nextLoc otherLocs = do + isWalkable <- null <$> checkMoveFailureUnprivileged cosmicLoc + let candidateNeighbors = + if isWalkable + then map (view planar) $ getNeighborLocs cosmicLoc + else [] + visitableNeighbors = filter (not . (`HashSet.member` visited tracking)) candidateNeighbors + + -- It's cheaper to prepend the "visitableNeighbors" list because + -- it should in general be a shorter list than the "pending" list. + newPending = visitableNeighbors <> otherLocs + + partitionMutator = + if isWalkable + then interior + else boundary + newPartition = floodPartition tracking & partitionMutator %~ HashSet.insert nextLoc + + newTracking = + tracking + { visited = newVisited + , floodPartition = newPartition + } + floodRecursive newTracking newPending params + where + newVisited = HashSet.insert nextLoc $ visited tracking + cosmicLoc = Cosmic (theSubworld params) nextLoc + +floodFill :: + HasRobotStepState sig m => + Cosmic Location -> + Int -> + m (Maybe Int) +floodFill (Cosmic swn curLoc) = + floodRecursive emptyTracking [curLoc] . FloodParms swn + where + emptyTracking = Tracking mempty $ FloodPartition mempty mempty diff --git a/src/swarm-lang/Swarm/Language/Capability.hs b/src/swarm-lang/Swarm/Language/Capability.hs index 7ee3b870d..68a9e520c 100644 --- a/src/swarm-lang/Swarm/Language/Capability.hs +++ b/src/swarm-lang/Swarm/Language/Capability.hs @@ -36,6 +36,8 @@ data Capability CMove | -- | Execute the 'Backup' command CBackup + | -- | Execute the 'Volume' command + CVolume | -- | Execute the 'Path' command CPath | -- | Execute the 'Push' command @@ -224,6 +226,7 @@ constCaps = \case Selfdestruct -> Just CSelfdestruct Move -> Just CMove Backup -> Just CBackup + Volume -> Just CVolume Path -> Just CPath Push -> Just CPush Stride -> Just CMovemultiple diff --git a/src/swarm-lang/Swarm/Language/Syntax.hs b/src/swarm-lang/Swarm/Language/Syntax.hs index affa48a50..1853d6a01 100644 --- a/src/swarm-lang/Swarm/Language/Syntax.hs +++ b/src/swarm-lang/Swarm/Language/Syntax.hs @@ -37,10 +37,13 @@ module Swarm.Language.Syntax ( isBuiltinFunction, isTangible, isLong, + + -- * Size limits maxSniffRange, maxScoutRange, maxStrideRange, maxPathRange, + globalMaxVolume, -- * Syntax Syntax' (..), @@ -124,6 +127,15 @@ maxStrideRange = 64 maxPathRange :: Integer maxPathRange = 128 +-- | Checked upon invocation of the command, +-- before flood fill computation, to ensure +-- the search has a reasonable bound. +-- +-- The user is warned in the failure message +-- that there exists a global limit. +globalMaxVolume :: Integer +globalMaxVolume = 64 * 64 + ------------------------------------------------------------ -- Constants ------------------------------------------------------------ @@ -158,6 +170,8 @@ data Const Move | -- | Move backward one step. Backup + | -- | Measure the size of the enclosed volume + Volume | -- | Describe a path to the destination. Path | -- | Push an entity forward one step. @@ -564,6 +578,19 @@ constInfo c = case c of shortDoc (Set.singleton $ Mutation $ RobotChange PositionChange) "Move backward one step." + Volume -> + command 1 short + . doc + (Set.singleton $ Query $ Sensing EntitySensing) + "Measure enclosed volume." + $ [ "Specify the max volume to check for." + , "Returns either the measured volume bounded by \"unwalkable\" cells," + , "or `unit` if the search exceeds the limit." + , T.unwords + [ "There is also an implicit hard-coded maximum of" + , T.pack $ show globalMaxVolume + ] + ] Path -> command 2 short . doc diff --git a/src/swarm-lang/Swarm/Language/Typecheck.hs b/src/swarm-lang/Swarm/Language/Typecheck.hs index 540aa3681..9b5c12671 100644 --- a/src/swarm-lang/Swarm/Language/Typecheck.hs +++ b/src/swarm-lang/Swarm/Language/Typecheck.hs @@ -742,6 +742,7 @@ inferConst c = case c of Selfdestruct -> [tyQ| cmd unit |] Move -> [tyQ| cmd unit |] Backup -> [tyQ| cmd unit |] + Volume -> [tyQ| int -> cmd (unit + int) |] Path -> [tyQ| (unit + int) -> ((int * int) + text) -> cmd (unit + (dir * int)) |] Push -> [tyQ| cmd unit |] Stride -> [tyQ| int -> cmd unit |] diff --git a/swarm.cabal b/swarm.cabal index 793e6edab..7ad25410b 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -286,6 +286,7 @@ library swarm-engine Swarm.Game.Step.Arithmetic Swarm.Game.Step.Combustion Swarm.Game.Step.Const + Swarm.Game.Step.Flood Swarm.Game.Step.Path.Cache Swarm.Game.Step.Path.Cache.DistanceLimit Swarm.Game.Step.Path.Finding @@ -536,6 +537,7 @@ library , Swarm.Game.Step.Arithmetic , Swarm.Game.Step.Combustion , Swarm.Game.Step.Const + , Swarm.Game.Step.Flood , Swarm.Game.Step.Path.Cache , Swarm.Game.Step.Path.Cache.DistanceLimit , Swarm.Game.Step.Path.Finding diff --git a/test/integration/Main.hs b/test/integration/Main.hs index aeb9e5754..69bcd3c49 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -363,6 +363,7 @@ testScenarioSolutions rs ui = , testSolution Default "Testing/1399-backup-command" , testSolution Default "Testing/1536-custom-unwalkable-entities" , testSolution Default "Testing/1631-tags" + , testSolution Default "Testing/1747-volume-command" , testGroup -- Note that the description of the classic world in -- data/worlds/classic.yaml (automatically tested to some