Custom ColorFunction/ColorData in ArrayPlot (and similar functions)

Question

This is related to Simon\'s question on changing default ColorData in Mathematica. While the solutions all addressed the issue of changing ColorData in line plots,

Answer 1

(I hope this isn't too late an addendum.)

As it turns out, one doesn't even need to keep the entire set of sixty-four RGBColor[] directives around for the purpose of using with Blend[] A clue that this is certainly the case is afforded by ListPlot[]s of the columns of cMap:

{rr, gg, bb} = Transpose[Rationalize[cMap]];
GraphicsGrid[{MapThread[
   ListPlot[#1, DataRange -> {0, 1}, Frame -> True, 
     GridLines -> {{1/9, 23/63, 13/21, 55/63}, None}, 
     PlotLabel -> #2] &, {{rr, gg, bb}, {"Red", "Green", "Blue"}}]}]

and we see that implicitly, the functions representing these components are piecewise linear. Since Blend[] necessarily does linear interpolation between colors, if we can find those colors that correspond to "corners" in the piecewise linear graphs, we can eliminate all the other colors in between those corners (since Blend[] will do the interpolation for us), and thus potentially have to carry around only, say, seven as opposed to sixty-four colors.

From reading the code given above, you'll note that I already found those transition points for you (hint: check the setting for GridLines). Further hints on what those colors might be are furnished by the documentation for colormap():

jet ranges from blue to red, and passes through the colors cyan, yellow, and orange.

Could it be? Let's check:

cols = RGBColor @@@ Rationalize[cMap];
Position[cols, #][[1, 1]] & /@ {Blue, Cyan, Yellow, 
  Orange // Rationalize, Red}
{8, 24, 40, 48, 56}

This just gives the positions of the colors within the array cols, but we can rescale things to correspond to the argument range expected of a colormap:

(# - 1)/(Length[cols] - 1) & /@ %
{1/9, 23/63, 13/21, 47/63, 55/63}

and those are precisely where the breakpoints of the piecewise linear functions corresponding to RGB components of the colormap are. That is five colors; to ensure a smooth interpolation, we add the first and last colors as well to this list,

cols[[{1, Length[cols]}]]
{RGBColor[0, 0, 9/16], RGBColor[1/2, 0, 0]}

paring the original cols list to a total of seven. Since 7/64 is approximately 11%, this is a pretty big savings.

Thus the color function we seek is

jet[u_?NumericQ] := Blend[
        {{0, RGBColor[0, 0, 9/16]}, {1/9, Blue}, {23/63, Cyan}, {13/21, Yellow},
         {47/63, Orange}, {55/63, Red}, {1, RGBColor[1/2, 0, 0]}}, 
                          u] /; 0 <= u <= 1

We make two comparisons to verify jet[]. Here's a gradient plot comparing the ColorFunctions jet and Blend[cols, #]&:

GraphicsGrid[{{
   Graphics[Raster[{Range[100]/100}, ColorFunction -> (Blend[cols, #] &)], 
    AspectRatio -> .2, ImagePadding -> None, PlotLabel -> "Full", 
    PlotRangePadding -> None], 
   Graphics[Raster[{Range[100]/100}, ColorFunction -> jet], 
    AspectRatio -> .2, ImagePadding -> None, 
    PlotLabel -> "Compressed", PlotRangePadding -> None]}}]

and here's a mechanical verification that the 64 colors in cols are nicely reproduced:

Rationalize[Table[jet[k/63], {k, 0, 63}]] === cols
True

You can now use jet[] as a ColorFunction for any plotting function that supports it. Enjoy!

Answer 2

Replace your ColorData["Rainbow"] with this one:

Function[Blend[RGBColor @@@ cMap, Slot[1]]]

and you get this:

---

As to your second question, you can do it this way:

xMax = 3; yMax = 3;
img = Transpose@
   Table[Sin[y^3 + x^2], {x, -xMax, xMax, 0.01}, {y, -yMax, yMax, 
     0.01}];
plot = ArrayPlot[img, 
  ColorFunction -> Function[Blend[RGBColor @@@ cMap, Slot[1]]], 
  AspectRatio -> 1, FrameTicks -> Automatic, 
  DataRange -> {{-xMax, xMax}, {-yMax, yMax}}, DataReversed -> True]

but why don't you use DensityPlot?

DensityPlot[Sin[y^3 + x^2], {x, -xMax, xMax}, {y, -yMax, yMax}, 
 ColorFunction -> Function[Blend[RGBColor @@@ cMap, Slot[1]]], 
 PlotPoints -> 300]

---

EDIT
Note that in the second plot the y-range labeling is reversed. That's because it takes the DataReversed setting into account. ArrayPlot plots the rows of the arrays in the same order as they appear when the array's content is printed on screen. So the first row is plotted on top and the last row is plotted at the bottom. High row values correspond to low y-values and vice versa. DataReversed->True corrects for this phenomenon, but in this case it also 'corrects' the y values. A workaround is to fill the array starting from high y-values going down to the lower ones. In that case you don't need DataReversed:

xMax = 3; yMax = 3;
img = Transpose@
   Table[Sin[y^3 + x^2], {x, -xMax, xMax, 0.01}, {y, 
     yMax, -yMax, -0.01}];
plot = ArrayPlot[img, 
  ColorFunction -> Function[Blend[RGBColor @@@ cMap, Slot[1]]], 
  AspectRatio -> 1, FrameTicks -> Automatic, 
  DataRange -> {{-xMax, xMax}, {-yMax, yMax}}]