WIP: split row into contiguous chunks

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

@@ -16,4 +16,5 @@
 1644-rotated-preplacement-recognition.yaml
 2115-encroaching-upon-exterior-transparent-cells.yaml
 2115-encroaching-upon-interior-transparent-cells.yaml
-9999-piecewise-lines.yaml
+2201-piecewise-lines.yaml
+2201-piecewise-solid.yaml

data/scenarios/Testing/1575-structure-recognizer/2201-piecewise-lines.yaml

@@ -0,0 +1,106 @@
+version: 1
+name: Structure recognition - piecewise lines
+description: |
+  General solution for transparency
+creative: false
+objectives:
+  - teaser: Recognize structure
+    goal:
+      - |
+        `spaceship`{=structure} structure should be recognized upon completion,
+        even with an extraneous entity within its bounds.
+    condition: |
+      def isRight = \x. case x (\_. false) (\_. true); end;
+      foundStructure <- structure "spaceship" 0;
+      return $ isRight foundStructure;
+robots:
+  - name: base
+    dir: east
+    devices:
+      - ADT calculator
+      - blueprint
+      - fast grabber
+      - logger
+      - treads
+    inventory:
+      - [1, rock]
+solution: |
+  move; move; move; move; move; move; move;
+  swap "rock";
+structures:
+  - name: fragment
+    recognize: [north]
+    structure:
+      palette:
+        'z': [stone, pixel (R)]
+        'w': [stone, pixel (B)]
+        'x': [stone, rock]
+        'y': [stone, mountain]
+      mask: '.'
+      map: |
+        zw.xy
+  - name: spaceship
+    recognize: [north]
+    structure:
+      palette:
+        'p': [stone, board]
+        'x': [stone, rock]
+        'y': [stone, mountain]
+        'z': [stone, pixel (R)]
+        'w': [stone, pixel (B)]
+        'q': [stone, pixel (G)]
+      mask: '.'
+      map: |
+        q....xy.zw.xy
+        qq....ppp....
+        q....xy.xy.qq
+  - name: friendship
+    recognize: [north]
+    structure:
+      palette:
+        'x': [stone, rock]
+        'y': [stone, mountain]
+        'z': [stone, pixel (R)]
+        'w': [stone, pixel (B)]
+        'q': [stone, pixel (G)]
+      mask: '.'
+      map: |
+        qqq.......
+        qqq.......
+        qqq.......
+        qqq.......
+        ..xy.zw.xy
+        qqq.......
+  - name: damage
+    description: A single-cell overwrite of the spaceship
+    structure:
+      palette:
+        't': [stone, tree]
+      map: |
+        t
+  - name: modified ship
+    description: A spaceship with a single cell replaced by a `tree`{=entity}
+    structure:
+      placements:
+        - src: spaceship
+        - src: damage
+          offset: [5, 0]
+      map: ""
+known: [board, mountain, rock, tree, pixel (R), pixel (B)]
+world:
+  dsl: |
+    {blank}
+  palette:
+    '.': [grass, erase]
+    'B': [grass, erase, base]
+    'p':
+      structure:
+        name: modified ship
+      cell: [grass]
+  upperleft: [100, -100]
+  map: |
+    ..........
+    B.p.......
+    ..........
+    ..........
+    ..........

data/scenarios/Testing/1575-structure-recognizer/9999-piecewise-lines.yaml → data/scenarios/Testing/1575-structure-recognizer/2201-piecewise-solid.yaml

@@ -34,12 +34,11 @@ structures:
       palette:
         'p': [stone, board]
         'x': [stone, rock]
-        'y': [stone, mountain]
       mask: '.'
       map: |
-        xy.xy
-        .ppp.
-        xy.xy
+        xxx
+        ppp
+        xxx
   - name: damage
     description: A single-cell overwrite of the spaceship
     structure:
@@ -67,8 +66,8 @@ world:
       cell: [grass]
   upperleft: [0, 0]
   map: |
-    ..........
-    B..p......
-    ..........
-    ..........
-    ..........
+    .........
+    B..p.....
+    .........
+    .........
+    .........

src/swarm-engine/Swarm/Game/State/Initialize.hs

@@ -15,7 +15,6 @@ import Control.Effect.Lens (view)
 import Control.Effect.Lift (Has)
 import Control.Effect.State (State)
 import Control.Lens hiding (Const, use, uses, view, (%=), (+=), (.=), (<+=), (<<.=))
-import Data.Foldable.Extra (allM)
 import Data.IntMap qualified as IM
 import Data.List (partition)
 import Data.List.NonEmpty (NonEmpty)
@@ -25,7 +24,6 @@ import Data.Map qualified as M
 import Data.Maybe (isNothing)
 import Data.Set qualified as S
 import Data.Text (Text)
-import Linear (V2 (..))
 import Swarm.Game.CESK (finalValue, initMachine)
 import Swarm.Game.Device (getCapabilitySet, getMap)
 import Swarm.Game.Entity
@@ -50,7 +48,7 @@ import Swarm.Game.State
 import Swarm.Game.State.Landscape (mkLandscape)
 import Swarm.Game.State.Robot (setRobotInfo)
 import Swarm.Game.State.Substate
-import Swarm.Game.Universe as U (offsetBy)
+import Swarm.Game.Step.Util (adaptGameState)
 import Swarm.Game.World.Gen (Seed)
 import Swarm.Language.Capability (constCaps)
 import Swarm.Language.Syntax (allConst, erase)
@@ -183,7 +181,8 @@ mkRecognizer ::
   StaticStructureInfo Cell ->
   m (StructureRecognizer (Maybe Cell) Entity)
 mkRecognizer structInfo@(StaticStructureInfo structDefs _) = do
-  foundIntact <- mapM (sequenceA . (id &&& ensureStructureIntact)) allPlaced
+  foundIntact <- mapM (sequenceA . (id &&& adaptGameState . ensureStructureIntact mtlEntityAt)) allPlaced
+
   let fs = populateStaticFoundStructures . map fst . filter snd $ foundIntact
   return
     $ StructureRecognizer
@@ -199,24 +198,6 @@ mkRecognizer structInfo@(StaticStructureInfo structDefs _) = do
       ((getName . originalDefinition . structureWithGrid) x)
       (upperLeftCorner x)
 
--- | Matches definitions against the placements.
--- Fails fast (short-circuits) if a non-matching
--- cell is encountered.
-ensureStructureIntact ::
-  (Has (State GameState) sig m) =>
-  FoundStructure (Maybe Cell) Entity ->
-  m Bool
-ensureStructureIntact (FoundStructure (StructureWithGrid _ _ _ grid) upperLeft) =
-  allM outer $ zip [0 ..] grid
- where
-  outer (y, row) = allM (inner y) $ zip [0 ..] row
-  inner y (x, maybeTemplateEntity) = case maybeTemplateEntity of
-    Nothing -> return True
-    Just _ ->
-      fmap (== maybeTemplateEntity) $
-        entityAt $
-          upperLeft `offsetBy` V2 x (negate y)
-
 buildTagMap :: EntityMap -> Map Text (NonEmpty EntityName)
 buildTagMap em =
   binTuples expanded

src/swarm-engine/Swarm/Game/Step/Util.hs

@@ -62,6 +62,16 @@ lookInDirection d = do
   let nextLoc = loc `offsetBy` newHeading
   (nextLoc,) <$> entityAt nextLoc
 
+adaptGameState ::
+  Has (State GameState) sig m =>
+  TS.State GameState b ->
+  m b
+adaptGameState f = do
+  oldGS <- get @GameState
+  let (newRecognizer, newGS) = TS.runState f oldGS
+  put newGS
+  return newRecognizer
+
 -- | Modify the entity (if any) at a given location.
 updateEntityAt ::
   (Has (State Robot) sig m, Has (State GameState) sig m) =>
@@ -77,14 +87,9 @@ updateEntityAt cLoc@(Cosmic subworldName loc) upd = do
     currentTick <- use $ temporal . ticks
     myID <- use robotID
     zoomRobots $ wakeWatchingRobots myID currentTick cLoc
-    oldRecognizer <- use $ discovery . structureRecognition
-
-    oldGS <- get @GameState
-    let (newRecognizer, newGS) =
-          flip TS.runState oldGS $
-            SRT.entityModified mtlEntityAt modType cLoc oldRecognizer
-    put newGS
 
+    oldRecognizer <- use $ discovery . structureRecognition
+    newRecognizer <- adaptGameState $ SRT.entityModified mtlEntityAt modType cLoc oldRecognizer
     discovery . structureRecognition .= newRecognizer
 
     pcr <- use $ pathCaching . pathCachingRobots

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

@@ -6,8 +6,13 @@ module Swarm.Game.Scenario.Topography.Structure.Recognition.Log where
 
 import Data.Aeson
 import Data.Int (Int32)
+import Data.IntSet qualified as IS
+import Data.IntSet.NonEmpty (NEIntSet)
+import Data.IntSet.NonEmpty qualified as NEIS
 import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty qualified as NE
 import GHC.Generics (Generic)
+import Linear (V2)
 import Servant.Docs (ToSample)
 import Servant.Docs qualified as SD
 import Swarm.Game.Location (Location)
@@ -29,31 +34,6 @@ data OrientedStructure = OrientedStructure
 distillLabel :: StructureWithGrid b a -> OrientedStructure
 distillLabel swg = OrientedStructure (getName $ originalDefinition swg) (rotatedTo swg)
 
-data MatchingRowFrom = MatchingRowFrom
-  { topDownRowIdx :: Int32
-  -- ^ numbered from the top down
-  , structure :: OrientedStructure
-  }
-  deriving (Generic, ToJSON)
-
-newtype HaystackPosition = HaystackPosition Int
-  deriving (Generic, ToJSON)
-
-data HaystackContext e = HaystackContext
-  { maskedWorldRow :: WorldRowContent e
-  -- ^ entities that do not constitute any of the eligible structures
-  -- are replaced with 'null' in this list.
-  , haystackPosition :: HaystackPosition
-  }
-  deriving (Functor, Generic, ToJSON)
-
-data FoundRowCandidate e = FoundRowCandidate
-  { haystackContext :: HaystackContext e
-  , soughtContent :: StructureRowContent e
-  , matchedCandidates :: [MatchingRowFrom]
-  }
-  deriving (Functor, Generic, ToJSON)
-
 data EntityKeyedFinder e = EntityKeyedFinder
   { searchOffsets :: InspectionOffsets
   , candidateStructureRows :: NonEmpty (StructureRowContent e)
@@ -76,22 +56,96 @@ 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]
+data ChunkMatchFailureReason e
+  = ChunkMatchFailureReason OriginalName (RowMismatchReason e)
+  deriving (Functor, Generic, ToJSON)
+
+data FoundChunkComparison e = FoundChunkComparison
+  { foundChunkKeys :: [NonEmpty e]
+  , referenceChunkKeys :: [NonEmpty e]
+  }
+  deriving (Functor, Generic, ToJSON)
+
+data RowMismatchReason e
+  = NoKeysSubset (FoundChunkComparison e)
+  | -- | NOTE: should be redundant with 'NoKeysSubset'
+    EmptyIntersection
+  deriving (Functor, Generic, ToJSON)
+
+data WrongRecurrenceCountExplanation = WrongRecurrenceCountExplanation
+  { foundCount :: Int
+  , foundMembers :: NonEmpty Int
+  , expectedCount :: Int
+  , expectedMembers :: NonEmpty Int
+  }
+  deriving (Generic, ToJSON)
+
+-- | The located occurrences of a specific contiguous chunk of entities.
+-- Note that an identical chunk may recur more than once in a structure row.
+-- This record represents all of the recurrences of one such chunk.
+--
+-- Any different chunks contained within a row will be described by
+-- their own instance of this record.
+--
+-- Note: By virtue of the searching algorithm, these indices
+-- are expected to automatically be in sorted order
+data FoundAndExpectedChunkPositions = FoundAndExpectedChunkPositions
+  { foundPositions :: NEIntSet
+  , expectedPositions :: NEIntSet
+  }
+  deriving (Generic, ToJSON)
+
+-- | We only have to do this once, for the "smallest" chunk occurrence size discrepancy.
+-- All subsequent chunks will merely filter on this initial set.
+generatePossibleOffsets :: (Int, FoundAndExpectedChunkPositions) -> Maybe NEIntSet
+generatePossibleOffsets (sizeDifference, FoundAndExpectedChunkPositions found expected) =
+  NEIS.nonEmptySet $ IS.fromList possibleOffsets
+ where
+  possibleOffsets =
+    NE.take (sizeDifference + 1) $
+      NE.map (subtract (NEIS.findMin expected)) sortedFound
+
+  sortedFound = NEIS.toAscList found
+
+-- | Return all of the offsets that are viable for repetitions of this chunk.
+--
+-- Note that if there are an equal number of observed occurrences
+-- and expected occurrences, then there is only one possible offset.
+-- If there are N expected and (N + 1) observed, then there are 2 possible offsets.
+findCoveringOffsets :: NEIntSet -> FoundAndExpectedChunkPositions -> Maybe NEIntSet
+findCoveringOffsets possibleOffsets x =
+  NEIS.nonEmptySet $ NEIS.filter (isCoveredWithOffset x) possibleOffsets
+
+isCoveredWithOffset :: FoundAndExpectedChunkPositions -> Int -> Bool
+isCoveredWithOffset (FoundAndExpectedChunkPositions found expected) offset =
+  NEIS.map (+ offset) expected `NEIS.isSubsetOf` found
+
+data FoundRowFromChunk a = FoundRowFromChunk
+  { chunkOffsetFromSearchBorder :: Int
+  , rowIndexWithinStructure :: Int32
+  , structurePositionOffset :: V2 Int32
+  , chunkStructure :: a
+  }
+  deriving (Functor, Generic, ToJSON)
+
+data ChunkedRowMatch a e = ChunkedRowMatch
+  { positionsComparison :: [(FoundAndExpectedChunkPositions, NonEmpty e)]
+  , foundChunkRow :: FoundRowFromChunk a
   }
   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 [VerticalSearch e]
+  | -- | this is actually internally used as a (Map (NonEmpty e) (NonEmpty Int)),
+    -- but the requirements of Functor force us to invert the mapping
+    FoundPiecewiseChunks [(NonEmpty Int, NonEmpty e)]
+  | ExpectedChunks (NonEmpty [NonEmpty e])
+  | StartSearchAt (Cosmic Location) InspectionOffsets
+  | ChunksMatchingExpected [ChunkedRowMatch OriginalName e]
+  | ChunkFailures [ChunkMatchFailureReason e]
+  | ChunkIntactnessVerification IntactPlacementLog
   | IntactStaticPlacement [IntactPlacementLog]
   deriving (Functor, Generic)