# Obtain subimages from a binary image with specified neighbourhood

Lets say I have this binary picture (an array with 1's and 0's):

start = {{0, 1, 1, 1}, {1, 1, 0, 0}, {1, 1, 0, 1}, {1, 1, 0, 0}};
i = ArrayPlot[CellularAutomaton[<|"OuterTotalisticCode"->224,"Dimension"->2,"Neighborhood"->9|>,{start,0},{{{200}}}],Frame->False,ColorRules->{1->White,0->Black}]


Then I can extract the subimages e.g. by using:

subimages =  ComponentMeasurements[i, "Image", All, "PropertyAssociation"]["Image"]


This gives me 13 subimages which have one black pixel in between. (Note, that the blank entries above are white pixels and thus the result is correct.)

But now I would like to count subimages with two black pixels in between as one subimage. More precisely I would like to obtain only a result with 9 subimages as grouped as this:

Is there any obvious way to do it in Mathematica?

# Edit:

The answers by @MarcoB and @kglr work for the specified example. Especially if one uses additionally an Erosion on the mask to trim down the boundaries. But the solution is not generally applicable, another example:

start = {{0, 1, 1, 1}, {1, 1, 0, 0}, {1, 1, 0, 1}, {1, 1, 0, 0}, {1, 1, 1, 1}};
i = ArrayPlot[CellularAutomaton[<|"OuterTotalisticCode" -> 224, "Dimension" -> 2,"Neighborhood" -> 9|>, {start, 0}, {{{400}}}], Frame -> False,ColorRules -> {1 -> White, 0 -> Black}];


The resulting image should be, as before, divided into subimages with 2 black cells in between, as this (the critical location where the suggested solutions fail is indicated with the arrow):

This was the proposed solution (with an added Erosion):

dilated = Dilation[i, DiskMatrix[1]];


Image 4 was captured incorrectly. To me it seems that ComponentMeasurements applies a bounding box which is not desired. Any modification of the proposed solution that fixes this issue is appreciated!

• What is the value of start in your code? Commented May 12, 2020 at 16:51
• sorry, thanks for asking, I edited. Commented May 12, 2020 at 16:52
• Your edit changes the question substantially, to the point of invalidating all answers provided so far. Moving the goalposts like you just did is frowned upon because it wastes the effort put in by answer writers, and discourages further answers because people will be worried that you will substantially change the question yet again. Consider removing your edit, accepting an answer to your original question, and perhaps posting your new problem as a new question. Commented May 13, 2020 at 13:37
• @MarcoB I disagree with your statement. The first picture just served as an (arbitrary) example and the question was framed generally. While the provided solutions gave correct answers to the example they didn't give the correct answer to the (general) question. But if there won't be further answers I will accept one answer given and ask another question, yes. Commented May 13, 2020 at 13:58

Update:

start1 = {{0, 1, 1, 1}, {1, 1, 0, 0}, {1, 1, 0, 1}, {1, 1, 0, 0}};
ca1 = CellularAutomaton[<|"OuterTotalisticCode" -> 224, "Dimension" -> 2,
"Neighborhood"->9|>, {start,0}, {{{200}}}];
i1 = ArrayPlot[ca1, Frame-> False, ColorRules -> {1 -> White, 0 -> Black}];


Using a combination of ArrayMesh and FindClusters with ChessboardDistance we get a list of clusters of polygon objects:

clusters1 = FindClusters[MeshPrimitives[ArrayMesh[ca1], 2],
DistanceFunction -> (ChessboardDistance[RegionCentroid @ #, RegionCentroid @ #2]&)];

Show[i1, Graphics @ MapIndexed[{FaceForm[], EdgeForm[{ Dotted, Cyan}],
Scale[BoundingRegion[Join @@ (PolygonCoordinates /@ #),
"FastEllipse"], {1, 1} 1.1], EdgeForm[], Opacity[1],
FaceForm[ColorData[97]@#2[[1]]], #} &, clusters1]]


Multicolumn[Graphics[{EdgeForm[], FaceForm[White], #},
Background -> Black, ImageSize -> Tiny, PlotRangePadding -> 1]& /@
clusters1, 5]


start2 = {{0, 1, 1, 1}, {1, 1, 0, 0}, {1, 1, 0, 1}, {1, 1, 0, 0}, {1, 1, 1, 1}};
ca2 = CellularAutomaton[<|"OuterTotalisticCode" -> 224, "Dimension" -> 2,
"Neighborhood" -> 9|>, {start2, 0}, {{{400}}}];

i2 = ArrayPlot[ca2, Frame -> False, ColorRules -> {1 -> White, 0 -> Black}];

clusters2 = FindClusters[MeshPrimitives[ArrayMesh[ca2], 2],
DistanceFunction -> (ChessboardDistance[RegionCentroid @ #,RegionCentroid @ #2]&)];

Show[i2, Graphics @ MapIndexed[{FaceForm[], EdgeForm[{ Dotted, Cyan}],
Scale[BoundingRegion[Join @@ (PolygonCoordinates /@ #), "FastEllipse"],
{1, 1} 1.1],
EdgeForm[], Opacity[1],  FaceForm[ColorData[97]@#2[[1]]], #} &, clusters2]]


Multicolumn[Graphics[{EdgeForm[], FaceForm[White], #},
Background -> Black, ImageSize -> Tiny, PlotRangePadding -> 1]& /@
clusters2, 5]


trim = Values @ ComponentMeasurements[MorphologicalTransform[Binarize @ i, "Max"],
"BoundingBox"];

ImageTrim[i, trim]


• Thanks for your answer, however your solution is not quite correct for a different example. Please have a look at the edit I made. Do you have any idea how to adjust it appropriately? Commented May 13, 2020 at 9:58
• @MrPuh, I missed the two black cells in between bit (although it is boldfaced in your post:).
– kglr
Commented May 13, 2020 at 10:01
• Your answer was correct for the first example I provided! It just doesn't give the right result for a different example. Any thoughts on how to fix it is appreciated :) Commented May 13, 2020 at 10:04

One simple approach is to expand the small blocks using Dilation, then count the number of blocks that remain. Starting with your image i:

idil = Dilation[i, 2];
subidil = ComponentMeasurements[idil, "Image", All, "PropertyAssociation"]["Image"]


and you can see that subidil has the desired Length[subidil]=9 components.

This is an answer to the original question, which was: "to count subimages with two black pixels in between as one subimage". It is not an answer to the extended and revised (twice) question.

• This wouldn't give me the actual subimages though, but a "thicker" version. I tried Erosion afterwards but this doesn't really work. Commented May 12, 2020 at 17:32
• You could use the output of subidil as masks on the original set if you want finer control. Commented May 12, 2020 at 17:41
• Not sure if I get what you mean. How would I do this? Commented May 12, 2020 at 17:52
• Overlay each of the smaller older ones (in subimg) to its appropriate new larger one (in subidil). ComponentMeasurements will tell you where they are. Commented May 12, 2020 at 18:43

Similar to what @bill proposed, but generating the separated images.

First, use dilation to "fuse together" the small features that are close by. Then use MorphologicalComponents to generate a mask identifying each of the dilated components. Finally, use that mask to extract the subimages of the original image that correspond to where the fused blobs are in the dilated image.

dilated = Dilation[i, DiskMatrix[1]];