refactor

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

@@ -17,4 +17,3 @@
 2115-encroaching-upon-exterior-transparent-cells.yaml
 2115-encroaching-upon-interior-transparent-cells.yaml
 2201-piecewise-lines.yaml
-2201-piecewise-solid.yaml

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

@@ -67,8 +67,7 @@ adaptGameState ::
   TS.State GameState b ->
   m b
 adaptGameState f = do
-  oldGS <- get
-  let (newRecognizer, newGS) = TS.runState f oldGS
+  (newRecognizer, newGS) <- TS.runState f <$> get
   put newGS
   return newRecognizer
 

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

@@ -1,27 +1,24 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 -- |
 -- SPDX-License-Identifier: BSD-3-Clause
 --
 -- Types strictly for debugging structure recognition via the web interface
 module Swarm.Game.Scenario.Topography.Structure.Recognition.Log where
 
 import Data.Aeson
-import Data.Int (Int32)
-import Data.IntSet.NonEmpty (NEIntSet)
 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 Linear (V2)
 import Servant.Docs (ToSample)
 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)
 
--- | Type aliases for documentation
-type StructureRowContent e = SymbolSequence e
-
-type WorldRowContent e = SymbolSequence e
-
 data OrientedStructure = OrientedStructure
   { oName :: OriginalName
   , oDir :: AbsoluteDir
@@ -31,6 +28,10 @@ data OrientedStructure = OrientedStructure
 distillLabel :: StructureWithGrid b a -> OrientedStructure
 distillLabel swg = OrientedStructure (getName $ originalDefinition swg) (rotatedTo swg)
 
+renderSharedNames :: ConsolidatedRowReferences b a -> Text
+renderSharedNames =
+  T.intercalate "/" . NE.toList . NE.nub . NE.map (getName . originalDefinition . wholeStructure) . referencingRows
+
 newtype EntityKeyedFinder = EntityKeyedFinder
   { searchOffsets :: InspectionOffsets
   }
@@ -65,56 +66,19 @@ data RowMismatchReason e
     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)
-
-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
-  | FoundCompleteStructureCandidates [OrientedStructure]
+  = IntactStaticPlacement [IntactPlacementLog]
+  | 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])
-  | StartSearchAt (Cosmic Location) InspectionOffsets
   | ChunksMatchingExpected [ChunkedRowMatch OriginalName e]
   | ChunkFailures [ChunkMatchFailureReason e]
   | ChunkIntactnessVerification IntactPlacementLog
-  | IntactStaticPlacement [IntactPlacementLog]
+  | StructureRemoved OriginalName
   deriving (Functor, Generic)
 
 instance (ToJSON e) => ToJSON (SearchLog e) where

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
@@ -50,10 +48,10 @@ import Data.Hashable (Hashable)
 import Data.Map qualified as M
 import Data.Maybe (catMaybes, mapMaybe)
 import Data.Set qualified as Set
-import Linear (V2 (..))
-import Swarm.Game.Location (Location)
+import Data.Tuple (swap)
+import Swarm.Game.Location (Location, asVector)
 import Swarm.Game.Scenario.Topography.Area (getGridDimensions, rectWidth)
-import Swarm.Game.Scenario.Topography.Grid (getRows)
+import Swarm.Game.Scenario.Topography.Grid (getRows, mapIndexedMembers, mkGrid)
 import Swarm.Game.Scenario.Topography.Placement (Orientation (..), applyOrientationTransform, getStructureName)
 import Swarm.Game.Scenario.Topography.Structure.Named
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Prep (
@@ -65,6 +63,7 @@ import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Static
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
 import Swarm.Game.Universe (Cosmic (..), offsetBy)
+import Swarm.Game.World.Coords (coordsToLoc)
 import Swarm.Language.Syntax.Direction (AbsoluteDir)
 import Swarm.Util (histogram)
 
@@ -145,22 +144,22 @@ lookupStaticPlacements extractor (StaticStructureInfo structDefs thePlacements)
 -- | Matches definitions against the placements.
 -- Fails fast (short-circuits) if a non-matching
 -- cell is encountered.
+--
+-- Returns 'Nothing' if there is no discrepancy between the match subject and world content.
+-- Returns the first observed mismatch cell otherwise.
 ensureStructureIntact ::
   (Monad s, Hashable a) =>
   GenericEntLocator s a ->
   FoundStructure b a ->
   s Bool
-ensureStructureIntact entLoader (FoundStructure (StructureWithGrid _ _ _ grid) upperLeft) =
-  allM outer $ zip [0 ..] grid
+ensureStructureIntact entLoader (FoundStructure (StructureWithGrid _ _ _ grid) upperLeft) = do
+  allM checkLoc allLocPairs
  where
-  outer (y, row) = allM (inner y) $ zip [0 ..] row
-  inner y (x, maybeTemplateEntity) = case maybeTemplateEntity of
+  checkLoc (maybeTemplateEntity, loc) = case maybeTemplateEntity of
     Nothing -> return True
-    Just _ ->
-      fmap (== maybeTemplateEntity) $
-        entLoader $
-          mkLoc x y
+    Just x -> (== Just x) <$> entLoader loc
 
   -- 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 y = upperLeft `offsetBy` V2 x (negate y)
+  f = fmap ((upperLeft `offsetBy`) . asVector . coordsToLoc) . swap
+  allLocPairs = mapIndexedMembers (curry f) $ mkGrid grid

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

@@ -54,46 +54,57 @@ mkOffsets pos (RowWidth w) =
 mkEntityLookup ::
   (Hashable a, Eq a) =>
   [StructureWithGrid b a] ->
-  HM.HashMap a (AutomatonNewInfo b a)
+  HM.HashMap a (AutomatonInfo b a)
 mkEntityLookup grids =
   HM.map mkRowAutomatons rowsByEntityParticipation
  where
   -- Produces an automaton to evaluate whenever a given entity
   -- is encountered.
   mkRowAutomatons neList =
-    AutomatonNewInfo bounds $
-      PiecewiseRecognition smPiecewise extractedChunksForLookup
+    AutomatonInfo bounds $
+      PiecewiseRecognition chunksStateMachine extractedChunksForLookup
    where
     bounds = sconcat $ NE.map expandedOffsets neList
 
-    extractedChunksForStateMachine =
-      HS.fromList . concat . NE.toList $
-        NE.map (map chunkContents . contiguousChunks) neList
-
-    -- TODO: These should be grouped by
-    -- row content to avoid redundant checks
+    -- 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
 
-    smPiecewise =
+    extractedChunksForStateMachine =
+      HS.fromList . concat . NE.toList $
+        NE.map (map chunkContents . contiguousChunks) neList
+
+    -- 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 each structure, even if some of those
   -- rows contain repetition of the same entity.
-  -- That is not to say that there are not recurrences of identical rows,
-  -- though, if the same structure or a different structure has some identical rows.
   rowsByEntityParticipation =
     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
 
-getContiguousChunks :: [Maybe a] -> [PositionedChunk a]
+-- | Utilizes the convenient 'wordsBy' function
+-- from the "split" package.
+getContiguousChunks :: SymbolSequence a -> [PositionedChunk a]
 getContiguousChunks rowMembers =
   map mkChunk
     . mapMaybe (NE.nonEmpty . mapMaybe sequenceA)
@@ -109,9 +120,9 @@ getContiguousChunks rowMembers =
 -- are dropped but accounted for positionally when indexing the columns.
 explodeRowEntities ::
   (Hashable a, Eq a) =>
-  StructureRow b a ->
+  ConsolidatedRowReferences b a ->
   [SingleRowEntityOccurrences b a]
-explodeRowEntities annotatedRow@(StructureRow _ _ rowMembers) =
+explodeRowEntities annotatedRow@(ConsolidatedRowReferences rowMembers _ width) =
   map f $ HM.toList $ binTuplesHM unconsolidatedEntityOccurrences
  where
   chunks = getContiguousChunks rowMembers
@@ -130,8 +141,7 @@ explodeRowEntities annotatedRow@(StructureRow _ _ rowMembers) =
         zipWith (\idx -> fmap (PositionWithinRow idx annotatedRow,)) [0 ..] rowMembers
 
   deriveEntityOffsets :: PositionWithinRow b a -> InspectionOffsets
-  deriveEntityOffsets (PositionWithinRow pos r) =
-    mkOffsets pos $ gridWidth $ wholeStructure r
+  deriveEntityOffsets (PositionWithinRow pos _) = mkOffsets pos width
 
 -- * Util