10
$\begingroup$

The Region of Mathematica is nice,and is the new conception of version 10.0.I can convenient get Area,Centroid and the RandomPoint from the Region.Now,I get a beautifull apple like this picture.

enter image description here

Then I Binarize it:

binapple = Binarize[pic, 0.91] // ColorNegate // FillingTransform

so I get the binarize-apple: enter image description here

The question is how to convert the binarize-apple to a Region.Can anybody give some suggestion.I'll appreciate you sincerely.

$\endgroup$
9
$\begingroup$

Here's a partial answer which might lead you in the right direction. If we convert the binarized image into image data, we can establish a condition suitable for RegionPlot:

rp = With[{idata = ImageData[binapple], 
  xmax = First@ImageDimensions[binapple], 
  ymax = Last@ImageDimensions[binapple]},
 RegionPlot[
  idata[[IntegerPart@(ymax - y), IntegerPart@x]] == 1, {x, 1, 
   xmax}, {y, 1, ymax}]]

enter image description here

The problem with this approach is that one should be able to create an implicit region in a similar manner, however I am getting a part specification error message when I try:

With[{idata = ImageData[binapple], 
  xmax = First@ImageDimensions[binapple], 
  ymax = Last@ImageDimensions[binapple]},
 ImplicitRegion[
  idata[[IntegerPart@(ymax - IntegerPart@y), IntegerPart@x]] == 1 && 
   1 <= IntegerPart@x <= xmax && 1 <= IntegerPart@y <= ymax, {x, y}]]

I'll certainly update this half-answer once I find my error.

Note: One hackish way to get the region itself is to run BoundaryDiscretizeGraphics@rp[[1]]. We can wrap this all up in a function:

binaryImageToRegion[bimg_] := 
 With[{idata = ImageData[bimg], xmax = First@ImageDimensions[bimg], 
   ymax = Last@ImageDimensions[bimg]},
  BoundaryDiscretizeGraphics@
   First@RegionPlot[
     idata[[IntegerPart@(ymax - y), IntegerPart@x]] == 1, {x, 1, 
      xmax}, {y, 1, ymax}]]

So that binaryImageToRegion[binapple] gives:

enter image description here

The RegionPlot does add quite a bit of overhead, but I don't see a significant performance issue with your test case.

$\endgroup$
  • 2
    $\begingroup$ ... and binaryImageToRegion[binapple] // RegionQ yields True. $\endgroup$ – bobthechemist Sep 26 '15 at 13:10
  • $\begingroup$ I'm confuse why using ImplicitRegion,too.When you find the error,update it,please~^_^ $\endgroup$ – yode Sep 26 '15 at 13:38
7
$\begingroup$

Another more or less direct construction, like rherman's:

Clear[square];
(* Create a square for each pixel in  pos  *)
square = Compile[{{pos, _Real, 2}},
   Block[{tp = Transpose[pos]},
    Transpose[
     {tp - 1, {tp[[1]], tp[[2]] - 1}, tp, {tp[[1]] - 1, tp[[2]]}},
     {2, 3, 1}
     ]
    ]
   ];

discretizeImage[img_] := Module[{pos, poly, coords, nf},
   pos = PixelValuePositions[img, 1];
   poly = square[pos];
   coords = DeleteDuplicates@Flatten[poly, 1];
   nf = Nearest[coords -> Automatic];
   MeshRegion[
    N@coords,
    Polygon[poly /. {x_Real, y_Real} :> First@nf[{x, y}]]
    ]
   ];

mesh = discretizeImage[binapple // DeleteSmallComponents]; // AbsoluteTiming
(*  {2.90293, Null}  *)

bmesh = BoundaryMesh@mesh

Mathematica graphics

$\endgroup$
  • $\begingroup$ Your Transpose and your MeshRegion impressed to me deeply.But considering the briefness and the running efficiency,I'll maintance my first acception still.Thanks very much all the same. $\endgroup$ – yode Sep 27 '15 at 20:53
  • $\begingroup$ @yode You're welcome. $\endgroup$ – Michael E2 Sep 27 '15 at 21:05
5
$\begingroup$
img = Import["http://i.stack.imgur.com/lkLgU.png"];

imgregion[im_] := 
 Polygon[Part[#, Last@FindShortestTour[#]] &@
   PixelValuePositions[
    MorphologicalPerimeter[
     Erosion[FillingTransform@ColorNegate@Binarize[im, 0.91], 2], 
     CornerNeighbors -> False], 1]]

RegionQ@imgregion[img]
True
RegionPlot[imgregion[img]]

Mathematica graphics

Graphics[imgregion[img]]

Mathematica graphics

$\endgroup$
  • $\begingroup$ Thanks for your help.The FindShortestTour is a good stuff.But I think there is a the blemish in this way,such as the binarize-picture isn't a complete part which combine many "white".The FindShortestTour will be shy.and the FindCurvePath is a bug function I think. $\endgroup$ – yode Sep 27 '15 at 10:48
  • 1
    $\begingroup$ +1. This is reasonably fast and avoids the problems of RegionPlot in the currently accepted answer (when it subdivides and is not just a proxy for BoundaryDiscretizeRegion). -- Do you know about PixelValuePositions? $\endgroup$ – Michael E2 Sep 27 '15 at 13:50
  • $\begingroup$ @MichaelE2 Thanks for the tip, I didn't know about PixelValuePositions. Answer updated. $\endgroup$ – rhermans Sep 27 '15 at 20:43
  • $\begingroup$ I was wandering if there was a good way to replace Binarize, for something more clever, incorporating the information that the area of interest is green, as the gray shadow is clearly not part of the apple. I'm aware of ColorSeparate, but that works only for Green {0,1,0} and in this case the dominant color is {0.482, 0.700, 0.191}. $\endgroup$ – rhermans Sep 27 '15 at 20:47
  • 2
    $\begingroup$ @rhermans Do you mean the ChanVeseBinarize? $\endgroup$ – yode Sep 27 '15 at 21:34

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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