# Calculate area of apple from image

I want to find area of following apple

I want to do something like this:

define boundary region of apple

apple=...

then find area using only Area

Area[apple]

like this

I tried first few steps :

Binarize[Import[

• Total[ImageData@Binarize@pic, 2]? – Kuba Jun 29 '16 at 10:33
• @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. – Feyre Jun 29 '16 at 10:45
• @Kuba In fact, the answer is $262144-93601=168543$, which is the same as Length[Position[ImageData[c], 0]] – Feyre Jun 29 '16 at 10:48
• @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. – Kuba Jun 29 '16 at 11:00
• Reminds me a similar article on Estimation of the total surface area in Indian elephants winning the IgNobel prize in mathematics in 2002. – yarchik Jun 29 '16 at 21:05

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


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

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


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


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


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

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


{2, 3, 1450102}