sniff/chirp commands (#1181)

towards #1171

## New tests

Unit tests:

    scripts/run-tests.sh --test-arguments '--pattern "Relative direction"'

Integration tests for `sniff` and `chirp` demonstrate how to home in on an item using distance and orientation, respectively.

## Efficiency

For the sake of execution time, I have capped the max "diameter" (`N`) of both commands to `200` cells.  In the worst case (the entity is not present), `O(N^2)` cells are inspected, which manifests as a perceptible delay when the command is run.  I came across the `getElemsInArea` function that seems to suggest that an `O(N * log N)` search may be possible.  Is that the case?

Otherwise we may be able to add some new data structures to the game state for efficient entity location querying.

data/scenarios/Testing/00-ORDER.txt

@@ -25,4 +25,6 @@
 1024-sand.yaml
 1034-custom-attributes.yaml
 1140-detect-command.yaml
-1157-drill-return-value.yaml
+1157-drill-return-value.yaml
+1171-sniff-command.yaml
+1171-chirp-command.yaml

data/scenarios/Testing/1171-chirp-command.yaml

@@ -0,0 +1,48 @@
+version: 1
+name: Chirp test
+creative: true
+description: Locate a tree using chirp
+objectives:
+  - goal:
+      - grab a tree.
+    condition: |
+      as base {has "tree"}
+solution: |
+  def takeStep = \item.
+    direction <- chirp item;
+    if (direction == down) {
+      grab;
+    } {
+      turn direction;
+      move;
+      takeStep item;
+    }
+    end;
+
+  takeStep "tree";
+robots:
+  - name: base
+    dir: [0,-1]
+    display:
+      char: Ω
+      attr: robot
+    devices:
+      - logger
+      - string
+      - grabber
+      - treads
+known: []
+world:
+  default: [blank]
+  palette:
+    'Ω': [grass, null, base]
+    '.': [grass]
+    'T': [grass, tree]
+  upperleft: [0, 0]
+  map: |
+   .........
+   ......T..
+   .........
+   .........
+   .Ω.......
+   .........

data/scenarios/Testing/1171-sniff-command.yaml

@@ -0,0 +1,57 @@
+version: 1
+name: Sniff test
+creative: true
+description: Locate a tree using sniff
+objectives:
+  - goal:
+      - grab a tree.
+    condition: |
+      as base {has "tree"}
+solution: |
+  def homeIn = \item. \oldDistance.
+    if (oldDistance > 0) {
+      move;
+      newDistance <- sniff item;
+      d <- if (newDistance > oldDistance) {
+        turn back;
+        move;
+        turn left;
+        return oldDistance;
+      } {
+        return newDistance;
+      };
+      homeIn item d;
+    } {
+      grab;
+    }
+    end;
+
+  let item = "tree" in
+  initialDistance <- sniff item;
+  homeIn item initialDistance;
+robots:
+  - name: base
+    dir: [0,-1]
+    display:
+      char: Ω
+      attr: robot
+    devices:
+      - logger
+      - string
+      - grabber
+      - treads
+known: []
+world:
+  default: [blank]
+  palette:
+    'Ω': [grass, null, base]
+    '.': [grass]
+    'T': [grass, tree]
+  upperleft: [0, 0]
+  map: |
+   .........
+   ......T..
+   .........
+   .........
+   .Ω.......
+   .........

editors/emacs/swarm-mode.el

@@ -77,6 +77,8 @@
                "time"
                "whereami"
                "detect"
+               "sniff"
+               "chirp"
                "heading"
                "blocked"
                "scan"
@@ -98,10 +100,10 @@
                "robotnamed"
                "robotnumbered"
                "knows"
-               "north"
-               "south"
                "east"
+               "north"
                "west"
+               "south"
                "left"
                "right"
                "back"

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|noop|wait|selfdestruct|move|turn|grab|harvest|place|give|equip|unequip|make|has|equipped|count|drill|build|salvage|reprogram|say|listen|log|view|appear|create|time|whereami|detect|heading|blocked|scan|upload|ishere|isempty|meet|meetall|whoami|setname|random|run|return|try|swap|atomic|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|noop|wait|selfdestruct|move|turn|grab|harvest|place|give|equip|unequip|make|has|equipped|count|drill|build|salvage|reprogram|say|listen|log|view|appear|create|time|whereami|detect|sniff|chirp|heading|blocked|scan|upload|ishere|isempty|meet|meetall|whoami|setname|random|run|return|try|swap|atomic|teleport|as|robotnamed|robotnumbered|knows)\\b"
 				}
 			]
 			},
@@ -89,7 +89,7 @@
 			"patterns": [
 				{
 				"name": "variable.language.dir",
-				"match": "\\b(?i)(north|south|east|west|left|right|back|forward|down)\\b"
+				"match": "\\b(?i)(east|north|west|south|left|right|back|forward|down)\\b"
 				},
 				{
 				"name": "variable.parameter",

scripts/run-tests.sh

@@ -4,4 +4,4 @@ SCRIPT_DIR=$( cd -- "$( dirname -- "${BASH_SOURCE[0]}" )" &> /dev/null && pwd )
 cd $SCRIPT_DIR/..
 
 # See https://github.com/swarm-game/swarm/issues/936
-STACK_WORK=.stack-work-test stack test $@
+STACK_WORK=.stack-work-test stack test "$@"

src/Swarm/Game/Location.hs

@@ -14,7 +14,9 @@ module Swarm.Game.Location (
   -- ** Heading and Direction functions
   Heading,
   applyTurn,
+  relativeTo,
   toDirection,
+  nearestDirection,
   fromDirection,
   isCardinal,
   north,
@@ -35,12 +37,12 @@ module Swarm.Game.Location (
 
 import Control.Arrow ((&&&))
 import Data.Aeson (FromJSONKey, ToJSONKey)
-import Data.Function ((&))
+import Data.Function (on, (&))
 import Data.Int (Int32)
 import Data.Map (Map)
 import Data.Map qualified as M
 import Data.Yaml (FromJSON (parseJSON), ToJSON (toJSON))
-import Linear (Additive (..), V2 (..), negated, norm, perp)
+import Linear (Additive (..), V2 (..), negated, norm, perp, unangle)
 import Linear.Affine (Affine (..), Point (..), origin)
 import Swarm.Language.Syntax (AbsoluteDir (..), Direction (..), RelativeDir (..), isCardinal)
 import Swarm.Util qualified as Util
@@ -139,6 +141,28 @@ cardinalDirs =
 toDirection :: Heading -> Maybe Direction
 toDirection v = M.lookup v cardinalDirs
 
+-- | Example:
+--      DWest `relativeTo` DSouth == DRight
+relativeTo :: AbsoluteDir -> AbsoluteDir -> RelativeDir
+relativeTo targetDir referenceDir =
+  [DForward, DLeft, DBack, DRight] !! indexDiff
+ where
+  enumCount = length (Util.listEnums :: [AbsoluteDir])
+  indexDiff = ((-) `on` fromEnum) targetDir referenceDir `mod` enumCount
+
+-- | Logic adapted from:
+-- https://gamedev.stackexchange.com/questions/49290/#comment213403_49300
+nearestDirection :: Heading -> AbsoluteDir
+nearestDirection coord =
+  orderedDirs !! index
+ where
+  angle :: Double
+  angle = unangle (fmap fromIntegral coord) / (2 * pi)
+
+  index = round (fromIntegral enumCount * angle) `mod` enumCount
+  orderedDirs = Util.listEnums
+  enumCount = length orderedDirs
+
 -- | Convert a 'Direction' into a corresponding heading.  Note that
 --   this only does something reasonable for 'DNorth', 'DSouth', 'DEast',
 --   and 'DWest'---other 'Direction's return the zero vector.

src/Swarm/Game/Step.hs

@@ -42,6 +42,7 @@ import Data.Foldable (asum, for_, traverse_)
 import Data.Foldable.Extra (findM)
 import Data.Function (on)
 import Data.Functor (void)
+import Data.Int (Int32)
 import Data.IntMap qualified as IM
 import Data.IntSet qualified as IS
 import Data.List (find, sortOn)
@@ -57,7 +58,7 @@ import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Time (getZonedTime)
 import Data.Tuple (swap)
-import Linear (V2 (..), zero)
+import Linear (V2 (..), perp, zero)
 import Swarm.Game.Achievement.Attainment
 import Swarm.Game.Achievement.Definitions
 import Swarm.Game.CESK
@@ -1206,6 +1207,28 @@ execConst c vs s k = do
         firstOne <- findM (fmap (maybe False $ isEntityNamed name) . entityAt . (loc .+^)) sortedLocs
         return $ Out (asValue firstOne) s k
       _ -> badConst
+    Sniff -> case vs of
+      [VText name] -> do
+        firstFound <- findNearest name
+        return $ Out (asValue $ maybe (-1) fst firstFound) s k
+      _ -> badConst
+    Chirp -> case vs of
+      [VText name] -> do
+        firstFound <- findNearest name
+        mh <- use robotOrientation
+        inst <- use equippedDevices
+        let processDirection entityDir =
+              if countByName "compass" inst >= 1
+                then Just $ DAbsolute entityDir
+                else case mh >>= toDirection of
+                  Just (DAbsolute robotDir) -> Just $ DRelative $ entityDir `relativeTo` robotDir
+                  _ -> Nothing -- This may happen if the robot is facing "down"
+            val = VDir $ fromMaybe (DRelative DDown) $ do
+              entLoc <- firstFound
+              guard $ snd entLoc /= zero
+              processDirection . nearestDirection . snd $ entLoc
+        return $ Out val s k
+      _ -> badConst
     Heading -> do
       mh <- use robotOrientation
       -- In general, (1) entities might not have an orientation, and
@@ -1845,6 +1868,25 @@ execConst c vs s k = do
       , prettyText (Out (VCApp c (reverse vs)) s k)
       ]
 
+  findNearest ::
+    HasRobotStepState sig m =>
+    Text ->
+    m (Maybe (Int32, V2 Int32))
+  findNearest name = do
+    loc <- use robotLocation
+    findM (fmap (maybe False $ isEntityNamed name) . entityAt . (loc .+^) . snd) sortedLocs
+   where
+    sortedLocs :: [(Int32, V2 Int32)]
+    sortedLocs = (0, zero) : concatMap genDiamondSides [1 .. maxSniffRange]
+
+    -- Grow a list of locations in a diamond shape outward, such that the nearest cells
+    -- are searched first by construction, rather than having to sort.
+    genDiamondSides :: Int32 -> [(Int32, V2 Int32)]
+    genDiamondSides diameter = concat [f diameter x | x <- [0 .. diameter]]
+     where
+      -- Adds a single cell to each of the four sides of the diamond
+      f d x = map (d,) $ take 4 $ iterate perp $ V2 x (d - x)
+
   finishCookingRecipe ::
     HasRobotStepState sig m =>
     Recipe e ->

src/Swarm/Language/Capability.hs

@@ -72,6 +72,10 @@ data Capability
     CSensehere
   | -- | Execute the 'Detect' command
     CDetectloc
+  | -- | Execute the 'Sniff' command
+    CDetectdistance
+  | -- | Execute the 'Chirp' command
+    CDetectdirection
   | -- | Execute the 'Scan' command
     CScan
   | -- | Execute the 'Random' command
@@ -216,6 +220,8 @@ constCaps = \case
   Wait -> Just CTime
   Whereami -> Just CSenseloc
   Detect -> Just CDetectloc
+  Sniff -> Just CDetectdistance
+  Chirp -> Just CDetectdirection
   Heading -> Just COrient
   -- ----------------------------------------------------------------
   -- Text operations

src/Swarm/Language/Syntax.hs

@@ -36,6 +36,7 @@ module Swarm.Language.Syntax (
   isBuiltinFunction,
   isTangible,
   isLong,
+  maxSniffRange,
 
   -- * Syntax
   Syntax' (..),
@@ -87,6 +88,7 @@ import Data.Char qualified as C (toLower)
 import Data.Data (Data)
 import Data.Data.Lens (uniplate)
 import Data.Hashable (Hashable)
+import Data.Int (Int32)
 import Data.List qualified as L (tail)
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NonEmpty
@@ -100,14 +102,28 @@ import Swarm.Language.Types
 import Swarm.Util qualified as Util
 import Witch.From (from)
 
+-- | Maximum perception distance for
+-- 'chirp' and 'sniff' commands
+maxSniffRange :: Int32
+maxSniffRange = 256
+
 ------------------------------------------------------------
 -- Directions
 ------------------------------------------------------------
 
 -- | An absolute direction is one which is defined with respect to an
 --   external frame of reference; robots need a compass in order to
 --   use them.
-data AbsoluteDir = DNorth | DSouth | DEast | DWest
+--
+-- NOTE: These values are ordered by increasing angle according to
+-- the standard mathematical convention.
+-- That is, the right-pointing direction, East, is considered
+-- the "reference angle" and the order proceeds counter-clockwise.
+-- See https://en.wikipedia.org/wiki/Polar_coordinate_system#Conventions
+--
+-- Do not alter this ordering, as there exist functions that depend on it
+-- (e.g. "nearestDirection" and "relativeTo").
+data AbsoluteDir = DEast | DNorth | DWest | DSouth
   deriving (Eq, Ord, Show, Read, Generic, Data, Hashable, ToJSON, FromJSON, Enum, Bounded)
 
 cardinalDirectionKeyOptions :: JSONKeyOptions
@@ -234,6 +250,10 @@ data Const
   | -- | Locate the closest instance of a given entity within the rectangle
     -- specified by opposite corners, relative to the current location.
     Detect
+  | -- | Get the distance to the closest instance of the specified entity.
+    Sniff
+  | -- | Get the direction to the closest instance of the specified entity.
+    Chirp
   | -- | Get the current heading.
     Heading
   | -- | See if we can move forward or not.
@@ -584,6 +604,19 @@ constInfo c = case c of
   Detect ->
     command 2 Intangible . doc "Detect an entity within a rectangle." $
       ["Locate the closest instance of a given entity within the rectangle specified by opposite corners, relative to the current location."]
+  Sniff ->
+    command 1 short . doc "Determine distance to entity." $
+      [ "Measures concentration of airborne particles to infer distance to a certain kind of entity."
+      , "If none is detected, returns (-1)."
+      , T.unwords ["Has a max range of", T.pack $ show maxSniffRange, "units."]
+      ]
+  Chirp ->
+    command 1 short . doc "Determine direction to entity." $
+      [ "Uses a directional sonic emitter and microphone tuned to the acoustic signature of a specific entity to determine its direction."
+      , "Returns 'down' if out of range or the direction is indeterminate."
+      , "Provides absolute directions if \"compass\" equipped, relative directions otherwise."
+      , T.unwords ["Has a max range of", T.pack $ show maxSniffRange, "units."]
+      ]
   Heading -> command 0 Intangible "Get the current heading."
   Blocked -> command 0 Intangible "See if the robot can move forward."
   Scan ->

src/Swarm/Language/Typecheck.hs

@@ -560,6 +560,8 @@ inferConst c = case c of
   Time -> [tyQ| cmd int |]
   Whereami -> [tyQ| cmd (int * int) |]
   Detect -> [tyQ| text -> ((int * int) * (int * int)) -> cmd (unit + (int * int)) |]
+  Sniff -> [tyQ| text -> cmd int |]
+  Chirp -> [tyQ| text -> cmd dir |]
   Heading -> [tyQ| cmd dir |]
   Blocked -> [tyQ| cmd bool |]
   Scan -> [tyQ| dir -> cmd (unit + text) |]