From e9f47917e8eb9c2fab3fca1e25e8c161be9eb4e8 Mon Sep 17 00:00:00 2001 From: Karl Ostmo Date: Tue, 13 Aug 2024 23:44:24 -0700 Subject: [PATCH 1/2] add tests --- .../1575-structure-recognizer/00-ORDER.txt | 2 + ...ching-upon-exterior-transparent-cells.yaml | 77 +++++++++++++++++ ...ching-upon-interior-transparent-cells.yaml | 85 +++++++++++++++++++ test/integration/Main.hs | 2 + 4 files changed, 166 insertions(+) create mode 100644 data/scenarios/Testing/1575-structure-recognizer/2115-encroaching-upon-exterior-transparent-cells.yaml create mode 100644 data/scenarios/Testing/1575-structure-recognizer/2115-encroaching-upon-interior-transparent-cells.yaml diff --git a/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt b/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt index b6b940335..00d044fa0 100644 --- a/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt +++ b/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt @@ -14,3 +14,5 @@ 1575-bounding-box-overlap.yaml 1644-rotated-recognition.yaml 1644-rotated-preplacement-recognition.yaml +2115-encroaching-upon-exterior-transparent-cells.yaml +2115-encroaching-upon-interior-transparent-cells.yaml diff --git a/data/scenarios/Testing/1575-structure-recognizer/2115-encroaching-upon-exterior-transparent-cells.yaml b/data/scenarios/Testing/1575-structure-recognizer/2115-encroaching-upon-exterior-transparent-cells.yaml new file mode 100644 index 000000000..52f09fcb9 --- /dev/null +++ b/data/scenarios/Testing/1575-structure-recognizer/2115-encroaching-upon-exterior-transparent-cells.yaml @@ -0,0 +1,77 @@ +version: 1 +name: Structure recognition - exterior transparency +description: | + Incursion of an entity of a foreign type + upon a "transparent" cell within the bounding box + of a recognizable structure shall not prevent + the structure from being recognized. + + If the incurring entity is the *same* type as + a participating entity in that structure, however, + it will prevent recognition. +creative: false +objectives: + - teaser: Recognize structure + goal: + - | + `chevron`{=structure} structure should be recognized upon completion, + even with an extraneous entity within its bounds. + condition: | + def isRight = \x. case x (\_. false) (\_. true); end; + + foundBox <- structure "chevron" 0; + return $ isRight foundBox; +robots: + - name: base + dir: east + devices: + - ADT calculator + - blueprint + - fast grabber + - logger + - treads + inventory: + - [1, board] + - name: judge + dir: east + system: true + display: + invisible: true +solution: | + move; move; move; + swap "board"; +structures: + - name: chevron + recognize: [north] + structure: + palette: + 'b': [stone, board] + mask: '.' + map: | + .b + bb + - name: stripe + recognize: [north] + structure: + palette: + 't': [grass, tree] + 'b': [grass, board] + map: | + btb +known: [board, mountain, tree] +world: + dsl: | + {blank} + palette: + '.': [grass, erase] + 'B': [grass, erase, base] + 'j': [grass, erase, judge] + 't': [grass, tree] + 'b': [grass, board] + upperleft: [-7, 3] + map: | + j..... + ...... + .B.ttt + ...bb. + ...... diff --git a/data/scenarios/Testing/1575-structure-recognizer/2115-encroaching-upon-interior-transparent-cells.yaml b/data/scenarios/Testing/1575-structure-recognizer/2115-encroaching-upon-interior-transparent-cells.yaml new file mode 100644 index 000000000..49b48a1fc --- /dev/null +++ b/data/scenarios/Testing/1575-structure-recognizer/2115-encroaching-upon-interior-transparent-cells.yaml @@ -0,0 +1,85 @@ +version: 1 +name: Structure recognition - interior transparency +description: | + Incursion of an entity of a foreign type + upon a "transparent" cell within the bounding box + of a recognizable structure shall not prevent + the structure from being recognized. + + If the incurring entity is the *same* type as + a participating entity in that structure, however, + it will prevent recognition. +creative: false +objectives: + - teaser: Recognize structure + goal: + - | + `pigpen`{=structure} structure should be recognized upon completion, + even with an extraneous entity within its bounds. + condition: | + def isRight = \x. case x (\_. false) (\_. true); end; + foundBox <- structure "pigpen" 0; + return $ isRight foundBox; +robots: + - name: base + dir: east + devices: + - ADT calculator + - blueprint + - fast grabber + - logger + - treads + inventory: + - [1, board] + - name: judge + dir: east + system: true + display: + invisible: true +solution: | + move; move; move; move; + swap "board"; +structures: + - name: pigpen + recognize: [north] + structure: + palette: + 'b': [stone, board] + mask: '.' + map: | + bbbb + b..b + b..b + bbbb + - name: obstruction + recognize: [north] + structure: + palette: + 't': [grass, tree] + 'b': [grass, board] + map: | + tttb +known: [board, mountain, tree] +world: + dsl: | + {blank} + palette: + '.': [grass, erase] + 'B': [grass, erase, base] + 'r': [grass, mountain] + 'j': [grass, erase, judge] + 'p': + structure: + name: pigpen + cell: [grass] + 'b': + structure: + name: obstruction + cell: [grass] + upperleft: [-7, 3] + map: | + j..... + .p.... + ...r.. + B..b.. + ...... diff --git a/test/integration/Main.hs b/test/integration/Main.hs index fe5c8ec9a..33ea4f0d0 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -454,6 +454,8 @@ testScenarioSolutions rs ui key = , testSolution Default "Testing/1575-structure-recognizer/1575-bounding-box-overlap" , testSolution Default "Testing/1575-structure-recognizer/1644-rotated-recognition" , 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/1430-built-robot-ownership" CheckForBadErrors $ \g -> do From 6bee94088fe92d8682a377fa4f91da0facd94bce Mon Sep 17 00:00:00 2001 From: Karl Ostmo Date: Tue, 13 Aug 2024 11:52:01 -0700 Subject: [PATCH 2/2] support structure intrusion --- .../1575-interior-entity-placement.yaml | 4 - .../Topography/Structure/Recognition/Log.hs | 35 ++++-- .../Topography/Structure/Recognition/Prep.hs | 49 ++++++-- .../Structure/Recognition/Tracking.hs | 111 +++++++++++------- .../Topography/Structure/Recognition/Type.hs | 11 +- weeder.toml | 2 +- 6 files changed, 139 insertions(+), 73 deletions(-) diff --git a/data/scenarios/Testing/1575-structure-recognizer/1575-interior-entity-placement.yaml b/data/scenarios/Testing/1575-structure-recognizer/1575-interior-entity-placement.yaml index 9832ec7cc..7a6515706 100644 --- a/data/scenarios/Testing/1575-structure-recognizer/1575-interior-entity-placement.yaml +++ b/data/scenarios/Testing/1575-structure-recognizer/1575-interior-entity-placement.yaml @@ -9,10 +9,6 @@ description: | Additionally, recognition of statically-placed structures at scenario initialization is also unaffected by interior entities. - - However, any such "contaminating" entities - will prevent the recognition of a structure - when constructed by a robot. creative: false objectives: - teaser: Replace rock 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 d8753d3c4..5bd8c163d 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 @@ -6,6 +6,7 @@ module Swarm.Game.Scenario.Topography.Structure.Recognition.Log where import Data.Aeson import Data.Int (Int32) +import Data.List.NonEmpty (NonEmpty) import GHC.Generics (Generic) import Servant.Docs (ToSample) import Servant.Docs qualified as SD @@ -14,8 +15,10 @@ import Swarm.Game.Scenario.Topography.Structure.Recognition.Type import Swarm.Game.Universe (Cosmic) import Swarm.Language.Syntax.Direction (AbsoluteDir) -type StructureRowContent e = [Maybe e] -type WorldRowContent e = [Maybe e] +-- | Type aliases for documentation +type StructureRowContent e = SymbolSequence e + +type WorldRowContent e = SymbolSequence e data OrientedStructure = OrientedStructure { oName :: OriginalName @@ -27,7 +30,8 @@ distillLabel :: StructureWithGrid b a -> OrientedStructure distillLabel swg = OrientedStructure (getName $ originalDefinition swg) (rotatedTo swg) data MatchingRowFrom = MatchingRowFrom - { rowIdx :: Int32 + { topDownRowIdx :: Int32 + -- ^ numbered from the top down , structure :: OrientedStructure } deriving (Generic, ToJSON) @@ -45,14 +49,23 @@ data HaystackContext e = HaystackContext data FoundRowCandidate e = FoundRowCandidate { haystackContext :: HaystackContext e - , structureContent :: StructureRowContent e - , rowCandidates :: [MatchingRowFrom] + , soughtContent :: StructureRowContent e + , matchedCandidates :: [MatchingRowFrom] + } + deriving (Functor, Generic, ToJSON) + +data EntityKeyedFinder e = EntityKeyedFinder + { searchOffsets :: InspectionOffsets + , candidateStructureRows :: NonEmpty (StructureRowContent e) + , entityMask :: [e] + -- ^ NOTE: HashSet has no Functor instance, + -- so we represent this as a list here. } deriving (Functor, Generic, ToJSON) data ParticipatingEntity e = ParticipatingEntity { entity :: e - , searchOffsets :: InspectionOffsets + , entityKeyedFinders :: NonEmpty (EntityKeyedFinder e) } deriving (Functor, Generic, ToJSON) @@ -63,6 +76,14 @@ data IntactPlacementLog = IntactPlacementLog } deriving (Generic, ToJSON) +data VerticalSearch e = VerticalSearch + { haystackVerticalExtents :: InspectionOffsets + -- ^ vertical offset of haystack relative to the found row + , soughtStructures :: [OrientedStructure] + , verticalHaystack :: [WorldRowContent e] + } + deriving (Functor, Generic, ToJSON) + data SearchLog e = FoundParticipatingEntity (ParticipatingEntity e) | StructureRemoved OriginalName @@ -70,7 +91,7 @@ data SearchLog e | FoundCompleteStructureCandidates [OrientedStructure] | -- | There may be multiple candidate structures that could be -- completed by the element that was just placed. This lists all of them. - VerticalSearchSpans [(InspectionOffsets, [OrientedStructure])] + VerticalSearchSpans [VerticalSearch e] | IntactStaticPlacement [IntactPlacementLog] deriving (Functor, Generic) 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 299f6c924..9b4d7a2cf 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 @@ -7,6 +7,7 @@ import Data.HashMap.Strict qualified as HM import Data.HashSet qualified as HS import Data.Hashable (Hashable) import Data.Int (Int32) +import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE import Data.Maybe (catMaybes) import Data.Semigroup (sconcat) @@ -32,13 +33,13 @@ mkOffsets pos xs = -- rows constitute a complete structure. mkRowLookup :: (Hashable a, Eq a) => - NE.NonEmpty (StructureRow b a) -> + NonEmpty (StructureRow b a) -> AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a) mkRowLookup neList = - AutomatonInfo participatingEnts bounds sm + AutomatonInfo participatingEnts bounds sm tuples where mkSmTuple = entityGrid &&& id - tuples = NE.toList $ NE.map (mkSmTuple . wholeStructure) neList + tuples = NE.map (mkSmTuple . wholeStructure) neList -- All of the unique entities across all of the full candidate structures participatingEnts = @@ -50,7 +51,7 @@ mkRowLookup neList = mkOffsets rwIdx g bounds = sconcat $ NE.map deriveRowOffsets neList - sm = makeStateMachine tuples + sm = makeStateMachine $ NE.toList tuples -- | Make the first-phase lookup map, keyed by 'Entity', -- along with automatons whose key symbols are "Maybe Entity". @@ -61,7 +62,7 @@ mkRowLookup neList = mkEntityLookup :: (Hashable a, Eq a) => [StructureWithGrid b a] -> - HM.HashMap a (AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a)) + HM.HashMap a (NonEmpty (AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a))) mkEntityLookup grids = HM.map mkValues rowsByEntityParticipation where @@ -75,17 +76,26 @@ mkEntityLookup grids = structureRowsNE = NE.map myRow singleRows sm2D = mkRowLookup structureRowsNE - mkValues neList = AutomatonInfo participatingEnts bounds sm + mkValues neList = + NE.map (\(mask, tups) -> AutomatonInfo mask bounds sm tups) tuplesByEntMask where - participatingEnts = - HS.fromList - (concatMap (catMaybes . fst) tuples) + -- If there are no transparent cells, + -- we don't need a mask. + getMaskSet row = + if Nothing `elem` row + then HS.fromList $ catMaybes row + else mempty - tuples = HM.toList $ HM.mapWithKey mkSmValue groupedByUniqueRow + tuplesByEntMask = binTuplesHMasListNE $ NE.map (getMaskSet . fst &&& id) tuplesNE + + tuplesNE = NE.map (\(a, b) -> (a, mkSmValue a b)) groupedByUniqueRow + + groupedByUniqueRow = + binTuplesHMasListNE $ + NE.map (rowContent . myRow &&& id) neList - groupedByUniqueRow = binTuplesHM $ NE.toList $ NE.map (rowContent . myRow &&& id) neList bounds = sconcat $ NE.map expandedOffsets neList - sm = makeStateMachine tuples + sm = makeStateMachine $ NE.toList tuplesNE -- The values of this map are guaranteed to contain only one -- entry per row of a given structure. @@ -111,6 +121,7 @@ mkEntityLookup grids = SingleRowEntityOccurrences r e occurrences $ sconcat $ NE.map deriveEntityOffsets occurrences + unconsolidated = map swap $ catMaybes $ @@ -123,7 +134,19 @@ mkEntityLookup grids = binTuplesHM :: (Foldable t, Hashable a, Eq a) => t (a, b) -> - HM.HashMap a (NE.NonEmpty b) + HM.HashMap a (NonEmpty b) binTuplesHM = foldr f mempty where f = uncurry (HM.insertWith (<>)) . fmap pure + +-- | We know that if the input to the binning function +-- is a nonempty list, the output map must also have +-- at least one element. +-- Ideally we would use a NonEmptyMap to prove this, +-- but unfortunately such a variant does not exist for 'HashMap'. +-- So we just "force" the proof by using 'NE.fromList'. +binTuplesHMasListNE :: + (Hashable a, Eq a) => + NonEmpty (a, b) -> + NonEmpty (a, NonEmpty b) +binTuplesHMasListNE = NE.fromList . HM.toList . binTuplesHM 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 ee0076e98..89358fe7f 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 @@ -12,13 +12,14 @@ module Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking ( import Control.Lens ((%~), (&), (.~), (^.)) import Control.Monad (forM, guard) import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) +import Data.Foldable (foldrM) 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.List (sortOn) -import Data.List.NonEmpty qualified as NE +import Data.List.NonEmpty.Extra qualified as NE import Data.Map qualified as M import Data.Maybe (listToMaybe) import Data.Ord (Down (..)) @@ -66,11 +67,19 @@ entityModified entLoader modification cLoc recognizer = let oldRecognitionState = r ^. recognitionState stateRevision <- case HM.lookup newEntity entLookup of Nothing -> return oldRecognitionState - Just finder -> do - let msg = FoundParticipatingEntity $ ParticipatingEntity newEntity (finder ^. inspectionOffsets) + 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 :) - registerRowMatches entLoader cLoc finder stateRevision' + foldrM (registerRowMatches entLoader cLoc) stateRevision' finders return $ r & recognitionState .~ stateRevision @@ -107,14 +116,15 @@ candidateEntityAt :: (Monad s, Hashable a) => GenericEntLocator s a -> FoundRegistry b a -> - -- | participating entities + -- | 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 guard $ M.notMember cLoc $ foundByLocation registry ent <- MaybeT $ entLoader cLoc - guard $ HS.member ent participating + guard $ null participating || HS.member ent participating return ent -- | Excludes entities that are already part of a @@ -123,13 +133,13 @@ getWorldRow :: (Monad s, Hashable a) => GenericEntLocator s a -> FoundRegistry b a -> - -- | participating entities - HashSet a -> Cosmic Location -> InspectionOffsets -> + -- | participating entities + HashSet a -> Int32 -> s [Maybe a] -getWorldRow entLoader registry participatingEnts cLoc (InspectionOffsets (Min offsetLeft) (Max offsetRight)) yOffset = do +getWorldRow entLoader registry cLoc (InspectionOffsets (Min offsetLeft) (Max offsetRight)) participatingEnts yOffset = do mapM getCandidate horizontalOffsets where getCandidate = candidateEntityAt entLoader registry participatingEnts @@ -139,8 +149,27 @@ getWorldRow entLoader registry participatingEnts cLoc (InspectionOffsets (Min of -- to bottom, but swarm world coordinates increase from bottom to top. mkLoc x = cLoc `offsetBy` V2 x (negate yOffset) +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 + where + rowMatchInfo :: [MatchingRowFrom] + rowMatchInfo = NE.toList . NE.map (f . myRow) . singleRowItems $ pVal c + where + f x = + MatchingRowFrom (rowIndex x) $ distillLabel . wholeStructure $ x + -- | This is the first (one-dimensional) stage -- in a two-stage (two-dimensional) search. +-- +-- It searches for any structure row that happens to +-- contain the placed entity. registerRowMatches :: (Monad s, Hashable a, Eq b) => GenericEntLocator s a -> @@ -148,34 +177,12 @@ registerRowMatches :: AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a) -> RecognitionState b a -> s (RecognitionState b a) -registerRowMatches entLoader cLoc (AutomatonInfo participatingEnts horizontalOffsets sm) rState = do - let registry = rState ^. foundStructures - - entitiesRow <- - getWorldRow - entLoader - registry - participatingEnts - cLoc - horizontalOffsets - 0 - - let candidates = findAll sm entitiesRow - - mkCandidateLogEntry c = - FoundRowCandidate - (HaystackContext entitiesRow (HaystackPosition $ pIndex c)) - (needleContent $ pVal c) - rowMatchInfo - where - rowMatchInfo :: [MatchingRowFrom] - rowMatchInfo = NE.toList . NE.map (f . myRow) . singleRowItems $ pVal c - where - f x = - MatchingRowFrom (rowIndex x) $ distillLabel . wholeStructure $ x +registerRowMatches entLoader cLoc (AutomatonInfo participatingEnts horizontalOffsets sm _) rState = do + maskChoices <- attemptSearchWithEntityMask participatingEnts - logEntry = FoundRowCandidates $ map mkCandidateLogEntry candidates + let logEntry = uncurry logRowCandidates maskChoices rState2 = rState & recognitionLog %~ (logEntry :) + candidates = snd maskChoices candidates2Dpairs <- forM candidates $ @@ -186,6 +193,22 @@ registerRowMatches entLoader cLoc (AutomatonInfo participatingEnts horizontalOff return $ registerStructureMatches (concat candidates2D) rState3 + where + registry = rState ^. foundStructures + + attemptSearchWithEntityMask entsMask = do + entitiesRow <- + 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) -- | Examines contiguous rows of entities, accounting -- for the offset of the initially found row. @@ -197,10 +220,10 @@ checkVerticalMatch :: -- | Horizontal search offsets InspectionOffsets -> Position (StructureSearcher b a) -> - s ((InspectionOffsets, [OrientedStructure]), [FoundStructure b a]) + s (VerticalSearch a, [FoundStructure b a]) checkVerticalMatch entLoader registry cLoc (InspectionOffsets (Min searchOffsetLeft) _) foundRow = do - (x, y) <- getMatches2D entLoader registry cLoc horizontalFoundOffsets $ automaton2D searcherVal - return ((x, rowStructureNames), y) + ((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 @@ -234,18 +257,18 @@ getMatches2D :: -- | Horizontal found offsets (inclusive indices) InspectionOffsets -> AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a) -> - s (InspectionOffsets, [FoundStructure 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 verticalOffsets - return (vRange, getFoundStructures (offsetTop, offsetLeft) cLoc sm entityRows) + (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 participatingEnts cLoc horizontalFoundOffsets - verticalOffsets = [offsetTop .. offsetBottom] + getRow = getWorldRow entLoader registry cLoc horizontalFoundOffsets participatingEnts + vertOffsets = [offsetTop .. offsetBottom] -- | -- We only allow an entity to participate in one structure at a time, 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 2d8f97934..8908d0584 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 @@ -25,7 +25,7 @@ import Data.Function (on) import Data.HashMap.Strict (HashMap) import Data.HashSet (HashSet) import Data.Int (Int32) -import Data.List.NonEmpty qualified as NE +import Data.List.NonEmpty (NonEmpty) import Data.Map (Map) import Data.Maybe (catMaybes) import Data.Ord (Down (Down)) @@ -74,7 +74,7 @@ type SymbolSequence a = [AtomicKeySymbol a] data StructureSearcher b a = StructureSearcher { automaton2D :: AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a) , needleContent :: SymbolSequence a - , singleRowItems :: NE.NonEmpty (SingleRowEntityOccurrences b a) + , singleRowItems :: NonEmpty (SingleRowEntityOccurrences b a) } -- | @@ -108,7 +108,7 @@ data PositionWithinRow b a = PositionWithinRow data SingleRowEntityOccurrences b a = SingleRowEntityOccurrences { myRow :: StructureRow b a , myEntity :: a - , entityOccurrences :: NE.NonEmpty (PositionWithinRow b a) + , entityOccurrences :: NonEmpty (PositionWithinRow b a) , expandedOffsets :: InspectionOffsets } @@ -197,6 +197,9 @@ 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. } deriving (Generic) @@ -208,7 +211,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 (AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a)) + , _automatonsByEntity :: HashMap a (NonEmpty (AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a))) } deriving (Generic) diff --git a/weeder.toml b/weeder.toml index b93e5806c..21c1c1750 100644 --- a/weeder.toml +++ b/weeder.toml @@ -40,9 +40,9 @@ roots = [ "^Swarm.Language.Syntax.Pattern.UTerm$", "^Swarm.Language.Syntax.Util.asTree$", "^Swarm.Language.Syntax.Util.mapFreeS$", + "^Swarm.Util.isSuccessOr$", "^Swarm.Util.replaceLast$", "^Swarm.Util.reflow$", - "^Swarm.Util.isSuccessOr$", "^Swarm.Util._NonEmpty$", # True positives (unused lenses):