3
$\begingroup$

I want to find area of following apple

enter image description here

I want to do something like this:

define boundary region of apple

apple=...

then find area using only Area

Area[apple]

like this

enter image description here

I tried first few steps :

Binarize[Import[
"http://pngimg.com/upload/small/apple_PNG12438.png"]] //ColorNegate
$\endgroup$
5
  • $\begingroup$ Total[ImageData@Binarize@pic, 2]? $\endgroup$ – Kuba Jun 29 '16 at 10:33
  • $\begingroup$ @Kuba, ImageDimensions[] gives {512,512}, which gives a total area of $262144$, so I doubt that value which is about a third of total area, can be correct. $\endgroup$ – Feyre Jun 29 '16 at 10:45
  • $\begingroup$ @Kuba In fact, the answer is $262144-93601=168543$, which is the same as Length[Position[ImageData[c], 0]] $\endgroup$ – Feyre Jun 29 '16 at 10:48
  • $\begingroup$ @Feyre Total[ImageData@Binarize@Import["http://i.stack.imgur.com/4nyum.png"], 2] gives 168543. I should have stressed out that I haven't used OP's code at all but it could have been deduced from the fact that I used Binarize. $\endgroup$ – Kuba Jun 29 '16 at 11:00
  • 1
    $\begingroup$ Reminds me a similar article on Estimation of the total surface area in Indian elephants winning the IgNobel prize in mathematics in 2002. $\endgroup$ – yarchik Jun 29 '16 at 21:05
9
$\begingroup$

One way to do this is to use DominantColors as follows.

im = Import["http://pngimg.com/upload/small/apple_PNG12438.png"];
res = DominantColors[im, Automatic, {"Count", "Color"}]

enter image description here

To be sure if the reddish color is indeed the eatable part of the apple check this.

eatable=DeleteSmallComponents@First@DominantColors[i, Automatic, "CoverageImage"]

enter image description here

Now the exact eatable part can be recovered as the first entry of the output.

DominantColors[eatable, Automatic, {"Count", "Color"}]

{152709, 109435}

Now what the OP wanted!

positions = ImageValuePositions[ColorNegate@EdgeDetect@eatable, 0];
apple = Graphics[
   FilledCurve[Line[positions[[Last@FindShortestTour[positions]]]]]] //
   DiscretizeGraphics[#, MaxCellMeasure -> 0.1] &

enter image description here

And we can get the area..

{Area[apple], NIntegrate[1, {x, y} \[Element] apple]}

{152615.,152615.}

But who eats a 2D apple..

But we can also make a 3D apple and calculate how much surface we need to munch.

pts = positions[[Last@FindShortestTour[positions]]];
par = BSplineFunction[ExponentialMovingAverage,TranslationTransform[-Mean@pts] /@ pts, .25],
SplineClosed -> True, SplineDegree -> 2];
ap = RevolutionPlot3D[{First@par[t], Last@par[t], t}, {t, 0, 1},RevolutionAxis -> {0, 1, 0},
PlotPoints -> 60, MaxRecursion -> 3,Mesh -> None, Boxed -> False, Axes->False];
appleColor = res[[1, 2]];
apple3D = DiscretizeGraphics[
  Cases[Normal@ap, _GraphicsGroup, -1][[1]],
  MeshCellStyle -> {{2, All} -> 
     Directive[res[[1, 2]], Specularity[White, 20], 
      Glow[Darker[appleColor, .5]], Lighting -> "Neutral"],
    {1, All} -> Directive[Thin, Darker@res[[1, 2]]]}
  ]

enter image description here

And here goes the surface/munching area with some dimensional info..

{RegionDimension@apple3D,RegionEmbeddingDimension@apple3D,IntegerPart[RegionMeasure@apple3D]}

{2, 3, 1450102}

$\endgroup$

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.