5
$\begingroup$

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

Result of DeleteSmallComponents@Colorize@MorphologicalComponents[image]

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:

Computed center of the circular specimen

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.

$\endgroup$
10
  • $\begingroup$ 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. $\endgroup$
    – UDB
    Jul 28, 2017 at 15:01
  • $\begingroup$ @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. $\endgroup$
    – Mike
    Jul 29, 2017 at 6:06
  • $\begingroup$ @UDB: Now I see, PointPlot variable definition was missing. I edited it in the text. Thanks! $\endgroup$
    – Mike
    Jul 29, 2017 at 11:06
  • $\begingroup$ Related: How to find the center of a circular pattern? $\endgroup$
    – Mr.Wizard
    Jul 29, 2017 at 11:19
  • $\begingroup$ @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." $\endgroup$
    – Mike
    Jul 29, 2017 at 14:53

2 Answers 2

7
$\begingroup$

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]

enter image description here

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}]

enter image description here

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"]}]

enter image description here

$\endgroup$
2
  • $\begingroup$ 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. $\endgroup$
    – Mike
    Jul 29, 2017 at 6:17
  • $\begingroup$ @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 $\endgroup$ Jul 29, 2017 at 7:39
6
$\begingroup$

Something like the following seems to work decently well:

bin = Binarize@MorphologicalPerimeter@img

binarized

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

HighlightImage[bin, centroid]

highlighted centroid

$\endgroup$
2
  • $\begingroup$ 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. $\endgroup$
    – Mike
    Jul 29, 2017 at 10:53
  • $\begingroup$ 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. $\endgroup$
    – Mike
    Aug 25, 2017 at 6:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.