15
$\begingroup$

I used the following clumsy way to obtain a bundle of black tulips. Is there a better way to do so?

im = Import["http://i.stack.imgur.com/qclHT.jpg"]

cols = DominantColors[im, 9]
rim1 = RemoveBackground[im, {"Background", { cols[[2]], 0.1}}];
rim2 = RemoveBackground[rim1, {"Background", { cols[[3]], 0.1}}];
rim3 = RemoveBackground[rim2, {"Background", { cols[[5]], 0.1}}] ;
rim4 = RemoveBackground[rim3, {"Background", { cols[[7]], 0.1}}] ;
rim5 = RemoveBackground[rim4, {"Background", { cols[[8]], 0.1}}] ;
rim6 = RemoveBackground[rim5, {"Background", { cols[[9]], 0.1}}] ;
ImageCompose[  ColorConvert[im, "Grayscale"], rim6]

enter image description here

$\endgroup$
22
$\begingroup$

One can apply here a smooth threshold with the criterion $$ r + b > \alpha g. $$

ImageApply[With[{t = (1 + Tanh[2 (1.5 #[[2]] - #[[1]] - #[[3]])])/2}, # t + 
    Mean[#] {1, 1, 1} (1 - t)] &, im]

enter image description here

The same with packed arrays:

Image@Transpose[#, {3, 1, 2}] &@
     With[{t = (1 + Tanh[2 (1.5 #2 - # - #3)])/
         2}, {# t, #2 t, #3 t} + 
       ConstantArray[(1 - t) Mean@{##}, 3]] & @@ 
   Transpose[#, {2, 3, 1}] &@ImageData@im

It is only 30% faster. I thing it is due to auto-compilation in ImageApply.

A darker version, which is closer to real-life black tulips:

With[{t = (1 - Tanh[4 (#[[1]] - #[[2]] - 0.5 #[[3]])])/2}, # t + 
    0.2 Mean[#] {1, 1, 1} (1 - t)] &, im]

enter image description here

$\endgroup$
4
  • 1
    $\begingroup$ wow. Those are believable in color. +1 $\endgroup$
    – rcollyer
    Sep 17 '14 at 12:47
  • 1
    $\begingroup$ How did you come up with the Tanh function? I'm by no means am image processing expert, but that can't be just a trial-and-error function... (+1 BTW) $\endgroup$
    – kale
    Sep 17 '14 at 13:25
  • 2
    $\begingroup$ @kale It is one of simple functions which gives a smooth version of UnitStep. Others are ArcTan, Erf, etc. Furthermore, these functions allow to construct a smooth version of TriangleWave and so on. $\endgroup$
    – ybeltukov
    Sep 17 '14 at 13:48
  • 2
    $\begingroup$ You could apply a mask for letting the leaves untouched. Something like Opening[Binarize@ ColorReplace[ColorSeparate[im, "HSB"][[1]], Black -> White, .003], 3] $\endgroup$ Sep 17 '14 at 14:25

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.