From f702056a3d2bed5b786c2858b76b888f4d0988eb Mon Sep 17 00:00:00 2001
From: Karl Ostmo <kostmo@gmail.com>
Date: Sat, 2 Nov 2024 18:50:00 -0700
Subject: [PATCH 1/3] Structure recognition with discontiguous row chunks

---
 .../1575-structure-recognizer/00-ORDER.txt    |   1 +
 .../2201-piecewise-lines.yaml                 | 110 +++++
 .../Topography/Structure/Recognition/Log.hs   |  91 ++--
 .../Structure/Recognition/Precompute.hs       |  16 +-
 .../Topography/Structure/Recognition/Prep.hs  | 208 ++++-----
 .../Structure/Recognition/Tracking.hs         | 395 +++++++++++-------
 .../Topography/Structure/Recognition/Type.hs  |  95 +++--
 swarm.cabal                                   |   1 +
 test/integration/Main.hs                      |   1 +
 9 files changed, 568 insertions(+), 350 deletions(-)
 create mode 100644 data/scenarios/Testing/1575-structure-recognizer/2201-piecewise-lines.yaml

diff --git a/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt b/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt
index 00d044fa0..aad980a98 100644
--- a/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt
+++ b/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt
@@ -16,3 +16,4 @@
 1644-rotated-preplacement-recognition.yaml
 2115-encroaching-upon-exterior-transparent-cells.yaml
 2115-encroaching-upon-interior-transparent-cells.yaml
+2201-piecewise-lines.yaml
diff --git a/data/scenarios/Testing/1575-structure-recognizer/2201-piecewise-lines.yaml b/data/scenarios/Testing/1575-structure-recognizer/2201-piecewise-lines.yaml
new file mode 100644
index 000000000..802deee3b
--- /dev/null
+++ b/data/scenarios/Testing/1575-structure-recognizer/2201-piecewise-lines.yaml
@@ -0,0 +1,110 @@
+version: 1
+name: Structure recognition - piecewise row recognition
+description: |
+  Demonstrate general solution for transparency.
+
+  In this scenario, a structure called `spaceship`{=structure} is occluded
+  by a single cell overlay shape called `damage`{=structure}.
+
+  The base swaps the "damage" entity with the correct part.
+creative: false
+objectives:
+  - teaser: Recognize structure
+    goal:
+      - |
+        `spaceship`{=structure} structure should be recognized upon completion.
+    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.......
+    ..........
+    ..........
+    ..........
diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Log.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Log.hs
index 352a00d68..02d842b89 100644
--- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Log.hs
+++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Log.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 -- |
 -- SPDX-License-Identifier: BSD-3-Clause
 --
@@ -5,8 +7,10 @@
 module Swarm.Game.Scenario.Topography.Structure.Recognition.Log where
 
 import Data.Aeson
-import Data.Int (Int32)
 import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty qualified as NE
+import Data.Text (Text)
+import Data.Text qualified as T
 import GHC.Generics (Generic)
 import Servant.Docs (ToSample)
 import Servant.Docs qualified as SD
@@ -15,11 +19,6 @@ import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
 import Swarm.Game.Universe (Cosmic)
 import Swarm.Language.Syntax.Direction (AbsoluteDir)
 
--- | Type aliases for documentation
-type StructureRowContent e = SymbolSequence e
-
-type WorldRowContent e = SymbolSequence e
-
 data OrientedStructure = OrientedStructure
   { oName :: OriginalName
   , oDir :: AbsoluteDir
@@ -29,70 +28,54 @@ 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)
+renderSharedNames :: ConsolidatedRowReferences b a -> Text
+renderSharedNames =
+  T.intercalate "/" . NE.toList . NE.nub . NE.map (getName . originalDefinition . wholeStructure) . referencingRows
 
-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
+data ParticipatingEntity e = ParticipatingEntity
+  { entity :: e
+  , searchOffsets :: InspectionOffsets
   }
   deriving (Functor, Generic, ToJSON)
 
-data FoundRowCandidate e = FoundRowCandidate
-  { haystackContext :: HaystackContext e
-  , soughtContent :: StructureRowContent e
-  , matchedCandidates :: [MatchingRowFrom]
+data IntactPlacementLog e = IntactPlacementLog
+  { intactnessFailure :: Maybe (StructureIntactnessFailure e)
+  , sName :: OriginalName
+  , locUpperLeft :: Cosmic Location
   }
   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.
-  }
+data ChunkMatchFailureReason e
+  = ChunkMatchFailureReason OriginalName (RowMismatchReason e)
   deriving (Functor, Generic, ToJSON)
 
-data ParticipatingEntity e = ParticipatingEntity
-  { entity :: e
-  , entityKeyedFinders :: NonEmpty (EntityKeyedFinder e)
+data FoundChunkComparison e = FoundChunkComparison
+  { foundChunkKeys :: [NonEmpty e]
+  , referenceChunkKeys :: [NonEmpty e]
   }
   deriving (Functor, Generic, ToJSON)
 
-data IntactPlacementLog = IntactPlacementLog
-  { intactnessFailure :: Maybe StructureIntactnessFailure
-  , sName :: OriginalName
-  , locUpperLeft :: Cosmic Location
-  }
-  deriving (Generic, ToJSON)
-
-data VerticalSearch e = VerticalSearch
-  { haystackVerticalExtents :: InspectionOffsets
-  -- ^ vertical offset of haystack relative to the found row
-  , soughtStructures :: [OrientedStructure]
-  , verticalHaystack :: [WorldRowContent e]
-  }
+data RowMismatchReason e
+  = NoKeysSubset (FoundChunkComparison e)
+  | -- | NOTE: we should never see 'EmptyIntersection',
+    -- since the earlier 'NoKeysSubset' condition
+    -- results in an empty intersection
+    EmptyIntersection
   deriving (Functor, Generic, ToJSON)
 
 data SearchLog e
-  = FoundParticipatingEntity (ParticipatingEntity e)
+  = IntactStaticPlacement [IntactPlacementLog e]
+  | StartSearchAt (Cosmic Location) InspectionOffsets
+  | FoundParticipatingEntity (ParticipatingEntity e)
+  | FoundCompleteStructureCandidates [(OrientedStructure, Cosmic Location)]
+  | -- | 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])
+  | ChunksMatchingExpected [ChunkedRowMatch OriginalName e]
+  | ChunkFailures [ChunkMatchFailureReason e]
+  | ChunkIntactnessVerification (IntactPlacementLog 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]
-  | IntactStaticPlacement [IntactPlacementLog]
   deriving (Functor, Generic)
 
 instance (ToJSON e) => ToJSON (SearchLog e) where
diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs
index 634cc2463..4ceb257ce 100644
--- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs
+++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs
@@ -17,13 +17,11 @@
 --
 -- The first searching stage looks for any member row of all participating
 -- structure definitions that contains the placed entity.
--- The value returned by the searcher is a second-stage searcher state machine,
--- which this time searches for complete structures of which the found row may
--- be a member.
---
--- Both the first stage and second stage searcher know to start the search
--- at a certain offset horizontally or vertically from the placed entity,
--- based on where within a structure that entity (or row) may occur.
+-- If we observe a row in the world that happens to occur in a structure, we use both
+-- the horizontal found offset and the index of the row within this structure to compute
+-- the expected world location of the candidate structure.
+-- Then we perform a full scan of that candidate structure against the world to verify
+-- the match.
 --
 -- Upon locating a complete structure, it is added to a registry
 -- (see 'Swarm.Game.Scenario.Topography.Structure.Recognition.Registry.FoundRegistry'), which
@@ -156,7 +154,7 @@ ensureStructureIntact ::
   (Monad s, Hashable a) =>
   GenericEntLocator s a ->
   FoundStructure b a ->
-  s (Maybe StructureIntactnessFailure)
+  s (Maybe (StructureIntactnessFailure a))
 ensureStructureIntact entLoader (FoundStructure (StructureWithGrid _ _ (RowWidth w) grid) upperLeft) = do
   fmap leftToMaybe . runExceptT . mapM checkLoc $ zip [0 ..] allLocPairs
  where
@@ -166,7 +164,7 @@ ensureStructureIntact entLoader (FoundStructure (StructureWithGrid _ _ (RowWidth
       unless (e == Just x)
         . except
         . Left
-        . StructureIntactnessFailure idx
+        . StructureIntactnessFailure x e idx
         $ fromIntegral w * length grid
 
   f = fmap ((upperLeft `offsetBy`) . asVector . coordsToLoc) . swap
diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Prep.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Prep.hs
index e265fb98c..62999398b 100644
--- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Prep.hs
+++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Prep.hs
@@ -1,6 +1,9 @@
 -- |
 -- SPDX-License-Identifier: BSD-3-Clause
-module Swarm.Game.Scenario.Topography.Structure.Recognition.Prep (mkEntityLookup) where
+module Swarm.Game.Scenario.Topography.Structure.Recognition.Prep (
+  mkEntityLookup,
+  binTuplesHM,
+) where
 
 import Control.Arrow ((&&&))
 import Data.HashMap.Strict qualified as HM
@@ -9,49 +12,38 @@ 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.List.Split (wordsBy)
+import Data.Maybe (catMaybes, mapMaybe)
 import Data.Semigroup (sconcat)
 import Data.Tuple (swap)
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
-import Text.AhoCorasick
+import Text.AhoCorasick (makeStateMachine)
 
+-- | Given all candidate structures, explode them into annotated rows.
+-- These annotations entail both the row index with the original structure
+-- and a reference to the original structure definition.
+--
+-- This operation may result in multiple entries that contain the same contents
+-- (but different annotations), either because the same contents appear
+-- in multiple rows within the same structure, or occur across structures.
 allStructureRows :: [StructureWithGrid b a] -> [StructureRow b a]
 allStructureRows =
   concatMap transformRows
  where
-  transformRows :: StructureWithGrid b a -> [StructureRow b a]
   transformRows g = zipWith (StructureRow g) [0 ..] $ entityGrid g
 
-mkOffsets :: Foldable f => Int32 -> f a -> InspectionOffsets
-mkOffsets pos xs =
-  InspectionOffsets (pure (negate pos)) $
-    pure $
-      fromIntegral (length xs) - 1 - pos
-
--- | Given each possible row of entities observed in the world,
--- yield a searcher that can determine whether adjacent
--- rows constitute a complete structure.
-mkRowLookup ::
-  (Hashable a, Eq a) =>
-  NonEmpty (StructureRow b a) ->
-  AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a)
-mkRowLookup neList =
-  AutomatonInfo participatingEnts bounds sm tuples
+-- | If this entity is encountered in the world,
+-- how far left of it and how far right of it do we need to
+-- scan the world row to ensure we can recognize every possible
+-- structure that features this entity?
+mkOffsets :: Int32 -> RowWidth -> InspectionOffsets
+mkOffsets pos (RowWidth w) =
+  InspectionOffsets
+    (subtractPosFrom 0)
+    (subtractPosFrom rightMostShapeRowIndex)
  where
-  mkSmTuple = entityGrid &&& id
-  tuples = NE.map (mkSmTuple . wholeStructure) neList
-
-  -- All of the unique entities across all of the full candidate structures
-  participatingEnts =
-    HS.fromList $
-      concatMap (concatMap catMaybes . fst) tuples
-
-  deriveRowOffsets :: StructureRow b a -> InspectionOffsets
-  deriveRowOffsets (StructureRow (StructureWithGrid _ _ _ g) rwIdx _) =
-    mkOffsets rwIdx g
-
-  bounds = sconcat $ NE.map deriveRowOffsets neList
-  sm = makeStateMachine $ NE.toList tuples
+  subtractPosFrom minuend = pure $ minuend - pos
+  rightMostShapeRowIndex = w - 1
 
 -- | Make the first-phase lookup map, keyed by 'Entity',
 -- along with automatons whose key symbols are "Maybe Entity".
@@ -59,73 +51,105 @@ mkRowLookup neList =
 -- Each automaton in this first layer will attempt to match the
 -- underlying world row against all rows within all structures
 -- (so long as they contain the keyed entity).
+--
+-- = Preparation steps
+--
+-- 1. Consolidate all identical rows across all structures into a map
+-- 2. Consolidate all entities across these rows into an entity-keyed lookup map
+-- 3. Extract the contiguous chunk from each unique row
+-- 4. Put the expected indices of these chunks into a lookup structure
+-- 5. Prepare Aho-Corasick state machines for recognizing these chunks
 mkEntityLookup ::
   (Hashable a, Eq a) =>
   [StructureWithGrid b a] ->
-  HM.HashMap a (NonEmpty (AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a)))
+  HM.HashMap a (AutomatonInfo b a)
 mkEntityLookup grids =
-  HM.map mkValues rowsByEntityParticipation
+  HM.map mkRowAutomatons rowsByEntityParticipation
  where
-  rowsAcrossAllStructures = allStructureRows grids
-
-  -- The input here are all rows across all structures
-  -- that share the same entity sequence.
-  mkSmValue ksms singleRows =
-    StructureSearcher sm2D ksms singleRows
-   where
-    structureRowsNE = NE.map myRow singleRows
-    sm2D = mkRowLookup structureRowsNE
-
-  mkValues neList =
-    NE.map (\(mask, tups) -> AutomatonInfo mask bounds sm tups) tuplesByEntMask
+  -- Produces an automaton to evaluate whenever a given entity
+  -- is encountered.
+  mkRowAutomatons neList =
+    AutomatonInfo bounds $
+      PiecewiseRecognition chunksStateMachine extractedChunksForLookup
    where
-    -- 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
+    bounds = sconcat $ NE.map expandedOffsets neList
 
-    tuplesByEntMask = binTuplesHMasListNE $ NE.map (getMaskSet . fst &&& id) tuplesNE
+    -- Prepare lookup structure for use with results of the
+    -- Aho-Corasick matcher.
+    extractedChunksForLookup = NE.map f neList
+     where
+      f x = RowChunkMatchingReference (myRow x) (mkRightMap x)
+      mkRightMap = binTuplesHM . map (chunkContents &&& chunkStartPos) . contiguousChunks
 
-    tuplesNE = NE.map (\(a, b) -> (a, mkSmValue a b)) groupedByUniqueRow
+    extractedChunksForStateMachine =
+      HS.fromList . concat . NE.toList $
+        NE.map (map chunkContents . contiguousChunks) neList
 
-    groupedByUniqueRow =
-      binTuplesHMasListNE $
-        NE.map (rowContent . myRow &&& id) neList
-
-    bounds = sconcat $ NE.map expandedOffsets neList
-    sm = makeStateMachine $ NE.toList tuplesNE
+    -- We wrap the entities with 'Just' since the Aho-Corasick
+    -- matcher needs to compare against world cells, which are of 'Maybe' type.
+    chunksStateMachine =
+      makeStateMachine $
+        map (NE.toList . fmap Just &&& id) $
+          HS.toList extractedChunksForStateMachine
 
   -- The values of this map are guaranteed to contain only one
-  -- entry per row of a given structure.
+  -- entry per row of each structure, even if some of those
+  -- rows contain repetition of the same entity.
   rowsByEntityParticipation =
-    binTuplesHM $
-      map (myEntity &&& id) $
-        concatMap explodeRowEntities rowsAcrossAllStructures
+    binTuplesHM
+      . map (myEntity &&& id)
+      . concatMap explodeRowEntities
+      $ structureRowsByContent
+
+  -- Consolidate all identical rows, whether those rows appear in
+  -- same structure or a different structures.
+  structureRowsByContent =
+    map (\(x, y) -> ConsolidatedRowReferences x y . gridWidth . wholeStructure $ NE.head y)
+      . HM.toList
+      . binTuplesHM
+      . map (rowContent &&& id)
+      $ allStructureRows grids
+
+-- | Utilizes the convenient 'wordsBy' function
+-- from the "split" package.
+getContiguousChunks :: SymbolSequence a -> [PositionedChunk a]
+getContiguousChunks rowMembers =
+  map mkChunk
+    . mapMaybe (NE.nonEmpty . mapMaybe sequenceA)
+    . wordsBy (null . snd)
+    $ zip [0 :: Int ..] rowMembers
+ where
+  mkChunk xs = PositionedChunk (fst $ NE.head xs) (NE.map snd xs)
 
-  deriveEntityOffsets :: PositionWithinRow b a -> InspectionOffsets
-  deriveEntityOffsets (PositionWithinRow pos r) =
-    mkOffsets pos $ rowContent r
-
-  -- The members of "rowMembers" are of 'Maybe' type; the 'Nothing's
-  -- are dropped but accounted for when indexing the columns.
-  explodeRowEntities ::
-    (Hashable a, Eq a) =>
-    StructureRow b a ->
-    [SingleRowEntityOccurrences b a]
-  explodeRowEntities r@(StructureRow _ _ rowMembers) =
-    map f $ HM.toList $ binTuplesHM unconsolidated
-   where
-    f (e, occurrences) =
-      SingleRowEntityOccurrences r e occurrences $
-        sconcat $
-          NE.map deriveEntityOffsets occurrences
+-- | All of the occurrences of each unique entity within a row
+-- are consolidated into one record, in which the repetitions are noted.
+--
+-- The members of "rowMembers" are of 'Maybe' type; the 'Nothing's
+-- are dropped but accounted for positionally when indexing the columns.
+explodeRowEntities ::
+  (Hashable a, Eq a) =>
+  ConsolidatedRowReferences b a ->
+  [SingleRowEntityOccurrences b a]
+explodeRowEntities annotatedRow@(ConsolidatedRowReferences rowMembers _ width) =
+  map f $ HM.toList $ binTuplesHM unconsolidatedEntityOccurrences
+ where
+  chunks = getContiguousChunks rowMembers
+
+  f (e, occurrences) =
+    SingleRowEntityOccurrences annotatedRow e chunks $
+      sconcat $
+        NE.map deriveEntityOffsets occurrences
+
+  -- Tuples of (entity, rowOccurrenceOfEntity).
+  -- Only row members for which an entity exists (is not Nothing)
+  -- are retained here.
+  unconsolidatedEntityOccurrences =
+    map swap $
+      catMaybes $
+        zipWith (\idx -> fmap (PositionWithinRow idx annotatedRow,)) [0 ..] rowMembers
 
-    unconsolidated =
-      map swap $
-        catMaybes $
-          zipWith (\idx -> fmap (PositionWithinRow idx r,)) [0 ..] rowMembers
+  deriveEntityOffsets :: PositionWithinRow b a -> InspectionOffsets
+  deriveEntityOffsets (PositionWithinRow pos _) = mkOffsets pos width
 
 -- * Util
 
@@ -138,15 +162,3 @@ binTuplesHM ::
 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
diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Tracking.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Tracking.hs
index a8c2fd0b5..09b9aefcc 100644
--- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Tracking.hs
+++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Tracking.hs
@@ -9,26 +9,34 @@ module Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking (
   entityModified,
 ) where
 
+import Control.Arrow (left, (&&&))
 import Control.Lens ((%~), (&), (.~), (^.))
-import Control.Monad (forM, guard)
+import Control.Monad (foldM, guard, unless)
+import Control.Monad.Extra (findM)
+import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
-import Data.Foldable (foldrM)
+import Control.Monad.Trans.Writer.Strict
+import Data.Either (partitionEithers)
+import Data.Either.Extra (maybeToEither)
+import Data.Function (on)
 import Data.HashMap.Strict qualified as HM
-import Data.HashSet (HashSet)
 import Data.HashSet qualified as HS
 import Data.Hashable (Hashable)
-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 (sortOn)
-import Data.List.NonEmpty.Extra qualified as NE
+import Data.List.NonEmpty qualified as NE
 import Data.Map qualified as M
-import Data.Maybe (listToMaybe)
 import Data.Ord (Down (..))
 import Data.Semigroup (Max (..), Min (..))
+import Data.Tuple (swap)
 import Linear (V2 (..))
 import Swarm.Game.Location (Location)
 import Swarm.Game.Scenario.Topography.Structure.Recognition
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Log
-import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute (GenericEntLocator)
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute (GenericEntLocator, ensureStructureIntact)
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Prep (binTuplesHM)
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
 import Swarm.Game.Scenario.Topography.Terraform
@@ -48,49 +56,47 @@ entityModified ::
   Cosmic Location ->
   StructureRecognizer b a ->
   s (StructureRecognizer b a)
-entityModified entLoader modification cLoc recognizer =
-  case modification of
+entityModified entLoader modification cLoc recognizer = do
+  (val, accumulatedLogs) <- runWriterT $ case modification of
     Add newEntity -> doAddition newEntity recognizer
     Remove _ -> doRemoval
     Swap _ newEntity -> doRemoval >>= doAddition newEntity
+  return $
+    val
+      & recognitionState . recognitionLog %~ (reverse accumulatedLogs <>)
  where
   entLookup = recognizer ^. automatons . automatonsByEntity
 
   doAddition newEntity r = do
-    let oldRecognitionState = r ^. recognitionState
     stateRevision <- case HM.lookup newEntity entLookup of
       Nothing -> return oldRecognitionState
-      Just finders -> do
-        let logFinder f =
-              EntityKeyedFinder
-                (f ^. inspectionOffsets)
-                (NE.map fst $ f ^. searchPairs)
-                (HS.toList $ f ^. participatingEntities)
-            msg =
-              FoundParticipatingEntity $
-                ParticipatingEntity newEntity $
-                  NE.map logFinder finders
-            stateRevision' = oldRecognitionState & recognitionLog %~ (msg :)
-
-        foldrM (registerRowMatches entLoader cLoc) stateRevision' finders
+      Just finder -> do
+        tell . pure . FoundParticipatingEntity $
+          ParticipatingEntity
+            newEntity
+            (finder ^. inspectionOffsets)
+        registerRowMatches entLoader cLoc finder oldRecognitionState
 
     return $ r & recognitionState .~ stateRevision
+   where
+    oldRecognitionState = r ^. recognitionState
 
   doRemoval = do
     -- Entity was removed; may need to remove registered structure.
-    let oldRecognitionState = recognizer ^. recognitionState
-        structureRegistry = oldRecognitionState ^. foundStructures
     stateRevision <- case M.lookup cLoc $ foundByLocation structureRegistry of
       Nothing -> return oldRecognitionState
-      Just fs ->
+      Just fs -> do
+        tell $ pure $ StructureRemoved structureName
         return $
           oldRecognitionState
-            & recognitionLog %~ (StructureRemoved structureName :)
             & foundStructures %~ removeStructure fs
        where
         structureName = getName $ originalDefinition $ structureWithGrid fs
 
     return $ recognizer & recognitionState .~ stateRevision
+   where
+    oldRecognitionState = recognizer ^. recognitionState
+    structureRegistry = oldRecognitionState ^. foundStructures
 
 -- | In case this cell would match a candidate structure,
 -- ensures that the entity in this cell is not already
@@ -100,25 +106,15 @@ entityModified entLoader modification cLoc recognizer =
 -- as 'Nothing' has the effect of "masking" them out,
 -- so that they can overlap empty cells within the bounding
 -- box of the candidate structure.
---
--- Finally, entities that are not members of any candidate
--- structure are also masked out, so that it is OK for them
--- to intrude into the candidate structure's bounding box
--- where the candidate structure has empty cells.
 candidateEntityAt ::
   (Monad s, Hashable a) =>
   GenericEntLocator s a ->
   FoundRegistry b a ->
-  -- | participating entities whitelist. If empty, all entities are included.
-  -- NOTE: This is only needed for structures that have transparent cells.
-  HashSet a ->
   Cosmic Location ->
   s (Maybe a)
-candidateEntityAt entLoader registry participating cLoc = runMaybeT $ do
+candidateEntityAt entLoader registry cLoc = runMaybeT $ do
   guard $ M.notMember cLoc $ foundByLocation registry
-  ent <- MaybeT $ entLoader cLoc
-  guard $ null participating || HS.member ent participating
-  return ent
+  MaybeT $ entLoader cLoc
 
 -- | Excludes entities that are already part of a
 -- registered found structure.
@@ -128,157 +124,232 @@ getWorldRow ::
   FoundRegistry b a ->
   Cosmic Location ->
   InspectionOffsets ->
-  -- | participating entities
-  HashSet a ->
-  Int32 ->
   s [Maybe a]
-getWorldRow entLoader registry cLoc (InspectionOffsets (Min offsetLeft) (Max offsetRight)) participatingEnts yOffset = do
+getWorldRow entLoader registry cLoc (InspectionOffsets (Min offsetLeft) (Max offsetRight)) = do
   mapM getCandidate horizontalOffsets
  where
-  getCandidate = candidateEntityAt entLoader registry participatingEnts
+  getCandidate = candidateEntityAt entLoader registry
   horizontalOffsets = map mkLoc [offsetLeft .. offsetRight]
+  mkLoc x = cLoc `offsetBy` V2 x 0
 
-  -- NOTE: We negate the yOffset because structure rows are numbered increasing from top
-  -- to bottom, but swarm world coordinates increase from bottom to top.
-  mkLoc x = cLoc `offsetBy` V2 x (negate yOffset)
+-- | This runs once per non-overlapping subset of found chunks
+checkChunksCombination ::
+  (Monoid (f (SearchLog a)), Applicative f, Monad m, Hashable a, Eq b) =>
+  Cosmic Location ->
+  InspectionOffsets ->
+  NE.NonEmpty (RowChunkMatchingReference b a) ->
+  [Position (NE.NonEmpty a)] ->
+  WriterT (f (SearchLog a)) m [FoundStructure b a]
+checkChunksCombination
+  cLoc
+  horizontalOffsets
+  rowChunkReferences
+  candidatesChunked = do
+    tell . pure . FoundPiecewiseChunks . map swap . HM.toList $
+      fmap NEIS.elems foundRowChunksLookup
 
-logRowCandidates :: [Maybe e] -> [Position (StructureSearcher b e)] -> SearchLog e
-logRowCandidates entitiesRow candidates =
-  FoundRowCandidates $ map mkCandidateLogEntry candidates
- where
-  mkCandidateLogEntry c =
-    FoundRowCandidate
-      (HaystackContext entitiesRow (HaystackPosition $ pIndex c))
-      (needleContent $ pVal c)
-      rowMatchInfo
+    tell . pure . ChunkFailures $ candidateFailures
+
+    tell . pure . ChunksMatchingExpected $
+      map (modifyChunkedRowMatch $ fmap renderSharedNames) candidateExpected
+
+    return structurePositionsToCheck
    where
-    rowMatchInfo :: [MatchingRowFrom]
-    rowMatchInfo = NE.toList . NE.map (f . myRow) . singleRowItems $ pVal c
+    structurePositionsToCheck = concatMap mkFoundStructures candidateExpected
+
+    candidateExpected = concatMap NE.toList candidateExpectedLists
+
+    foundRowChunksLookup =
+      fmap NEIS.fromList $
+        binTuplesHM $
+          map (pVal &&& pIndex) candidatesChunked
+
+    (candidateFailures, candidateExpectedLists) =
+      partitionEithers $
+        map (checkCandidateAgainstObservedChunks horizontalOffsets foundRowChunksLookup) $
+          NE.toList rowChunkReferences
+
+    mkFoundStructures x =
+      NE.toList $ NE.map mkFoundStructure . referencingRows . chunkStructure $ foundChunkRow x
      where
-      f x =
-        MatchingRowFrom (rowIndex x) $ distillLabel . wholeStructure $ x
+      mkFoundStructure r =
+        FoundStructure
+          (wholeStructure r)
+          (cLoc `offsetBy` theOffset)
+       where
+        theOffset = V2 (horizontalStructPos $ foundChunkRow x) (rowIndex r)
 
--- | This is the first (one-dimensional) stage
--- in a two-stage (two-dimensional) search.
---
--- It searches for any structure row that happens to
+    modifyChunkedRowMatch f (ChunkedRowMatch x y) = ChunkedRowMatch x (f y)
+
+checkCandidateAgainstObservedChunks ::
+  Hashable e =>
+  InspectionOffsets ->
+  HM.HashMap (NE.NonEmpty e) NEIntSet ->
+  RowChunkMatchingReference b e ->
+  Either (ChunkMatchFailureReason e) (NE.NonEmpty (ChunkedRowMatch (ConsolidatedRowReferences b e) e))
+checkCandidateAgainstObservedChunks horizontalOffsets foundRowChunksLookup (RowChunkMatchingReference r chunkPositionMap) =
+  left (ChunkMatchFailureReason $ renderSharedNames r) $ do
+    unless isKeysSubset . Left $
+      NoKeysSubset $
+        (FoundChunkComparison `on` HS.toList) foundChunksKeys referenceChunksKeys
+
+    nonEmptyPairs <-
+      maybeToEither EmptyIntersection $
+        NE.nonEmpty sortedByAlignmentChoices
+
+    let maybeViables = do
+          possibles <- seedPossibleOffsets $ snd $ NE.head nonEmptyPairs
+          foldM findCoveringOffsets possibles $ NE.map (snd . snd) nonEmptyPairs
+
+    viableRowOffsets <- maybeToEither EmptyIntersection maybeViables
+    return $ NE.map mkRowMatch $ NEIS.toList viableRowOffsets
+ where
+  theIntersection =
+    HM.intersectionWith
+      FoundAndExpectedChunkPositions
+      foundRowChunksLookup
+      modifiedChunkPositionMap
+  intersectionWithSizeDifferences = HM.map (sizeDifference &&& id) theIntersection
+   where
+    sizeDifference x = (subtract `on` NEIS.size) (expectedPositions x) (foundPositions x)
+
+  -- Remove the pairings that have fewer occurrences than the required number.
+  -- The 'fst' element of the tuple is the difference between the "observed" and "required" count.
+  withSufficientCoverage = HM.filter ((>= 0) . fst) intersectionWithSizeDifferences
+  sortedByAlignmentChoices = sortOn (fst . snd) $ HM.toList withSufficientCoverage
+
+  isKeysSubset = referenceChunksKeys `HS.isSubsetOf` foundChunksKeys
+
+  mkRowMatch rowOffset =
+    ChunkedRowMatch
+      (map swap $ HM.toList theIntersection)
+      (FoundRowFromChunk rowOffset horizontalStructurePosition r)
+   where
+    horizontalStructurePosition = fromIntegral rowOffset + getMin (startOffset horizontalOffsets)
+
+  modifiedChunkPositionMap = fmap NEIS.fromList chunkPositionMap
+  foundChunksKeys = HM.keysSet foundRowChunksLookup
+  referenceChunksKeys = HM.keysSet chunkPositionMap
+
+-- | Search for any structure row that happens to
 -- contain the placed entity.
 registerRowMatches ::
-  (Monad s, Hashable a, Eq b) =>
+  (Monoid (f (SearchLog a)), Applicative f, Monad s, Hashable a, Eq b) =>
   GenericEntLocator s a ->
   Cosmic Location ->
-  AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a) ->
+  AutomatonInfo b a ->
   RecognitionState b a ->
-  s (RecognitionState b a)
-registerRowMatches entLoader cLoc (AutomatonInfo participatingEnts horizontalOffsets sm _) rState = do
-  maskChoices <- attemptSearchWithEntityMask participatingEnts
+  WriterT (f (SearchLog a)) s (RecognitionState b a)
+registerRowMatches entLoader cLoc (AutomatonInfo horizontalOffsets pwMatcher) rState = do
+  tell $ pure $ StartSearchAt cLoc horizontalOffsets
 
-  let logEntry = uncurry logRowCandidates maskChoices
-      rState2 = rState & recognitionLog %~ (logEntry :)
-      candidates = snd maskChoices
-
-  candidates2Dpairs <-
-    forM candidates $
-      checkVerticalMatch entLoader registry cLoc horizontalOffsets
-
-  let (verticalSpans, candidates2D) = unzip candidates2Dpairs
-      rState3 = rState2 & recognitionLog %~ (VerticalSearchSpans verticalSpans :)
-
-  return $
-    registerStructureMatches (concat candidates2D) rState3
- where
-  registry = rState ^. foundStructures
+  tell . pure . ExpectedChunks $
+    NE.map (HM.keys . confirmationMap) rowChunkReferences
 
-  attemptSearchWithEntityMask entsMask = do
-    entitiesRow <-
+  entitiesRow <-
+    lift $
       getWorldRow
         entLoader
         registry
         cLoc
         horizontalOffsets
-        entsMask
-        0
 
-    -- All of the eligible structure rows found
-    -- within this horizontal swath of world cells
-    return (entitiesRow, findAll sm entitiesRow)
+  let candidatesChunked = findAll pwSM entitiesRow
+  unrankedCandidateStructures <- checkCombo candidatesChunked
 
--- | Examines contiguous rows of entities, accounting
--- for the offset of the initially found row.
-checkVerticalMatch ::
-  (Monad s, Hashable a) =>
-  GenericEntLocator s a ->
-  FoundRegistry b a ->
-  Cosmic Location ->
-  -- | Horizontal search offsets
-  InspectionOffsets ->
-  Position (StructureSearcher b a) ->
-  s (VerticalSearch a, [FoundStructure b a])
-checkVerticalMatch entLoader registry cLoc (InspectionOffsets (Min searchOffsetLeft) _) foundRow = do
-  ((x, y), z) <- getMatches2D entLoader registry cLoc horizontalFoundOffsets $ automaton2D searcherVal
-  return (VerticalSearch x rowStructureNames y, z)
- where
-  searcherVal = pVal foundRow
-  rowStructureNames = NE.toList . NE.map (distillLabel . wholeStructure . myRow) . singleRowItems $ searcherVal
+  -- We only allow an entity to participate in one structure at a time,
+  -- so multiple matches require a tie-breaker.
+  -- The largest structure (by area) shall win.
+  -- Sort by decreasing order of preference.
+  let rankedCandidates = sortOn Down unrankedCandidateStructures
+  tell . pure . FoundCompleteStructureCandidates $
+    map getStructInfo rankedCandidates
 
-  foundLeftOffset = searchOffsetLeft + fromIntegral (pIndex foundRow)
-  foundRightInclusiveIndex = foundLeftOffset + fromIntegral (pLength foundRow) - 1
-  horizontalFoundOffsets = InspectionOffsets (pure foundLeftOffset) (pure foundRightInclusiveIndex)
+  -- We should not check all of the structures, which can be expensive.
+  -- Instead, we ranked the candidates by preference a-priori
+  -- and now choose the first one that is verified.
+  maybeIntactStructure <- findM validateIntactness2d rankedCandidates
 
-getFoundStructures ::
-  Hashable keySymb =>
-  (Int32, Int32) ->
-  Cosmic Location ->
-  StateMachine keySymb (StructureWithGrid b a) ->
-  [keySymb] ->
-  [FoundStructure b a]
-getFoundStructures (offsetTop, offsetLeft) cLoc sm entityRows =
-  map mkFound candidates
+  lift $ registerBestStructureMatch maybeIntactStructure rState
  where
-  candidates = findAll sm entityRows
-  mkFound candidate = FoundStructure (pVal candidate) $ cLoc `offsetBy` loc
-   where
-    -- NOTE: We negate the yOffset because structure rows are numbered increasing from top
-    -- to bottom, but swarm world coordinates increase from bottom to top.
-    loc = V2 offsetLeft $ negate $ offsetTop + fromIntegral (pIndex candidate)
+  registry = rState ^. foundStructures
+  PiecewiseRecognition pwSM rowChunkReferences = pwMatcher
 
-getMatches2D ::
-  (Monad s, Hashable a) =>
-  GenericEntLocator s a ->
-  FoundRegistry b a ->
-  Cosmic Location ->
-  -- | Horizontal found offsets (inclusive indices)
-  InspectionOffsets ->
-  AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a) ->
-  s ((InspectionOffsets, [[Maybe a]]), [FoundStructure b a])
-getMatches2D
-  entLoader
-  registry
-  cLoc
-  horizontalFoundOffsets@(InspectionOffsets (Min offsetLeft) _)
-  (AutomatonInfo participatingEnts vRange@(InspectionOffsets (Min offsetTop) (Max offsetBottom)) sm _) = do
-    entityRows <- mapM getRow vertOffsets
-    return ((vRange, entityRows), getFoundStructures (offsetTop, offsetLeft) cLoc sm entityRows)
-   where
-    getRow = getWorldRow entLoader registry cLoc horizontalFoundOffsets participatingEnts
-    vertOffsets = [offsetTop .. offsetBottom]
+  getStructInfo (FoundStructure swg loc) = (distillLabel swg, loc)
+
+  validateIntactness2d fs = do
+    maybeIntactnessFailure <- lift $ ensureStructureIntact entLoader fs
+    tell . pure . ChunkIntactnessVerification $
+      IntactPlacementLog
+        maybeIntactnessFailure
+        (getName . originalDefinition . structureWithGrid $ fs)
+        (upperLeftCorner fs)
+    return $ null maybeIntactnessFailure
+
+  checkCombo = checkChunksCombination cLoc horizontalOffsets rowChunkReferences
 
 -- |
--- We only allow an entity to participate in one structure at a time,
--- so multiple matches require a tie-breaker.
--- The largest structure (by area) shall win.
-registerStructureMatches ::
-  (Eq a, Eq b) =>
-  [FoundStructure b a] ->
-  RecognitionState b a ->
-  RecognitionState b a
-registerStructureMatches unrankedCandidates oldState =
-  oldState
-    & (recognitionLog %~ (newMsg :))
-    & foundStructures %~ maybe id addFound (listToMaybe rankedCandidates)
+-- For a given "chunk", there could be multiple recurrences.
+-- However, the position of each recurrence is unique
+-- (i.e. the chunk cannot exist twice at the same location).
+--
+-- Either:
+-- A) An observed chunk is "superfluous" w.r.t. matching the candidate, or
+-- B) It is necessary for the match.
+--
+-- The lowest-numbered "reference position" (i.e. in the structure definition)
+-- of a given chunk must align with exactly one "observed position".
+--
+-- The difference between the "observed" position of the chunk that aligns with the
+-- lowest-numbered "reference position" shall be the global "row offset" applied to our observations.
+-- This row offset value applies to all "chunks" (both identical and distinct) that comprise the row.
+--
+-- If a given chunk occurrence is necessary for the match, then we may attempt to use it to compute
+-- the "row offset" by taking its position minus the lowest-numbered "reference position".
+--
+-- We can iterate over each occurrence position in ascending order.
+-- In the ideal case, the first such candidate ends up being the the actual, valid, offset.
+-- Otherwise, we know that all invalid offset candidates encountered before the first valid
+-- offset constitute "superfluous" chunks.
+--
+-- Note that there may exist multiple valid "row offsets".
+-- At most, there will be
+--   {number of observed occurrences} minus {number of required occurrences}
+-- such offsets.
+--
+-- = Performance notes
+--
+-- We only have to do this computation once, and only for the "smallest" size discrepancy
+-- between occurrences and references of a chunk. This generates the "seed" pool of possible offsets.
+-- All subsequent chunks will merely filter on this initial set.
+seedPossibleOffsets :: (Int, FoundAndExpectedChunkPositions) -> Maybe NEIntSet
+seedPossibleOffsets (sizeDifference, FoundAndExpectedChunkPositions found expected) =
+  NEIS.nonEmptySet $ IS.fromList possibleOffsets
  where
-  -- Sorted by decreasing order of preference.
-  rankedCandidates = sortOn Down unrankedCandidates
+  possibleOffsets =
+    NE.take (sizeDifference + 1) $
+      NE.map (subtract (NEIS.findMin expected)) $
+        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
 
-  getStructInfo (FoundStructure swg _) = distillLabel swg
-  newMsg = FoundCompleteStructureCandidates $ map getStructInfo rankedCandidates
+isCoveredWithOffset :: FoundAndExpectedChunkPositions -> Int -> Bool
+isCoveredWithOffset (FoundAndExpectedChunkPositions found expected) offset =
+  NEIS.map (+ offset) expected `NEIS.isSubsetOf` found
+
+registerBestStructureMatch ::
+  (Monad s, Eq a, Eq b) =>
+  Maybe (FoundStructure b a) ->
+  RecognitionState b a ->
+  s (RecognitionState b a)
+registerBestStructureMatch maybeValidCandidate oldState =
+  return $
+    oldState
+      & foundStructures %~ maybe id addFound maybeValidCandidate
diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Type.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Type.hs
index 7344d5de8..1088354b6 100644
--- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Type.hs
+++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Type.hs
@@ -23,8 +23,8 @@ import Control.Lens (makeLenses)
 import Data.Aeson (ToJSON)
 import Data.Function (on)
 import Data.HashMap.Strict (HashMap)
-import Data.HashSet (HashSet)
 import Data.Int (Int32)
+import Data.IntSet.NonEmpty (NEIntSet)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Map (Map)
 import Data.Maybe (catMaybes)
@@ -68,15 +68,6 @@ type AtomicKeySymbol a = Maybe a
 -- @
 type SymbolSequence a = [AtomicKeySymbol a]
 
--- | This is returned as a value of the 1-D searcher.
--- It contains search automatons customized to the 2-D structures
--- that may possibly contain the row found by the 1-D searcher.
-data StructureSearcher b a = StructureSearcher
-  { automaton2D :: AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a)
-  , needleContent :: SymbolSequence a
-  , singleRowItems :: NonEmpty (SingleRowEntityOccurrences b a)
-  }
-
 -- |
 -- Position specific to a single entity within a horizontal row.
 --
@@ -91,7 +82,29 @@ data StructureSearcher b a = StructureSearcher
 data PositionWithinRow b a = PositionWithinRow
   { _position :: Int32
   -- ^ horizontal index of the entity within the row
-  , structureRow :: StructureRow b a
+  , structureRow :: ConsolidatedRowReferences b a
+  }
+
+-- | A chunkified version of a structure row.
+-- Each unique structure row will need to test one of these
+-- against the world row being examined.
+data RowChunkMatchingReference b a = RowChunkMatchingReference
+  { locatableRows :: ConsolidatedRowReferences b a
+  , confirmationMap :: HashMap (NonEmpty a) (NonEmpty Int)
+  }
+
+data PiecewiseRecognition b a = PiecewiseRecognition
+  { piecewiseSM :: StateMachine (AtomicKeySymbol a) (NonEmpty a)
+  , picewiseLookup :: NonEmpty (RowChunkMatchingReference b a)
+  -- ^ A lookup structure for use with results of the
+  -- Aho-Corasick matcher. This lookup will determine whether
+  -- the discontiguous "chunks" found by the matcher occur at
+  -- the right positions with respect to the reference structure.
+  }
+
+data PositionedChunk a = PositionedChunk
+  { chunkStartPos :: Int
+  , chunkContents :: NonEmpty a
   }
 
 -- Represents all of the locations that particular entity
@@ -106,9 +119,9 @@ data PositionWithinRow b a = PositionWithinRow
 --
 -- this record will contain two entries in its 'entityOccurrences' field.
 data SingleRowEntityOccurrences b a = SingleRowEntityOccurrences
-  { myRow :: StructureRow b a
+  { myRow :: ConsolidatedRowReferences b a
   , myEntity :: a
-  , entityOccurrences :: NonEmpty (PositionWithinRow b a)
+  , contiguousChunks :: [PositionedChunk a]
   , expandedOffsets :: InspectionOffsets
   }
 
@@ -137,6 +150,14 @@ data StructureRow b a = StructureRow
   , rowContent :: SymbolSequence a
   }
 
+-- | Represents all rows across all structures that share
+-- a particular row content
+data ConsolidatedRowReferences b a = ConsolidatedRowReferences
+  { sharedRowContent :: SymbolSequence a
+  , referencingRows :: NonEmpty (StructureRow b a)
+  , theRowWidth :: RowWidth
+  }
+
 -- | This wrapper facilitates naming the original structure
 -- (i.e. the "payload" for recognition)
 -- for the purpose of both UI display and internal uniqueness,
@@ -194,16 +215,9 @@ instance Semigroup InspectionOffsets where
   InspectionOffsets l1 r1 <> InspectionOffsets l2 r2 =
     InspectionOffsets (l1 <> l2) (r1 <> r2)
 
--- | Each automaton shall be initialized to recognize
--- a certain subset of structure rows, that may either
--- all be within one structure, or span multiple structures.
-data AutomatonInfo en k v = AutomatonInfo
-  { _participatingEntities :: HashSet en
-  , _inspectionOffsets :: InspectionOffsets
-  , _automaton :: StateMachine k v
-  , _searchPairs :: NonEmpty ([k], v)
-  -- ^ these are the tuples input to the 'makeStateMachine' function,
-  -- for debugging purposes.
+data AutomatonInfo v k = AutomatonInfo
+  { _inspectionOffsets :: InspectionOffsets
+  , _piecewiseRecognizer :: PiecewiseRecognition v k
   }
   deriving (Generic)
 
@@ -215,7 +229,7 @@ data RecognizerAutomatons b a = RecognizerAutomatons
   { _originalStructureDefinitions :: Map OriginalName (StructureInfo b a)
   -- ^ all of the structures that shall participate in automatic recognition.
   -- This list is used only by the UI and by the 'Floorplan' command.
-  , _automatonsByEntity :: HashMap a (NonEmpty (AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a)))
+  , _automatonsByEntity :: HashMap a (AutomatonInfo b a)
   }
   deriving (Generic)
 
@@ -232,12 +246,39 @@ data FoundStructure b a = FoundStructure
   }
   deriving (Eq)
 
-data StructureIntactnessFailure = StructureIntactnessFailure
-  { failedOnIndex :: Int
-  , totalSize :: Int
+data FoundRowFromChunk a = FoundRowFromChunk
+  { chunkOffsetFromSearchBorder :: Int
+  , horizontalStructPos :: Int32
+  , chunkStructure :: a
+  }
+  deriving (Functor, 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.
+data FoundAndExpectedChunkPositions = FoundAndExpectedChunkPositions
+  { foundPositions :: NEIntSet
+  , expectedPositions :: NEIntSet
   }
   deriving (Generic, ToJSON)
 
+data ChunkedRowMatch a e = ChunkedRowMatch
+  { positionsComparison :: [(FoundAndExpectedChunkPositions, NonEmpty e)]
+  , foundChunkRow :: FoundRowFromChunk a
+  }
+  deriving (Functor, Generic, ToJSON)
+
+data StructureIntactnessFailure e = StructureIntactnessFailure
+  { expectedEntity :: e
+  , observedEntity :: AtomicKeySymbol e
+  , failedOnIndex :: Int
+  , totalSize :: Int
+  }
+  deriving (Functor, Generic, ToJSON)
+
 -- | Ordering is by increasing preference between simultaneously
 -- completed structures.
 -- The preference heuristic is for:
diff --git a/swarm.cabal b/swarm.cabal
index 3424b1c65..da9e06722 100644
--- a/swarm.cabal
+++ b/swarm.cabal
@@ -506,6 +506,7 @@ library swarm-topography
     linear,
     nonempty-containers,
     servant-docs,
+    split,
     text,
     transformers,
     unordered-containers,
diff --git a/test/integration/Main.hs b/test/integration/Main.hs
index 73525360e..e86b2d710 100644
--- a/test/integration/Main.hs
+++ b/test/integration/Main.hs
@@ -474,6 +474,7 @@ testScenarioSolutions rs ui key =
             , testSolution Default "Testing/1575-structure-recognizer/1644-rotated-preplacement-recognition"
             , testSolution Default "Testing/1575-structure-recognizer/2115-encroaching-upon-interior-transparent-cells"
             , testSolution Default "Testing/1575-structure-recognizer/2115-encroaching-upon-exterior-transparent-cells"
+            , testSolution Default "Testing/1575-structure-recognizer/2201-piecewise-lines"
             ]
         ]
     , testSolution' Default "Testing/1430-built-robot-ownership" CheckForBadErrors $ \g -> do

From a9ef12a28ce946b69225a9afc0346d8b4a4f5655 Mon Sep 17 00:00:00 2001
From: Karl Ostmo <kostmo@gmail.com>
Date: Sat, 16 Nov 2024 22:04:00 -0800
Subject: [PATCH 2/3] Account for overlap within intactness verification

---
 .../Swarm/Game/State/Initialize.hs            |  7 ++++++-
 .../Topography/Structure/Recognition/Log.hs   | 11 +---------
 .../Structure/Recognition/Precompute.hs       | 14 +++++++++++--
 .../Structure/Recognition/Tracking.hs         |  4 +++-
 .../Topography/Structure/Recognition/Type.hs  | 21 ++++++++++++++++++-
 5 files changed, 42 insertions(+), 15 deletions(-)

diff --git a/src/swarm-engine/Swarm/Game/State/Initialize.hs b/src/swarm-engine/Swarm/Game/State/Initialize.hs
index b88aff783..9df64270e 100644
--- a/src/swarm-engine/Swarm/Game/State/Initialize.hs
+++ b/src/swarm-engine/Swarm/Game/State/Initialize.hs
@@ -42,6 +42,7 @@ import Swarm.Game.Scenario.Topography.Cell (Cell, cellToEntity)
 import Swarm.Game.Scenario.Topography.Structure.Recognition
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Log
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (emptyFoundStructures)
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Static
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
 import Swarm.Game.State
@@ -181,7 +182,7 @@ mkRecognizer ::
   StaticStructureInfo Cell ->
   m (StructureRecognizer (Maybe Cell) Entity)
 mkRecognizer structInfo@(StaticStructureInfo structDefs _) = do
-  foundIntact <- mapM (sequenceA . (id &&& adaptGameState . ensureStructureIntact mtlEntityAt)) allPlaced
+  foundIntact <- mapM checkIntactness allPlaced
 
   let fs = populateStaticFoundStructures . map fst . filter (null . snd) $ foundIntact
   return
@@ -191,6 +192,10 @@ mkRecognizer structInfo@(StaticStructureInfo structDefs _) = do
       fs
       [IntactStaticPlacement $ map mkLogEntry foundIntact]
  where
+  -- NOTE: We assume that all static scenario placements are carefully arranged
+  -- so that overlapping structures are not simultaneously recognized.
+  checkIntactness = sequenceA . (id &&& adaptGameState . ensureStructureIntact emptyFoundStructures mtlEntityAt)
+
   allPlaced = lookupStaticPlacements cellToEntity structInfo
   mkLogEntry (x, intact) =
     IntactPlacementLog
diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Log.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Log.hs
index 02d842b89..a596bb264 100644
--- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Log.hs
+++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Log.hs
@@ -17,16 +17,6 @@ import Servant.Docs qualified as SD
 import Swarm.Game.Location (Location)
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
 import Swarm.Game.Universe (Cosmic)
-import Swarm.Language.Syntax.Direction (AbsoluteDir)
-
-data OrientedStructure = OrientedStructure
-  { oName :: OriginalName
-  , oDir :: AbsoluteDir
-  }
-  deriving (Generic, ToJSON)
-
-distillLabel :: StructureWithGrid b a -> OrientedStructure
-distillLabel swg = OrientedStructure (getName $ originalDefinition swg) (rotatedTo swg)
 
 renderSharedNames :: ConsolidatedRowReferences b a -> Text
 renderSharedNames =
@@ -72,6 +62,7 @@ data SearchLog e
     -- but the requirements of Functor force us to invert the mapping
     FoundPiecewiseChunks [(NonEmpty Int, NonEmpty e)]
   | ExpectedChunks (NonEmpty [NonEmpty e])
+  | WorldRowContent [Maybe e]
   | ChunksMatchingExpected [ChunkedRowMatch OriginalName e]
   | ChunkFailures [ChunkMatchFailureReason e]
   | ChunkIntactnessVerification (IntactPlacementLog e)
diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs
index 4ceb257ce..ba1a49e1c 100644
--- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs
+++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs
@@ -61,6 +61,8 @@ import Swarm.Game.Scenario.Topography.Structure.Recognition.Prep (
   mkEntityLookup,
  )
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (
+  FoundRegistry,
+  foundByLocation,
   populateStaticFoundStructures,
  )
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Static
@@ -152,19 +154,27 @@ lookupStaticPlacements extractor (StaticStructureInfo structDefs thePlacements)
 -- Returns the first observed mismatch cell otherwise.
 ensureStructureIntact ::
   (Monad s, Hashable a) =>
+  FoundRegistry b a ->
   GenericEntLocator s a ->
   FoundStructure b a ->
   s (Maybe (StructureIntactnessFailure a))
-ensureStructureIntact entLoader (FoundStructure (StructureWithGrid _ _ (RowWidth w) grid) upperLeft) = do
+ensureStructureIntact registry entLoader (FoundStructure (StructureWithGrid _ _ (RowWidth w) grid) upperLeft) = do
   fmap leftToMaybe . runExceptT . mapM checkLoc $ zip [0 ..] allLocPairs
  where
   checkLoc (idx, (maybeTemplateEntity, loc)) =
     forM_ maybeTemplateEntity $ \x -> do
       e <- lift $ entLoader loc
+
+      forM_ (M.lookup loc $ foundByLocation registry) $ \s ->
+        except
+          . Left
+          . StructureIntactnessFailure (AlreadyUsedBy $ distillLabel $ structureWithGrid s) idx
+          $ fromIntegral w * length grid
+
       unless (e == Just x)
         . except
         . Left
-        . StructureIntactnessFailure x e idx
+        . StructureIntactnessFailure (DiscrepantEntity $ EntityDiscrepancy x e) idx
         $ fromIntegral w * length grid
 
   f = fmap ((upperLeft `offsetBy`) . asVector . coordsToLoc) . swap
diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Tracking.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Tracking.hs
index 09b9aefcc..3212a5993 100644
--- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Tracking.hs
+++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Tracking.hs
@@ -254,6 +254,8 @@ registerRowMatches entLoader cLoc (AutomatonInfo horizontalOffsets pwMatcher) rS
         cLoc
         horizontalOffsets
 
+  tell . pure . WorldRowContent $ entitiesRow
+
   let candidatesChunked = findAll pwSM entitiesRow
   unrankedCandidateStructures <- checkCombo candidatesChunked
 
@@ -278,7 +280,7 @@ registerRowMatches entLoader cLoc (AutomatonInfo horizontalOffsets pwMatcher) rS
   getStructInfo (FoundStructure swg loc) = (distillLabel swg, loc)
 
   validateIntactness2d fs = do
-    maybeIntactnessFailure <- lift $ ensureStructureIntact entLoader fs
+    maybeIntactnessFailure <- lift $ ensureStructureIntact (rState ^. foundStructures) entLoader fs
     tell . pure . ChunkIntactnessVerification $
       IntactPlacementLog
         maybeIntactnessFailure
diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Type.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Type.hs
index 1088354b6..9d3869e79 100644
--- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Type.hs
+++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Type.hs
@@ -271,9 +271,28 @@ data ChunkedRowMatch a e = ChunkedRowMatch
   }
   deriving (Functor, Generic, ToJSON)
 
-data StructureIntactnessFailure e = StructureIntactnessFailure
+data EntityDiscrepancy e = EntityDiscrepancy
   { expectedEntity :: e
   , observedEntity :: AtomicKeySymbol e
+  }
+  deriving (Functor, Generic, ToJSON)
+
+data OrientedStructure = OrientedStructure
+  { oName :: OriginalName
+  , oDir :: AbsoluteDir
+  }
+  deriving (Generic, ToJSON)
+
+distillLabel :: StructureWithGrid b a -> OrientedStructure
+distillLabel swg = OrientedStructure (getName $ originalDefinition swg) (rotatedTo swg)
+
+data IntactnessFailureReason e
+  = DiscrepantEntity (EntityDiscrepancy e)
+  | AlreadyUsedBy OrientedStructure
+  deriving (Functor, Generic, ToJSON)
+
+data StructureIntactnessFailure e = StructureIntactnessFailure
+  { reason :: IntactnessFailureReason e
   , failedOnIndex :: Int
   , totalSize :: Int
   }

From 2b81e363cfc21d7e1cfc3039923be72c62cd8846 Mon Sep 17 00:00:00 2001
From: Karl Ostmo <kostmo@gmail.com>
Date: Sun, 17 Nov 2024 14:29:16 -0800
Subject: [PATCH 3/3] Add another test for non-overlap

---
 .../1575-structure-recognizer/00-ORDER.txt    |  1 +
 .../2201-piecewise-lines.yaml                 | 17 ----
 ...2201-preclude-overlapping-recognition.yaml | 94 +++++++++++++++++++
 .../Topography/Structure/Recognition/Prep.hs  |  2 +-
 test/integration/Main.hs                      |  1 +
 5 files changed, 97 insertions(+), 18 deletions(-)
 create mode 100644 data/scenarios/Testing/1575-structure-recognizer/2201-preclude-overlapping-recognition.yaml

diff --git a/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt b/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt
index aad980a98..2993b8268 100644
--- a/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt
+++ b/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt
@@ -17,3 +17,4 @@
 2115-encroaching-upon-exterior-transparent-cells.yaml
 2115-encroaching-upon-interior-transparent-cells.yaml
 2201-piecewise-lines.yaml
+2201-preclude-overlapping-recognition.yaml
diff --git a/data/scenarios/Testing/1575-structure-recognizer/2201-piecewise-lines.yaml b/data/scenarios/Testing/1575-structure-recognizer/2201-piecewise-lines.yaml
index 802deee3b..6b371cf99 100644
--- a/data/scenarios/Testing/1575-structure-recognizer/2201-piecewise-lines.yaml
+++ b/data/scenarios/Testing/1575-structure-recognizer/2201-piecewise-lines.yaml
@@ -58,23 +58,6 @@ structures:
         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:
diff --git a/data/scenarios/Testing/1575-structure-recognizer/2201-preclude-overlapping-recognition.yaml b/data/scenarios/Testing/1575-structure-recognizer/2201-preclude-overlapping-recognition.yaml
new file mode 100644
index 000000000..b71153a82
--- /dev/null
+++ b/data/scenarios/Testing/1575-structure-recognizer/2201-preclude-overlapping-recognition.yaml
@@ -0,0 +1,94 @@
+version: 1
+name: Structure recognition - precluding overlaps
+description: |
+  A cell may be a member of at most one structure.
+creative: false
+objectives:
+  - teaser: Recognize one structure
+    goal:
+      - |
+        `line`{=structure} structure should be recognized upon completion.
+    condition: |
+      def isRight = \x. case x (\_. false) (\_. true); end;
+      foundStructure <- structure "line" 0;
+      return $ isRight foundStructure;
+  - teaser: Recognize second structure
+    id: found_elbow
+    optional: true
+    goal:
+      - |
+        `line`{=structure} structure should be recognized upon completion.
+    condition: |
+      def isRight = \x. case x (\_. false) (\_. true); end;
+      foundStructure <- structure "elbow" 0;
+      return $ isRight foundStructure;
+  - teaser: Grab tree
+    prerequisite:
+      not: found_elbow
+    goal:
+      - |
+        `grab` the `tree`{=entity} to indicate we are done with the test.
+    condition: |
+      as base {has "tree"};
+robots:
+  - name: base
+    dir: north
+    devices:
+      - ADT calculator
+      - blueprint
+      - fast grabber
+      - logger
+      - treads
+    inventory:
+      - [5, rock]
+solution: |
+  place "rock"; move;
+  place "rock"; move;
+  place "rock";
+  turn right;
+  move;
+  turn right;
+
+  // Try to complete a second structure
+  place "rock"; move;
+  place "rock";
+
+  // Grab the tree to indicate completion
+  turn left;
+  move;
+  move;
+  move;
+  grab;
+structures:
+  - name: elbow
+    recognize: [north]
+    structure:
+      palette:
+        'x': [stone, rock]
+      mask: '.'
+      map: |
+        xx
+        .x
+  - name: line
+    recognize: [north]
+    structure:
+      palette:
+        'x': [stone, rock]
+      mask: '.'
+      map: |
+        x
+        x
+        x
+known: [rock]
+world:
+  dsl: |
+    {blank}
+  palette:
+    '.': [grass, erase]
+    'T': [grass, tree]
+    'B': [grass, erase, base]
+  upperleft: [0, 0]
+  map: |
+    .......
+    .....T.
+    .B.....
diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Prep.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Prep.hs
index 62999398b..3e6becb2b 100644
--- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Prep.hs
+++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Prep.hs
@@ -56,7 +56,7 @@ mkOffsets pos (RowWidth w) =
 --
 -- 1. Consolidate all identical rows across all structures into a map
 -- 2. Consolidate all entities across these rows into an entity-keyed lookup map
--- 3. Extract the contiguous chunk from each unique row
+-- 3. Extract the contiguous chunks from each unique row
 -- 4. Put the expected indices of these chunks into a lookup structure
 -- 5. Prepare Aho-Corasick state machines for recognizing these chunks
 mkEntityLookup ::
diff --git a/test/integration/Main.hs b/test/integration/Main.hs
index e86b2d710..95f9827be 100644
--- a/test/integration/Main.hs
+++ b/test/integration/Main.hs
@@ -475,6 +475,7 @@ testScenarioSolutions rs ui key =
             , testSolution Default "Testing/1575-structure-recognizer/2115-encroaching-upon-interior-transparent-cells"
             , testSolution Default "Testing/1575-structure-recognizer/2115-encroaching-upon-exterior-transparent-cells"
             , testSolution Default "Testing/1575-structure-recognizer/2201-piecewise-lines"
+            , testSolution Default "Testing/1575-structure-recognizer/2201-preclude-overlapping-recognition"
             ]
         ]
     , testSolution' Default "Testing/1430-built-robot-ownership" CheckForBadErrors $ \g -> do