move more recognizer logic into topography sublibrary

src/swarm-scenario/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs

@@ -37,21 +37,15 @@ module Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute (
   -- * Helper functions
   populateStaticFoundStructures,
   getEntityGrid,
-  extractGrids,
   lookupStaticPlacements,
 ) where
 
 import Control.Arrow ((&&&))
 import Control.Lens (view)
-import Data.Hashable (Hashable)
-import Data.Int (Int32)
-import Data.List.NonEmpty qualified as NE
 import Data.Map qualified as M
 import Data.Maybe (catMaybes, mapMaybe)
-import Data.Semigroup (sconcat)
-import Data.Set qualified as S
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Prep
 import Data.Set qualified as Set
-import Data.Tuple (swap)
 import Swarm.Game.Entity (Entity, EntityName, entityName)
 import Swarm.Game.Scenario (StaticStructureInfo (..))
 import Swarm.Game.Scenario.Topography.Cell (PCell, cellEntity)
@@ -62,115 +56,12 @@ import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
 import Swarm.Game.Universe (Cosmic (..))
 import Swarm.Language.Syntax.Direction (AbsoluteDir)
-import Swarm.Util (binTuples, histogram)
+import Swarm.Util (histogram)
 import Swarm.Util.Erasable (erasableToMaybe)
-import Text.AhoCorasick
 
 getEntityGrid :: Grid (Maybe (PCell Entity)) -> [SymbolSequence Entity]
 getEntityGrid = map (map ((erasableToMaybe . cellEntity) =<<)) . getRows
 
-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, Ord en) =>
-  (a -> en) ->
-  NE.NonEmpty (StructureRow b a) ->
-  AutomatonInfo en (SymbolSequence a) (StructureWithGrid b a)
-mkRowLookup nameFunc neList =
-  AutomatonInfo participatingEnts bounds sm
- where
-  mkSmTuple = entityGrid &&& id
-  tuples = NE.toList $ NE.map (mkSmTuple . wholeStructure) neList
-
-  -- All of the unique entities across all of the full candidate structures
-  participatingEnts =
-    S.fromList $
-      map nameFunc $
-        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 tuples
-
--- | Make the first-phase lookup map, keyed by 'Entity',
--- along with automatons whose key symbols are "Maybe Entity".
---
--- 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).
-mkEntityLookup ::
-  (Hashable a, Ord a, Ord en) =>
-  (a -> en) ->
-  [StructureWithGrid b a] ->
-  M.Map a (AutomatonInfo en (AtomicKeySymbol a) (StructureSearcher b en a))
-mkEntityLookup nameFunc grids =
-  M.map mkValues 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 nameFunc structureRowsNE
-
-  mkValues neList = AutomatonInfo participatingEnts bounds sm
-   where
-    participatingEnts =
-      (S.fromList . map nameFunc)
-        (concatMap (catMaybes . fst) tuples)
-
-    tuples = M.toList $ M.mapWithKey mkSmValue groupedByUniqueRow
-
-    groupedByUniqueRow = binTuples $ NE.toList $ NE.map (rowContent . myRow &&& id) neList
-    bounds = sconcat $ NE.map expandedOffsets neList
-    sm = makeStateMachine tuples
-
-  -- The values of this map are guaranteed to contain only one
-  -- entry per row of a given structure.
-  rowsByEntityParticipation =
-    binTuples $
-      map (myEntity &&& id) $
-        concatMap explodeRowEntities rowsAcrossAllStructures
-
-  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 :: Ord a => StructureRow b a -> [SingleRowEntityOccurrences b a]
-  explodeRowEntities r@(StructureRow _ _ rowMembers) =
-    map f $ M.toList $ binTuples unconsolidated
-   where
-    f (e, occurrences) =
-      SingleRowEntityOccurrences r e occurrences $
-        sconcat $
-          NE.map deriveEntityOffsets occurrences
-    unconsolidated =
-      map swap $
-        catMaybes $
-          zipWith (\idx -> fmap (PositionWithinRow idx r,)) [0 ..] rowMembers
-
 -- | Create Aho-Corasick matchers that will recognize all of the
 -- provided structure definitions
 mkAutomatons ::

swarm.cabal

@@ -221,6 +221,7 @@ library swarm-topography
     Swarm.Game.Scenario.Topography.Structure.Overlay
     Swarm.Game.Scenario.Topography.Structure.Recognition
     Swarm.Game.Scenario.Topography.Structure.Recognition.Log
+    Swarm.Game.Scenario.Topography.Structure.Recognition.Prep
     Swarm.Game.Scenario.Topography.Structure.Recognition.Registry
     Swarm.Game.Scenario.Topography.Structure.Recognition.Symmetry
     Swarm.Game.Scenario.Topography.Structure.Recognition.Type
@@ -238,6 +239,7 @@ library swarm-topography
     containers >=0.6.2 && <0.8,
     extra >=1.7 && <1.8,
     lens,
+    hashable,
     linear >=1.21.6 && <1.24,
     nonempty-containers >=0.3.4 && <0.3.5,
     servant-docs >=0.12 && <0.14,
@@ -308,7 +310,6 @@ library swarm-scenario
   other-modules: Paths_swarm
   autogen-modules: Paths_swarm
   build-depends:
-    AhoCorasick >=0.0.4 && <0.0.5,
     JuicyPixels >=3.3 && <3.4,
     aeson >=2.2 && <2.3,
     array >=0.5.4 && <0.6,