Using a given colour table with Image?

I think I finally succeeded in creating something faster.

Edit: now ~40X faster than ArrayPlot.

renderImage[
  array_?MatrixQ,
  cf_,
  q_Integer: 2048,
  opts : OptionsPattern[Image]
] := 
  Module[{tbl},
    tbl = List @@@ Array[cf, q, {0`, 1`}] // N // Developer`ToPackedArray;
    Image[tbl[[# + 1]] & /@ Round[(q - 1`) array], opts]
  ]

A test of function:

dat = Map[Mean, ImageData[Import["ExampleData/lena.tif"]], {2}];

ArrayPlot[dat, ColorFunction -> "Rainbow"]

renderImage[dat, ColorData["Rainbow"], ImageSize -> 300]

Mathematica graphics

Mathematica graphics

A test of speed:

big = RandomReal[1, {1500, 1500}];

ArrayPlot[big, ColorFunction -> "Rainbow"] // Timing // First

renderImage[big, ColorData["Rainbow"], ImageSize -> 300] // Timing // First

2.325

0.0624

And this time that's correct timing data.


Update

I have added a parameter q to control the number of quantization steps used. It arbitrarily defaults to 2048 which appears to be visually sufficient for most schemes and images. Examples of effect on quality and timing:

renderImage[dat, ColorData["Rainbow"], #, ImageSize -> 300] & /@ {7, 10000}

enter image description here

Needs["GeneralUtilities`"]

BenchmarkPlot[
 {renderImage[big, ColorData["Rainbow"], #] &},
 Identity,
 5^Range[9]
]

enter image description here