Speeding Up ImageApply / Binarize?

Question

I have a 5Kx4K image.

I'm wanting to binarize it.

At the moment, I have a simple binarization function, but it's taking 6 seconds or 8 seconds to binarize. ImageApply is actually faster than Binarize, which surprises me a bit.

Is there a way to speed up this computation?

imgLena = ExampleData[{"TestImage", "Lena"}];
imgBig = ImageAssemble[{{imgLena, imgLena, imgLena, imgLena, imgLena}
                      , {imgLena, imgLena, imgLena, imgLena, imgLena}
                      , {imgLena, imgLena, imgLena, imgLena, imgLena}}];
findEdges[rgb_] := If[( (rgb[[1]] < 0.7) && (rgb[[2]] > 0.5) && (rgb[[3 ]] > 0.5)), 1, 0];
fBinarize[rgb_] := (rgb[[1]] < 0.7) && (rgb[[2]] > 0.5) && (rgb[[3]] > 0.5);
Timing[ImageApply[findEdges, imgBig]]
Timing[Binarize[imgBig, fBinarize]]

ImageApply takes 6.5 seconds on my machine, and Binarize takes 7.8 seconds on my machine.

I was hoping for something on the order of 0.1 seconds. I can get close by cropping and other apriori knowledge, but is there a way to speed this computation up? I am particularly interested in stupid newbie errors. (I haven't used Mathematica in a few years.)

Answer 1

Break the image into r, g, b components and then use the second argument of Binarize to make the conditions different on each channel. The product of the three binary matrices is then your desired image.

{r, g, b} = ColorSeparate[imgBig];
Binarize[r, {0, 0.7}] Binarize[g, {0.5, 1}] Binarize[b, {0.5, 1}]

I think you'll find this is a lot faster.