# Plot number of overexposed pixels per column in grey scale image

I have a grey scale image (1600*480 pixels, 8 bit): https://i.imgur.com/BqgJRv7.png (update)

I want to determine the number of overexposed pixels in each column. Then I want to plot the a combined plot which is containing the image and the plot showing the number of overexposed pixels together with a smoothed curve.

Is this the right way how I did it? Can something be improved/corrected?

dim = ImageDimensions[image];

xaxis = Range[dim[[1]]];

overexposedPixelsPerColumn =
Count[Flatten@
Values[ComponentMeasurements[
ImageTake[image, {1, dim[[2]]}, {#, #}], "IntensityData"]],
brightness_ /; brightness == 1.] & /@ Range[dim[[1]]];

totalOverexposedPixels = Total@overexposedPixelsPerColumn;

maxOverexposedPixelsPerColumn = Max@overexposedPixelsPerColumn;

nPoints = 50;

smoothedOverexposedPixelsPerColumn =
MovingAverage[overexposedPixelsPerColumn, nPoints];

Show[
ListLinePlot[Transpose[{xaxis, overexposedPixelsPerColumn}],
InterpolationOrder -> 1, PlotStyle -> {LightGray},
Epilog -> {{PointSize[Large],
Point[Transpose[{xaxis, overexposedPixelsPerColumn}]]},
Inset[image, Scaled[{.5, 1}], Automatic, Scaled[1]]},
Frame -> True,
FrameLabel -> {{"# of overexposed pixels per column",
""}, {"column",
StringJoin["red curve: moving average over ", ToString[nPoints],
" pixels", "; total # of overexposed pixels=",
ToString[totalOverexposedPixels]]}},
PlotRange -> {All,
MinMax@(overexposedPixelsPerColumn) + {0,
Floor@(0.4*maxOverexposedPixelsPerColumn)}},
BaseStyle -> {FontWeight -> "Bold", FontSize -> 35,
FontFamily -> "Calibri"}, ImageSize -> 2000,
ImagePadding -> {{All, All}, {All, 50}},
PlotStyle -> {Blue, Thick}, AxesStyle -> Thick,
FrameStyle -> Thick],
ListLinePlot[
Transpose[{xaxis[[nPoints/2 ;; Length@xaxis - nPoints/2]],
smoothedOverexposedPixelsPerColumn}],
PlotStyle -> {Red, AbsoluteThickness[3]}]
]


It is hard to assess "IntensityData" from ComponentsMeasurements because I failed to find anything but a small entry in details section about it.

My comment was only slightly off, since Binarize treats the second parameter inclusively, that is 1. means anything <=1. will be 0 then the result is a black image. To exclude 1. we can flip it with ColorNegate:

img = Import @ "https://i.imgur.com/lPdFDcm.png";

data = Total /@
Transpose @ ImageData@ColorNegate@Binarize[ColorNegate@img, 0.] // N;
data // Total

ListPlot[
data, AspectRatio -> 1/3, ImageSize -> 600
]


Let me know if I made a mistake and I will delete the answer. If you find it more trustworthy I will try to update it later.

• What confuses me Dimensions[data] is 1413 instead of 1600. Ah, I see I uploaded the png file directly from the notebook with wrong size. I have now uploaded the one with 1600*480 pixels, see the link https://i.imgur.com/BqgJRv7.png. Sorry for the mistake. If I now use your code with this image it produces exactly what I got, when I use ListPlot[data, AspectRatio -> 1/3, ImageSize -> 600, PlotRange -> All]. Thank you for the solution. May be you can update your solution with the new file ...
– mrz
Nov 6, 2018 at 14:24