# Coloring an image with two Color schemes based on a Range

I would like to color an image generated from some data, using two color schemes based on two ranges of the data. This is my attempt:

Image[RandomReal[1, {10, 10}],
ColorFunction -> (Piecewise[{{ColorData["AlpineColors"][#],  0 < # < .5},
{ColorData["SouthwestColors"][#], .5 < # < 1}}] &)]]

• ArrayPlot[RandomReal[1, {10, 10}], ColorFunction -> (Piecewise[{{ColorData["LightTerrain"][#], 0 < # < .5}, {ColorData["TemperatureMap"][#], .5 < # < 1}}] &), Frame -> None] Mar 4, 2015 at 20:39
• Please see (76610) as it has bearing on this question. Mar 6, 2015 at 8:48

## 5 Answers

Here is something 10 x faster.

I made the same assumption as george2079 so for each subinterval whole color scheme is used not just exact part like in Simon's answer. Maybe useful, maybe not.

### Usage

colorF ~ createColorFunction ~ {"TemperatureMap", "AvocadoColors"};

pic = Image@ConstantArray[Range[0, 1, .001], 100]
Colorize[pic, ColorFunction -> colorF]


It is quite general, you can use arbitrary set of schemes:

colorF ~ createColorFunction ~  {"AlpineColors", "AvocadoColors",
"TemperatureMap", "SouthwestColors"};
Colorize[pic, ColorFunction -> colorF]


colorF ~ createColorFunction ~ RandomSample[ColorData["Gradients"], 10];
Colorize[pic, ColorFunction -> colorF]


colorF ~ createColorFunction ~ RandomSample[ColorData["Gradients"], 2];

Colorize[#, ColorFunction -> colorF, ColorFunctionScaling -> False] &@
ColorConvert[ExampleData[{"TestImage", "Lena"}], "Grayscale"]


The problem is condition which has to be checked for each pixel. We can take a walk around,

### Definition

SetAttributes[createColorFunction, HoldFirst];
createColorFunction[functionname_, schemes_List] := Module[{
colorss, setsNum, setsLength
},
Blend[{Red},1]; (*initialize Color stuff*)
colorss = DataPacletsColorDataDumpgetColorSchemeData[#][[5]] & /@ schemes;
setsNum = Length@colorss;
setsLength = Length /@ colorss;

functionname = With[{colorSets = Transpose[{
Accumulate[
Join @@ Table[
PadRight[{0}, setsLength[[i]],
1./((setsLength[[i]] - 1) setsNum)], {i, setsNum}]],
Join @@ colorss}]
},
Blend[colorSets, #] &
]
]


### Explanation

The ugly code in Accumulate takes lists of colors and creates:

{{c11, c12, c13}, {c21, c22, c23, c24, c25}}
------------->
{
{0, 0.25, 0.5,    0.5, 0.625, 0.75, 0.875, 1.},
{c11, c12, c13, c21, c22, c23, c24, c25}
} //Transpose


Which can be used to create Blend arguments. Colors sets are given by Blend code for built-in ColorData schemes

• I feel inclined to produce my own version of this method. Would you prefer that I edit your question to include it, or post my own answer? Mar 6, 2015 at 9:10
• @Mr.Wizard feel free to post your own if you want. I went with George's interpretation, you can with Simon's.
– Kuba
Mar 6, 2015 at 23:09

You can use Colorize for this

Colorize[RandomImage[1, {10, 10}], ColorFunction -> (Piecewise[
{{ColorData["AlpineColors"][#], 0 < # < .5},
{ColorData["SouthwestColors"][#], .5 < # < 1}}] &)]


• I don't get this, your code for RandomImage[1, {100, 100}] takes around 10s but for Image@ConstantArray[Range[0, 1, .01], 100] only 0.5s. It is not related to the type of data because ColorFunction -> (Blend[{Blue, Red}, #] &) is fast for both. I tried your code with the first setup, that is why I commited to manual approach, which seems to be an overkill probably. Do you know what is going on?
– Kuba
Mar 5, 2015 at 20:26
• @Kuba, weird. I have no idea why that should be the case! I only tried it with the 10x10 image so didn't realise how slow it was. Mar 5, 2015 at 22:01
• @Kuba I usually use Mr Wizard's renderImage function for this sort of thing. Mar 5, 2015 at 22:04
• @Kuba Merely looking at the code I do not see an obvious reason for it to be slow. I shall see what I can find with a closer inspection. Mar 6, 2015 at 2:44
• @Kuba Self Q&A posted: (76610) Mar 6, 2015 at 8:45

Here is a slightly compacted re-implementation of Kuba's routine. Its only caveat is that it will not work for gradients with non-equispaced colors, like "BrightBands"; the routine can be modified for that case, but it will be a bit more complicated.

chimeraColors[cols : {__String}] := Module[{bl, cl},
cl = ColorData[#, "BlendArgument"] & /@ cols;
If[! MatchQ[cl, {cc__?(VectorQ[#, ColorQ] &)}], Return[$Failed]]; bl = Transpose[Join @@@ {MapThread[Rescale[#1, {0, 1}, #2] &, {Subdivide[Length[#] - 1] & /@ cl, Partition[Subdivide[Length[cl]], 2, 1]}], cl}]; With[{c = bl}, Blend[c, #] &]]  Some examples: cfun = chimeraColors[{"DeepSeaColors", "ThermometerColors", "SolarColors"}]; LinearGradientImage[cfun, {600, 60}]  cfun = chimeraColors[{"Pastel", "CMYKColors"}]; Colorize[ExampleData[{"Texture", "Bubbles"}], ColorFunction -> cfun, ColorFunctionScaling -> False]  Added 6/30/2016 I present here a routine for the generalization of the OP's desire to use different color gradients in different intervals. This avoids the slowness observed by Kuba and the Wizard by directly constructing a Blend[] function from stitched-together pieces of the component color gradients. Here it is: bricolage[lst : {{_?NumericQ, _String} ..}] := Module[{cc, cl, dc, dl, gl, il, kl, nl}, {nl, gl} = Transpose[SortBy[lst, First]]; If[! (And @@ Thread[0 <= nl <= 1]) || Complement[gl, DataPacletsColorDataDumpgradientSchemeNames] =!= {}, Return[$Failed]];
nl = Sort[nl]; If[Last[nl] != 1, AppendTo[nl, 1]];
cl = ColorData[#, "BlendArgument"] & /@ gl;
If[MemberQ[cl, l_ /; ! VectorQ[l, ColorQ]], Return[\$Failed]];
kl = (Length /@ cl) - 1; dl = Subdivide /@ kl; il = Partition[nl, 2, 1];
dc = MapThread[Take[#1, Floor[#2 #3] + {2, 1}] &, {dl, il, kl}];
cc = MapThread[Take[#1, Floor[#2 #3] + {2, 1}] &, {cl, il, kl}];
cc = MapThread[Flatten[{If[#1[[1]] != #3[[1]],
ColorData[#4, #3[[1]]], Nothing],
#2,
If[#1[[-1]] != #3[[-1]],
ColorData[#4, #3[[-1]]], Nothing]}] &,
{dc, cc, il, gl}];
dc = MapThread[Union[Flatten[Insert[#2, #1, 2]]] &, {dc, il}];
With[{l = Flatten[{dc, cc}, {{2, 3}, {1}}]}, Blend[l, #] &]]


At the moment, the routine does not support color gradients where the colors are not equispaced (e.g. "BrightBands" or "M10DefaultDensityGradient"). Otherwise, it works quite well:

(* OP's color function *)
cfun = bricolage[{{0, "AlpineColors"}, {1/2, "SouthwestColors"}}];
LinearGradientImage[cfun, {600, 60}]


cfun = bricolage[{{0, "IslandColors"}, {2/5, "LightTerrain"}, {3/4,  "SandyTerrain"}}];
Colorize[ExampleData[{"Texture", "Bubbles"}], ColorFunction -> cfun,
ColorFunctionScaling -> False]


One approach:

 ImageApply[
List @@ Piecewise[{
{ColorData["AlpineColors"][2 #], 0 < # < .5},
{ColorData["SouthwestColors"][2 # - 1 ], .5 < # < 1}
}] &, Image[RandomReal[1, {10, 10}]]]


or

 Image[Map[
List @@ Piecewise[{
{ColorData["AlpineColors"][2 #], 0 < # < .5},
{ColorData["SouthwestColors"][2 # - 1 ], .5 < # < 1}}] &  ,
RandomReal[1, {100, 100}], {2}]]


( identical timing .. )

This is simply the correct version of your original approach:

Graphics[{Raster[RandomReal[1, {10, 10}],
ColorFunction -> (Piecewise[{{ColorData["AlpineColors"][#],
0 < # < .5}, {ColorData["SouthwestColors"][#], .5 < # < 1}}] &)]}]


ColorFunction is an option of Raster, Image has no such option.