Re: How to change individual colors of an image

*To*: mathgroup at smc.vnet.net*Subject*: [mg125079] Re: How to change individual colors of an image*From*: Szabolcs Horvát <szhorvat at gmail.com>*Date*: Mon, 20 Feb 2012 02:53:42 -0500 (EST)*Delivered-to*: l-mathgroup@mail-archive0.wolfram.com*References*: <jho1tn$5r0$1@smc.vnet.net>

On 2/18/2012 1:26 PM, Alexei Boulbitch wrote: > Dear community, > > > > My question relates to the work with an image. There are plenty of operators influencing the image as a whole. May be I have missed, but I could not find, if it is possible to work with all pixels possessing a given colour, (or may be, a group of colours close to one another) in such a way that this colour changes to another that is desired one. > > > > To be precise, below I paste a full form of a small piece of an image with white (or light gray), black and red fragments. Is it possible to say, change black into blue? Light gray into yellow? > > > > To see the image please copy-paste the 30 lists given below along with two code lines (combining them into the image) into Mathematica and execute: > > > Dear Alexei, A simple way to send complex expressions is using Compress/Uncompress (see at the end of this message). There are several ways to achieve what you need, but I am going to show a more general way here, called masking. This can be generalized to many problems. Suppose the image is stored in variable img Let's first find all pixels that have colour {138, 138, 138}/255 mask = Binarize[img, # == {138, 138, 138}/255 &] Alternatively use colours that are close to this shade of grey: mask = Binarize[img, Norm[# - {138, 138, 138}/255] < 0.05 &] Then change the image in the matching region green (i.e. colour {0,1,0}: ImageApply[{0, 1, 0} &, img, Masking -> mask] If you have Mathematica 7, you could use ImageApply directly: ImageApply[If[# == {138, 138, 138}/255, {0, 1, 0}, #] &, img] ------------------->8------------------ This is the image in a more compact and ASCII-only format: img = Uncompress@ "1:eJzt189r03AYx/GQ/pisddY1zKgz61Zk3qzCGN5cN5QdJjQVVCi6VLLNWt uRtdlSEBnIdIo/Bh7UeVA3wR8nxds8zv/LJ8/DJ7S5CjuEvXg3JDR8H8q3tG S02jQX4oqirCToMPvAWrQXVP/yCB1Ma3XKcSyv7N9Q9Fp2NUYnBr3y9PLP/8 I++wN77Bf7AV/YQ7jAhuAUG4PRXgc2aB/2esmI7+wTfGDP4RobhhEWWj+Ye2 CDQuv/hp9sh32EN+wVVNg4GOwMDPWK3qDgayab8g12mQx6B7L+Otxm5+AkC1 bWe0VvUGhTPkP3iC14xh7BLXYWtGyWyuq6dJw7oWnS4aD/HxT6tdlmb9lTkP WXwSyVKCOXk5KaRvXrupTTNKqYyUjRGxTalG2QEbIpT2CN3a/VpKmZGUo3DO loJkOdHhyULiWTVDUel6I36CvI+jvwmm2wDrjsRqUiFSYmqOGBAel8KkWV+/ okLxajXqL30P0RiOz+aqdDNVxXkv+F2clJ6XIqRc2pqrSkKNQ6esFtoegN2o XuTfH3xfMoGXRzfl6aLhSoUjotLdHiqtpQFKnNPUab3AaK3qBgUzbZGtTZFT aSz0vHEgnqoqJIc9wdVONayOU6KHqDgucMeQTxr8x23V7pp5PpZr3plJetu3 bZf/AwrxZDN6X955dGy3bqtuXeayzyO9edtv0P0u64wA==" -------------------8<------------------ This is how it was generated: wrap[string_, width_] := StringJoin@ Riffle[Partition[Characters[string], width, width, {1, 1}, {}], "\n"] wrap[Compress[img], 60] -- Szabolcs Horvát Visit Mathematica.SE: http://mathematica.stackexchange.com/