# Find the center of a circular specimen

In order to automate the process of finding the Orientation of the pattern in an image, I would like to first find the center of a circular specimen. Original image can be downloaded here. My current progress and the results are described further on.

I can get some sort of circular shaped 2D object using the following set of commands: DeleteSmallComponents@Colorize@MorphologicalComponents[image], which results in

Using built-in ComponentMeasurements[] in the following code

pos = ComponentMeasurements[DeleteSmallComponents@
Colorize@MorphologicalComponents[image],  "BoundingDiskCenter"]


and plotting a point on an image with the code

PointPlot=ListPlot[{{pos[[1, 2, 1]], pos[[1, 2, 2]]}},
PlotStyle -> Directive[Red, PointSize -> Medium]];
Show[{image, PointPlot}, ImageSize -> Full]


gives the center as:

As you can see, the point is not at exact center of the circle. I have tried using ImageCorrelation with the white disk on the black background, but I cannot manage to match the size of the specimen with the size of the disk. I apologize for bad code formatting, but I have no idea how to improve it.

• Try Show[#2, ListPlot[{{#1[[1, 2, 1]], #1[[1, 2, 2]]}}, PlotStyle -> Directive[Red, PointSize -> Medium]], ImageSize -> Automatic] &[Sequence @@ {ComponentMeasurements[#, "BoundingDiskCenter"], #}&@DeleteSmallComponents@Colorize@MorphologicalComponents[image]] and tell us what your problem is. – UDB Jul 28 '17 at 15:01
• @UDB: What did you want to lay open with that code? It should be modified as Show[#2, ListPlot[{{#1[[1, 2, 1]], #1[[1, 2, 2]]}}, PlotStyle -> Directive[Red, PointSize -> Medium]], ImageSize -> Full] &[ Sequence @@ {ComponentMeasurements[#, "BoundingDiskCenter"], #} &@ image] to exactly replicate my example. – Mike Jul 29 '17 at 6:06
• @UDB: Now I see, PointPlot variable definition was missing. I edited it in the text. Thanks! – Mike Jul 29 '17 at 11:06
• – Mr.Wizard Jul 29 '17 at 11:19
• @Mr.Wizard♦ Your code from the suggested post does not work in my case, because I get the following message: "Coordinate Mean[{}] should be a pair of numbers, or a Scaled or Offset form." – Mike Jul 29 '17 at 14:53

Here's something you can try: First, find the coordinates of all the bright spots in the image:

img = Import["https://i.stack.imgur.com/8NPCs.jpg"];
bin = MorphologicalBinarize[img];
allPoints = Round@ComponentMeasurements[bin, "Centroid"][[All, 2]];


Then we calculate the convex hull of these points:

hull = ConvexHullMesh[allPoints];
HighlightImage[bin, hull]


As you can see, there are a few outliers that "pull" the hull in the wrong direction. The easiest way to get rid of these outliers is to remove all the corners of the convex hull from the original point set, then calculate the convex hull again. (I think this algorithm is called "onion peeling" in Computational Geometry. Because it peels the outer layers of a point set one by one.)

If we do this a few times in a loop:

innerPoints = allPoints;
innerHull = hull;
onionLayers = Table[(
innerPoints =
Complement[innerPoints, Round[MeshCoordinates[innerHull]]];
innerHull = ConvexHullMesh[innerPoints]
), {n, 3}];


The "onion layers" look like this:

HighlightImage[bin, {Opacity[.2], hull, onionLayers}]


The isolated outliers are removed. So are a few of the "good" points, but they don't move the hull much, as they're packed close together.

You can then get the bounding disk of this hull using BoundingRegion:

HighlightImage[bin, {BoundingRegion[innerHull, "MinDisk"]}]


• Your answer looks very interesting. Unfortunatelly, it cannot be replicated, because I am running Mathematica v10.0.1.0. BoundingRegion was introduced not earlier than v11. – Mike Jul 29 '17 at 6:17
• @Mike: You can probably find the smallest enclosing disk using FindMinimum: use the center and squared radius as optimization variables, the radius as optimization objective and the distance of the hull corners to the center as constraints. Alternatively, you can try the center of mass of the convex hull - it's roughly circular, so the center should be close to the bounding disk center – Niki Estner Jul 29 '17 at 7:39

Something like the following seems to work decently well:

bin = Binarize@MorphologicalPerimeter@img


DeleteSmallComponents@Erosion[Closing[%, 40], 1];
centroid = MaximalBy[Values@ComponentMeasurements[%, {"Area", "Centroid"}], First][[1, 2]];

HighlightImage[bin, centroid]


• Only a slight correction to your code in order to work. HighlightImage[] line should be written as HighlightImage[bin,{centroid}]. At least that is what works in Mathematica v10.0.1.0. – Mike Jul 29 '17 at 10:53
• After checking this method, I mush say that it is very biased and, thus, unsuitable. Its results vary strongly with the uniformity/distribution of the white spots in the specimen. If the spots are uneven, it could show center of image close to the border. – Mike Aug 25 '17 at 6:57