diff --git a/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt b/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt index 4c442db6e..d2b4058bf 100644 --- a/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt +++ b/data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt @@ -19,3 +19,4 @@ 2201-piecewise-lines.yaml 2201-preclude-overlapping-recognition.yaml 2201-initial-recognition-overlap.yaml +2229-position-uniqueness-multiple-orientations.yaml diff --git a/data/scenarios/Testing/1575-structure-recognizer/2229-position-uniqueness-multiple-orientations.yaml b/data/scenarios/Testing/1575-structure-recognizer/2229-position-uniqueness-multiple-orientations.yaml new file mode 100644 index 000000000..8adcc1104 --- /dev/null +++ b/data/scenarios/Testing/1575-structure-recognizer/2229-position-uniqueness-multiple-orientations.yaml @@ -0,0 +1,60 @@ +version: 1 +name: Structure recognition - rotated structures at same position +description: | + A map keyed by (position, structure name) would not be sufficient to + account for multiple orientations of the same structure, sharing the + same top-left corner position. + + This is why the found structure registry must include orientation + in its key. +creative: false +objectives: + - teaser: Recognize both structures + goal: + - | + Two `thingy`{=structure} structures should be recognized immediately. + Without distinguishing them by orientation in the registry, only + one would be recognized. + condition: | + foundStructure <- structure "thingy" 0; + return $ case foundStructure + (\_. false) + (\result. fst result == 2); +robots: + - name: base + dir: north + devices: + - logger +solution: | + noop; +structures: + - name: thingy + recognize: [north, east] + structure: + palette: + 'x': [stone, rock] + 'y': [dirt] + mask: '.' + map: | + y.y + yxx +known: [rock] +world: + dsl: | + {blank} + placements: + - src: thingy + - src: thingy + offset: [0, 0] + orient: + up: east + palette: + '.': [grass, erase] + 'B': [grass, erase, base] + upperleft: [-3, 3] + map: | + .........B. + ........... + ........... + ........... + ........... diff --git a/src/swarm-engine/Swarm/Game/Step/Const.hs b/src/swarm-engine/Swarm/Game/Step/Const.hs index 37b97f952..b1ed7d9a1 100644 --- a/src/swarm-engine/Swarm/Game/Step/Const.hs +++ b/src/swarm-engine/Swarm/Game/Step/Const.hs @@ -554,7 +554,7 @@ execConst runChildProg c vs s k = do mkOutput mapNE = (NE.length xs, bottomLeftCorner) where xs = NEM.toList mapNE - (pos, struc) = indexWrapNonEmpty xs idx + ((pos, _), struc) = indexWrapNonEmpty xs idx topLeftCorner = pos ^. planar offsetHeight = V2 0 $ negate (rectHeight (getNEGridDimensions $ extractedGrid $ entityGrid struc) - 1) bottomLeftCorner :: Location 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 b409591aa..783a2c9a9 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,6 +17,7 @@ import Swarm.Game.Scenario.Topography.Structure.Recognition.Static ( ) import Swarm.Game.Scenario.Topography.Structure.Recognition.Type import Swarm.Game.Universe (Cosmic) +import Swarm.Language.Syntax.Direction (AbsoluteDir) renderSharedNames :: ConsolidatedRowReferences b a -> NonEmpty StructureName renderSharedNames = @@ -57,6 +58,7 @@ data SearchLog e | StartSearchAt (Cosmic Location) InspectionOffsets | FoundParticipatingEntity (ParticipatingEntity e) | FoundCompleteStructureCandidates [(OrientedStructure, Cosmic Location)] + | RecognizedSingleStructure (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)] @@ -80,7 +82,7 @@ searchLogOptions = instance ToSample (SearchLog e) where toSamples _ = SD.noSamples -data StructureLocation = StructureLocation StructureName (Cosmic Location) +data StructureLocation = StructureLocation StructureName (Cosmic Location, AbsoluteDir) deriving (Generic, ToJSON) instance ToSample StructureLocation where diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Registry.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Registry.hs index bf66735d6..9f6a20710 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Registry.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Registry.hs @@ -35,6 +35,7 @@ import Swarm.Game.Location import Swarm.Game.Scenario.Topography.Structure.Named (StructureName, name) import Swarm.Game.Scenario.Topography.Structure.Recognition.Type import Swarm.Game.Universe (Cosmic (..)) +import Swarm.Language.Syntax.Direction (AbsoluteDir (..)) import Swarm.Util (binTuples, deleteKeys) -- | The authoritative source of which built structures currently exist. @@ -42,7 +43,7 @@ import Swarm.Util (binTuples, deleteKeys) -- The two type parameters, `b` and `a`, correspond -- to 'Cell' and 'Entity', respectively. data FoundRegistry b a = FoundRegistry - { _foundByName :: Map StructureName (NEMap (Cosmic Location) (StructureWithGrid b a)) + { _foundByName :: Map StructureName (NEMap (Cosmic Location, AbsoluteDir) (StructureWithGrid b a)) , _foundByLocation :: Map (Cosmic Location) (FoundStructure b a) } @@ -52,7 +53,7 @@ emptyFoundStructures = FoundRegistry mempty mempty -- | We use a 'NEMap' here so that we can use the -- safe-indexing function 'indexWrapNonEmpty' in the implementation -- of the @structure@ command. -foundByName :: FoundRegistry b a -> Map StructureName (NEMap (Cosmic Location) (StructureWithGrid b a)) +foundByName :: FoundRegistry b a -> Map StructureName (NEMap (Cosmic Location, AbsoluteDir) (StructureWithGrid b a)) foundByName = _foundByName -- | This is a worldwide "mask" that prevents members of placed @@ -72,15 +73,16 @@ removeStructure fs (FoundRegistry byName byLoc) = allOccupiedCoords = genOccupiedCoords fs structureName = name . originalItem . entityGrid $ structureWithGrid fs upperLeft = upperLeftCorner fs + rotation = rotatedTo $ structureWithGrid fs -- NOTE: Observe similarities to -- Swarm.Game.State.removeRobotFromLocationMap - tidyDelete = NEM.nonEmptyMap . NEM.delete upperLeft + tidyDelete = NEM.nonEmptyMap . NEM.delete (upperLeft, rotation) addFound :: FoundStructure b a -> FoundRegistry b a -> FoundRegistry b a addFound fs@(PositionedStructure loc swg) (FoundRegistry byName byLoc) = FoundRegistry - (M.insertWith (<>) k (NEM.singleton loc swg) byName) + (M.insertWith (<>) k (NEM.singleton (loc, rotatedTo swg) swg) byName) (M.union occupationMap byLoc) where k = name . originalItem $ entityGrid swg @@ -115,7 +117,7 @@ populateStaticFoundStructures allFound = byLocation = M.unions $ map mkOccupationMap resolvedCollisions byName = - M.map (NEM.fromList . NE.map (upperLeftCorner &&& structureWithGrid)) $ + M.map (NEM.fromList . NE.map ((upperLeftCorner &&& rotatedTo . structureWithGrid) &&& structureWithGrid)) $ binTuples $ map (name . originalItem . entityGrid . structureWithGrid &&& id) resolvedCollisions 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 56f6a7791..52929c00c 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 @@ -6,12 +6,14 @@ -- See "Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute" for -- details of the structure recognition process. module Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking ( + RecognitionActiveStatus (..), entityModified, + entityModifiedLoggable, ) where import Control.Arrow (left, (&&&)) -import Control.Lens ((%~), (&), (^.)) -import Control.Monad (foldM, guard, unless) +import Control.Lens ((%~), (&), (.~), (^.)) +import Control.Monad (foldM, forM_, guard, unless) import Control.Monad.Extra (findM) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) @@ -44,12 +46,20 @@ import Swarm.Game.Scenario.Topography.Terraform import Swarm.Game.Universe import Text.AhoCorasick +data RecognitionActiveStatus + = RecognizeNewStructures + | -- | Do not add new recognitions to the registry. + -- This is useful if one needs to construct a larger structure + -- for which other smaller structures contained within it + -- would otherwise be recognized first, precluding the larger + -- structure from ever being recognized. + -- Removing elements of a previously recognized structure + -- will still cause it to be removed from the registry. + DisableNewRecognition + deriving (Show, Eq, Ord, Enum, Bounded) + -- | A hook called from the centralized entity update function, -- 'Swarm.Game.Step.Util.updateEntityAt'. --- --- This handles structure detection upon addition of an entity, --- and structure de-registration upon removal of an entity. --- Also handles atomic entity swaps. entityModified :: (Monad s, Hashable a, Eq b) => GenericEntLocator s a -> @@ -59,39 +69,56 @@ entityModified :: RecognitionState b a -> s (RecognitionState b a) entityModified entLoader modification cLoc autoRecognizer oldRecognitionState = do - (val, accumulatedLogs) <- runWriterT $ case modification of - Add newEntity -> doAddition newEntity oldRecognitionState - Remove _ -> doRemoval - Swap _ newEntity -> doRemoval >>= doAddition newEntity + (val, accumulatedLogs) <- + runWriterT $ + entityModifiedLoggable RecognizeNewStructures entLoader modification cLoc autoRecognizer oldRecognitionState return $ val & recognitionLog %~ (reverse accumulatedLogs <>) + +-- | This handles structure detection upon addition of an entity, +-- and structure de-registration upon removal of an entity. +-- Also handles atomic entity swaps. +entityModifiedLoggable :: + (Monoid (f (SearchLog a)), Monad m, Hashable a, Eq b, Applicative f) => + RecognitionActiveStatus -> + (Cosmic Location -> m (AtomicKeySymbol a)) -> + CellModification a -> + Cosmic Location -> + RecognizerAutomatons b a -> + RecognitionState b a -> + WriterT (f (SearchLog a)) m (RecognitionState b a) +entityModifiedLoggable activeStatus entLoader modification cLoc autoRecognizer oldRecognitionState = do + case modification of + Add newEntity -> doAddition newEntity oldRecognitionState + Remove _ -> doRemoval oldRecognitionState + Swap _ newEntity -> doRemoval oldRecognitionState >>= doAddition newEntity where entLookup = autoRecognizer ^. automatonsByEntity - doAddition newEntity = - maybe return logAndRegister $ HM.lookup newEntity entLookup + doAddition newEntity = case activeStatus of + RecognizeNewStructures -> maybe return logAndRegister $ HM.lookup newEntity entLookup + DisableNewRecognition -> return where logAndRegister finder s = do tell . pure . FoundParticipatingEntity $ ParticipatingEntity newEntity (finder ^. inspectionOffsets) - registerRowMatches entLoader cLoc finder s + newFoundStructures <- registerRowMatches entLoader cLoc finder $ s ^. foundStructures + return $ s & foundStructures .~ newFoundStructures - doRemoval = + doRemoval sOld = -- Entity was removed; may need to remove registered structure. - f oldRecognitionState + maybe return logAndRemove structureAtLoc sOld where - f = maybe return logAndRemove $ M.lookup cLoc $ foundByLocation structureRegistry + structureAtLoc = M.lookup cLoc $ foundByLocation $ sOld ^. foundStructures logAndRemove fs s = do tell $ pure $ StructureRemoved structureName return $ s & foundStructures %~ removeStructure fs where structureName = name . originalItem . entityGrid $ structureWithGrid fs - structureRegistry = oldRecognitionState ^. foundStructures - -- | In case this cell would match a candidate structure, -- ensures that the entity in this cell is not already -- participating in a registered structure. @@ -232,9 +259,9 @@ registerRowMatches :: GenericEntLocator s a -> Cosmic Location -> AutomatonInfo b a -> - RecognitionState b a -> - WriterT (f (SearchLog a)) s (RecognitionState b a) -registerRowMatches entLoader cLoc (AutomatonInfo horizontalOffsets pwMatcher) rState = do + FoundRegistry b a -> + WriterT (f (SearchLog a)) s (FoundRegistry b a) +registerRowMatches entLoader cLoc (AutomatonInfo horizontalOffsets pwMatcher) registry = do tell $ pure $ StartSearchAt cLoc horizontalOffsets tell . pure . ExpectedChunks $ @@ -268,15 +295,17 @@ registerRowMatches entLoader cLoc (AutomatonInfo horizontalOffsets pwMatcher) rS -- and now choose the first one that is verified. maybeIntactStructure <- findM validateIntactness2d rankedCandidates - lift $ registerBestStructureMatch maybeIntactStructure rState + forM_ maybeIntactStructure $ + tell . pure . RecognizedSingleStructure . getStructInfo + + return $ maybe id addFound maybeIntactStructure registry where - registry = rState ^. foundStructures PiecewiseRecognition pwSM rowChunkReferences = pwMatcher getStructInfo (PositionedStructure loc swg) = (distillLabel swg, loc) validateIntactness2d fs = do - maybeIntactnessFailure <- lift $ ensureStructureIntact (rState ^. foundStructures) entLoader fs + maybeIntactnessFailure <- lift $ ensureStructureIntact registry entLoader fs tell . pure . ChunkIntactnessVerification $ IntactPlacementLog maybeIntactnessFailure @@ -341,13 +370,3 @@ findCoveringOffsets possibleOffsets x = 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/test/integration/Main.hs b/test/integration/Main.hs index b325af842..fd53247dd 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -477,6 +477,7 @@ testScenarioSolutions rs ui key = , testSolution Default "Testing/1575-structure-recognizer/2201-piecewise-lines" , testSolution Default "Testing/1575-structure-recognizer/2201-preclude-overlapping-recognition" , testSolution Default "Testing/1575-structure-recognizer/2201-initial-recognition-overlap" + , testSolution Default "Testing/1575-structure-recognizer/2229-position-uniqueness-multiple-orientations" ] ] , testSolution' Default "Testing/1430-built-robot-ownership" CheckForBadErrors $ \g -> do