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/