Colorize Grayscale Image

Question

I have a grayscale image that contains two objects. The grayscale pixel values can be divided into three intervals where two of them represent objects and the third represents the background. The background is almost uniform, with pixel values close to 0.5. The other two intervals are [.2,.4] and [.55,.73].

I developed a function to colorize this image. It works fine, but I'm looking for ways to make it run faster. Any suggestions?

colorizeFunction[image_, α_, β_, γ_, θ_] :=
  Module[{data, newdata, red, green, blue, datared, datagreen, 
   datablue, newdatared, newdatagreen, newdatablue}, (
   {red, green, blue} = ColorSeparate[image];
   datared = ImageData[red];
   datagreen = ImageData[green];
   datablue = ImageData[blue];
   newdatared = datared /. x_ /; α <= x <= β -> 1;
   newdatagreen = datagreen /. x_ /; α <= x <= β -> 0;
   newdatablue = datablue /. x_ /; α <= x <= β -> 0;
   newdatared = newdatared /. x_ /; γ <= x <= θ -> 0;
   newdatagreen = newdatagreen /. x_ /; γ <= x <= θ -> 1;
   newdatablue = newdatablue /. x_ /; γ <= x <= θ -> 0;
   ColorCombine[{Image[newdatared], Image[newdatagreen], 
     Image[newdatablue]}, "RGB"]
   )]

Answer 1

I think the key is Binarize but I couldn't figure out a good way to overlay colored parts on a grayscale image so this is rather hackish. At least it is quite a bit faster than your method:

colorize2[image_, α_, β_, γ_, θ_] :=
 ColorCombine[{
    ImageSubtract[ImageAdd[img, #1], #2],
    ImageSubtract[ImageAdd[img, #2], #1], 
    ImageSubtract[img, ##]}] &[
      Binarize[image, {α, β}], 
      Binarize[image, {γ, θ}]
    ]

Test:

img = ExampleData[{"TestImage", "Lena"}] ~ColorConvert~ "Grayscale";

colorize2[img, 0.2, 0.4, 0.55, 0.73]

---

Edit: I figured out HighlightImage but it is an order of magnitude slower than what I wrote myself:

colorize3[image_, α_, β_, γ_, θ_] := Fold[
  HighlightImage[#, Binarize[image, #2[[1]]],
    Method -> "Solid", "HighlightColor" -> #2[[2]]] &,
  image,
  {{{α, β}, Red}, {{γ, θ}, Green}}
]

---

Edit #2: Another method, perhaps more pleasing in style, but twice as slow as colorize2:

extract[i_][x_, y_, c_] := # ~ImageMultiply~ c ~SetAlphaChannel~ # & @ Binarize[i, {x, y}]

colorize4[image_, α_, β_, γ_, θ_] := 
  Fold[ImageCompose, image, extract[image] @@@ {{α, β, Red}, {γ, θ, Green}}]

---

Edit #3: A slightly faster but less clean version of colorize2 leveraging this:

colorize2fast[image_, α_, β_, γ_, θ_] :=
 ColorCombine[
   Image /@ {Subtract[#3 + #, #2],
             Subtract[#3 + #2, #],
             Subtract[#3, # + #2]},
 ] & @@ ImageData /@
         {Binarize[image, {α, β}],
          Binarize[image, {γ, θ}],
          image}

Answer 2

something like this?

  ImageApply[ If[ # < .5, {1, 0, 0}, {0, 1, 0}] &, 
       ExampleData[{"TestImage", "Gray21"}] ]

another example, looking again I guess you want to leave gray outside the specified ranges.

 ImageApply[Piecewise[{ 
     {{1, 0, 0}, .1 < # < .3},
     {{0, 0, 1}, .6 < # < .7},
     {{#, #, #}, True}}] &, ExampleData[{"TestImage", "Boat"}]]