How to build a linear scale from a set of RGB color data obtained from a raster image with ImageData?

Question

I'm trying to reconstruct a density plot from a raster image. The idea is to assign the uppermost value of the scale (an arbitrary linear scale) to the "most red" points of the image, and the lowest value to the "most blue" part of the image.

What I have tried so far is to convert the image to gray scale, then get the image's pixel values with ImageData and multiply them by an arbitrary factor to get the [0,100] scale.

im = Import["https://imgur.com/Cm549qE.png"]
imG = ColorConvert[im, "Grayscale"];
imgData = 100 ImageData[imG];
ListDensityPlot[Reverse[imgData], ColorFunction -> "TemperatureMap",
PlotLegends -> Automatic]

This approach doesn't work because both the most red and the most blue parts of the image are assigned roughly the same value in the resulting density plot.

This question is perhaps related to this post but I haven't been able to adapt the code to my problem. Could someone suggest another solution? Thank you.

Answer 1

The problem with your approach (as you've probably realized) is that your mapping from color->value doesn't account for the color scale used for the plot (it just uses the brightness of each color for the mapping). The following code demonstrates how we can build a lookup function that returns the "correct" value for a given color. This is done the following way:

• First, create a list of color distances from the target color to the lookup-table
• Then, find the index of the lowest value
• Rescale that one to $[0,1]$

The code:

img = Import["https://i.stack.imgur.com/Psasj.png"];

(* Jet color scale from https://stackoverflow.com/a/9321152 *)
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

lut = Jet /@ Range[0, 1, 0.01];

(* use memorization to speed up the mapping over the image *)
Clear@getVal;
getVal[c_] := 
 getVal[c] = 
  Rescale[First@Ordering[ColorDistance[lut, c], 1], {1, Length@lut}]

(* check how well the inversion works *)
Plot[getVal@Jet@x, {x, 0, 1}]

reconstructed = ImageApply[getVal@*Apply[RGBColor], img]

(* color image again and compare with original *)

colored = Image[Map[Jet, ImageData@reconstructed, {2}]]

ImageSubtract[colored, img]

Clearly, the result is not perfect, there are some deviations, especially in the green areas. You can try to improve the result by choosing a color scale that more closely matches the one of your image.