From f702056a3d2bed5b786c2858b76b888f4d0988eb Mon Sep 17 00:00:00 2001 From: Karl Ostmo Date: Sat, 2 Nov 2024 18:50:00 -0700 Subject: [PATCH] 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