better transparency handling for structure recognizer

data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt

@@ -14,3 +14,5 @@
 1575-bounding-box-overlap.yaml
 1644-rotated-recognition.yaml
 1644-rotated-preplacement-recognition.yaml
+2115-encroaching-upon-exterior-transparent-cells.yaml
+2115-encroaching-upon-interior-transparent-cells.yaml

data/scenarios/Testing/1575-structure-recognizer/1575-interior-entity-placement.yaml

@@ -9,10 +9,6 @@ description: |
   Additionally, recognition of statically-placed
   structures at scenario initialization is also
   unaffected by interior entities.
-
-  However, any such "contaminating" entities
-  will prevent the recognition of a structure
-  when constructed by a robot.
 creative: false
 objectives:
   - teaser: Replace rock

data/scenarios/Testing/1575-structure-recognizer/2115-encroaching-upon-exterior-transparent-cells.yaml

@@ -0,0 +1,77 @@
+version: 1
+name: Structure recognition - exterior transparency
+description: |
+  Incursion of an entity of a foreign type
+  upon a "transparent" cell within the bounding box
+  of a recognizable structure shall not prevent
+  the structure from being recognized.
+
+  If the incurring entity is the *same* type as
+  a participating entity in that structure, however,
+  it will prevent recognition.
+creative: false
+objectives:
+  - teaser: Recognize structure
+    goal:
+      - |
+        `chevron`{=structure} structure should be recognized upon completion,
+        even with an extraneous entity within its bounds.
+    condition: |
+      def isRight = \x. case x (\_. false) (\_. true); end;
+
+      foundBox <- structure "chevron" 0;
+      return $ isRight foundBox;
+robots:
+  - name: base
+    dir: east
+    devices:
+      - ADT calculator
+      - blueprint
+      - fast grabber
+      - logger
+      - treads
+    inventory:
+      - [1, board]
+  - name: judge
+    dir: east
+    system: true
+    display:
+      invisible: true
+solution: |
+  move; move; move;
+  swap "board";
+structures:
+  - name: chevron
+    recognize: [north]
+    structure:
+      palette:
+        'b': [stone, board]
+      mask: '.'
+      map: |
+        .b
+        bb
+  - name: stripe
+    recognize: [north]
+    structure:
+      palette:
+        't': [grass, tree]
+        'b': [grass, board]
+      map: |
+        btb
+known: [board, mountain, tree]
+world:
+  dsl: |
+    {blank}
+  palette:
+    '.': [grass, erase]
+    'B': [grass, erase, base]
+    'j': [grass, erase, judge]
+    't': [grass, tree]
+    'b': [grass, board]
+  upperleft: [-7, 3]
+  map: |
+    j.....
+    ......
+    .B.ttt
+    ...bb.
+    ......

data/scenarios/Testing/1575-structure-recognizer/2115-encroaching-upon-interior-transparent-cells.yaml

@@ -0,0 +1,85 @@
+version: 1
+name: Structure recognition - interior transparency
+description: |
+  Incursion of an entity of a foreign type
+  upon a "transparent" cell within the bounding box
+  of a recognizable structure shall not prevent
+  the structure from being recognized.
+
+  If the incurring entity is the *same* type as
+  a participating entity in that structure, however,
+  it will prevent recognition.
+creative: false
+objectives:
+  - teaser: Recognize structure
+    goal:
+      - |
+        `pigpen`{=structure} structure should be recognized upon completion,
+        even with an extraneous entity within its bounds.
+    condition: |
+      def isRight = \x. case x (\_. false) (\_. true); end;
+      foundBox <- structure "pigpen" 0;
+      return $ isRight foundBox;
+robots:
+  - name: base
+    dir: east
+    devices:
+      - ADT calculator
+      - blueprint
+      - fast grabber
+      - logger
+      - treads
+    inventory:
+      - [1, board]
+  - name: judge
+    dir: east
+    system: true
+    display:
+      invisible: true
+solution: |
+  move; move; move; move;
+  swap "board";
+structures:
+  - name: pigpen
+    recognize: [north]
+    structure:
+      palette:
+        'b': [stone, board]
+      mask: '.'
+      map: |
+        bbbb
+        b..b
+        b..b
+        bbbb
+  - name: obstruction
+    recognize: [north]
+    structure:
+      palette:
+        't': [grass, tree]
+        'b': [grass, board]
+      map: |
+        tttb
+known: [board, mountain, tree]
+world:
+  dsl: |
+    {blank}
+  palette:
+    '.': [grass, erase]
+    'B': [grass, erase, base]
+    'r': [grass, mountain]
+    'j': [grass, erase, judge]
+    'p':
+      structure:
+        name: pigpen
+      cell: [grass]
+    'b':
+      structure:
+        name: obstruction
+      cell: [grass]
+  upperleft: [-7, 3]
+  map: |
+    j.....
+    .p....
+    ...r..
+    B..b..
+    ......

src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Log.hs

@@ -6,6 +6,7 @@ module Swarm.Game.Scenario.Topography.Structure.Recognition.Log where
 
 import Data.Aeson
 import Data.Int (Int32)
+import Data.List.NonEmpty (NonEmpty)
 import GHC.Generics (Generic)
 import Servant.Docs (ToSample)
 import Servant.Docs qualified as SD
@@ -14,8 +15,10 @@ import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
 import Swarm.Game.Universe (Cosmic)
 import Swarm.Language.Syntax.Direction (AbsoluteDir)
 
-type StructureRowContent e = [Maybe e]
-type WorldRowContent e = [Maybe e]
+-- | Type aliases for documentation
+type StructureRowContent e = SymbolSequence e
+
+type WorldRowContent e = SymbolSequence e
 
 data OrientedStructure = OrientedStructure
   { oName :: OriginalName
@@ -27,7 +30,8 @@ distillLabel :: StructureWithGrid b a -> OrientedStructure
 distillLabel swg = OrientedStructure (getName $ originalDefinition swg) (rotatedTo swg)
 
 data MatchingRowFrom = MatchingRowFrom
-  { rowIdx :: Int32
+  { topDownRowIdx :: Int32
+  -- ^ numbered from the top down
   , structure :: OrientedStructure
   }
   deriving (Generic, ToJSON)
@@ -45,14 +49,23 @@ data HaystackContext e = HaystackContext
 
 data FoundRowCandidate e = FoundRowCandidate
   { haystackContext :: HaystackContext e
-  , structureContent :: StructureRowContent e
-  , rowCandidates :: [MatchingRowFrom]
+  , soughtContent :: StructureRowContent e
+  , matchedCandidates :: [MatchingRowFrom]
+  }
+  deriving (Functor, Generic, ToJSON)
+
+data EntityKeyedFinder e = EntityKeyedFinder
+  { searchOffsets :: InspectionOffsets
+  , candidateStructureRows :: NonEmpty (StructureRowContent e)
+  , entityMask :: [e]
+  -- ^ NOTE: HashSet has no Functor instance,
+  -- so we represent this as a list here.
   }
   deriving (Functor, Generic, ToJSON)
 
 data ParticipatingEntity e = ParticipatingEntity
   { entity :: e
-  , searchOffsets :: InspectionOffsets
+  , entityKeyedFinders :: NonEmpty (EntityKeyedFinder e)
   }
   deriving (Functor, Generic, ToJSON)
 
@@ -63,14 +76,22 @@ data IntactPlacementLog = IntactPlacementLog
   }
   deriving (Generic, ToJSON)
 
+data VerticalSearch e = VerticalSearch
+  { haystackVerticalExtents :: InspectionOffsets
+  -- ^ vertical offset of haystack relative to the found row
+  , soughtStructures :: [OrientedStructure]
+  , verticalHaystack :: [WorldRowContent e]
+  }
+  deriving (Functor, Generic, ToJSON)
+
 data SearchLog e
   = FoundParticipatingEntity (ParticipatingEntity e)
   | StructureRemoved OriginalName
   | FoundRowCandidates [FoundRowCandidate e]
   | FoundCompleteStructureCandidates [OrientedStructure]
   | -- | There may be multiple candidate structures that could be
     -- completed by the element that was just placed. This lists all of them.
-    VerticalSearchSpans [(InspectionOffsets, [OrientedStructure])]
+    VerticalSearchSpans [VerticalSearch e]
   | IntactStaticPlacement [IntactPlacementLog]
   deriving (Functor, Generic)
 

src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Prep.hs

@@ -7,6 +7,7 @@ import Data.HashMap.Strict qualified as HM
 import Data.HashSet qualified as HS
 import Data.Hashable (Hashable)
 import Data.Int (Int32)
+import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NE
 import Data.Maybe (catMaybes)
 import Data.Semigroup (sconcat)
@@ -32,13 +33,13 @@ mkOffsets pos xs =
 -- rows constitute a complete structure.
 mkRowLookup ::
   (Hashable a, Eq a) =>
-  NE.NonEmpty (StructureRow b a) ->
+  NonEmpty (StructureRow b a) ->
   AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a)
 mkRowLookup neList =
-  AutomatonInfo participatingEnts bounds sm
+  AutomatonInfo participatingEnts bounds sm tuples
  where
   mkSmTuple = entityGrid &&& id
-  tuples = NE.toList $ NE.map (mkSmTuple . wholeStructure) neList
+  tuples = NE.map (mkSmTuple . wholeStructure) neList
 
   -- All of the unique entities across all of the full candidate structures
   participatingEnts =
@@ -50,7 +51,7 @@ mkRowLookup neList =
     mkOffsets rwIdx g
 
   bounds = sconcat $ NE.map deriveRowOffsets neList
-  sm = makeStateMachine tuples
+  sm = makeStateMachine $ NE.toList tuples
 
 -- | Make the first-phase lookup map, keyed by 'Entity',
 -- along with automatons whose key symbols are "Maybe Entity".
@@ -61,7 +62,7 @@ mkRowLookup neList =
 mkEntityLookup ::
   (Hashable a, Eq a) =>
   [StructureWithGrid b a] ->
-  HM.HashMap a (AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a))
+  HM.HashMap a (NonEmpty (AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a)))
 mkEntityLookup grids =
   HM.map mkValues rowsByEntityParticipation
  where
@@ -75,17 +76,26 @@ mkEntityLookup grids =
     structureRowsNE = NE.map myRow singleRows
     sm2D = mkRowLookup structureRowsNE
 
-  mkValues neList = AutomatonInfo participatingEnts bounds sm
+  mkValues neList =
+    NE.map (\(mask, tups) -> AutomatonInfo mask bounds sm tups) tuplesByEntMask
    where
-    participatingEnts =
-      HS.fromList
-        (concatMap (catMaybes . fst) tuples)
+    -- If there are no transparent cells,
+    -- we don't need a mask.
+    getMaskSet row =
+      if Nothing `elem` row
+        then HS.fromList $ catMaybes row
+        else mempty
 
-    tuples = HM.toList $ HM.mapWithKey mkSmValue groupedByUniqueRow
+    tuplesByEntMask = binTuplesHMasListNE $ NE.map (getMaskSet . fst &&& id) tuplesNE
+
+    tuplesNE = NE.map (\(a, b) -> (a, mkSmValue a b)) groupedByUniqueRow
+
+    groupedByUniqueRow =
+      binTuplesHMasListNE $
+        NE.map (rowContent . myRow &&& id) neList
 
-    groupedByUniqueRow = binTuplesHM $ NE.toList $ NE.map (rowContent . myRow &&& id) neList
     bounds = sconcat $ NE.map expandedOffsets neList
-    sm = makeStateMachine tuples
+    sm = makeStateMachine $ NE.toList tuplesNE
 
   -- The values of this map are guaranteed to contain only one
   -- entry per row of a given structure.
@@ -111,6 +121,7 @@ mkEntityLookup grids =
       SingleRowEntityOccurrences r e occurrences $
         sconcat $
           NE.map deriveEntityOffsets occurrences
+
     unconsolidated =
       map swap $
         catMaybes $
@@ -123,7 +134,19 @@ mkEntityLookup grids =
 binTuplesHM ::
   (Foldable t, Hashable a, Eq a) =>
   t (a, b) ->
-  HM.HashMap a (NE.NonEmpty b)
+  HM.HashMap a (NonEmpty b)
 binTuplesHM = foldr f mempty
  where
   f = uncurry (HM.insertWith (<>)) . fmap pure
+
+-- | We know that if the input to the binning function
+-- is a nonempty list, the output map must also have
+-- at least one element.
+-- Ideally we would use a NonEmptyMap to prove this,
+-- but unfortunately such a variant does not exist for 'HashMap'.
+-- So we just "force" the proof by using 'NE.fromList'.
+binTuplesHMasListNE ::
+  (Hashable a, Eq a) =>
+  NonEmpty (a, b) ->
+  NonEmpty (a, NonEmpty b)
+binTuplesHMasListNE = NE.fromList . HM.toList . binTuplesHM