4
$\begingroup$

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"]
   )]
$\endgroup$
3
$\begingroup$

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]

enter image description here


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}
$\endgroup$
  • $\begingroup$ colorize2[] is ~ 13 faster than colorizeFunction[]. But the color is not uniform. For example the green pixels haven't the same values like {a,b,c}. $\endgroup$ – BetterEnglish Oct 20 '14 at 19:44
  • $\begingroup$ But colorize2[] is 1.04 faster than colorize3[]. perfect $\endgroup$ – BetterEnglish Oct 20 '14 at 19:49
  • $\begingroup$ @Developer2000 Could you give me an example of the non-uniform colors? I am seeing e.g. {{0., 1., 0.}, {0., 1., 0.}, {0., 1., 0.}, {0., 1., 0.}, ... in the upper left corner of the image in my answer. $\endgroup$ – Mr.Wizard Oct 20 '14 at 19:54
  • $\begingroup$ @Developer2000 Your comment that colorize2 is only 13 times faster than the original made me look at things again. It was my mistake to use Timing rather than AbsoluteTiming, but correcting that I still measure about 45X faster in 10.0.1 under Windows. Which version are you running? $\endgroup$ – Mr.Wizard Oct 20 '14 at 20:02
  • $\begingroup$ @Developer2000 I added colorize2fast which tests somewhat faster still on my machine. Please try it. $\endgroup$ – Mr.Wizard Oct 20 '14 at 20:09
5
$\begingroup$

something like this?

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

enter image description here

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

enter image description here

$\endgroup$
  • $\begingroup$ thanks for your response. I edit my question to be more clear. $\endgroup$ – BetterEnglish Oct 20 '14 at 16:13

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.