1
$\begingroup$

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.

Original 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]

enter image description here

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.

$\endgroup$
1
$\begingroup$

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}]

enter image description here

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

enter image description here

(* color image again and compare with original *)

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

enter image description here

ImageSubtract[colored, img]

enter image description here

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.

$\endgroup$
  • $\begingroup$ Thank you. I built the [linear](mathematica.stackexchange.com/questions/87588/…. ) “sorting” the original image’s colors from blue to red. pix = ImageData[im]; dims = Dimensions@pix; stepx = 15; stepy = 15; discCols = Table[RGBColor[pix[[i, j]]], {i, stepx, dims[[1]], stepx}, {j,stepy, dims[[2]], stepy}]; o1 = Reverse@SortBy[Flatten@discCols, ColorConvert[#, "HSB"][[1]] &]; Image[#, ImageSize -> 400] & /@ {Table[o1, {100}], Table[o2, {100}]}Now the o1 array can be used to construct a linear scale and that scale on the Jet function. $\endgroup$ – Granados Jul 26 '18 at 16:28

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.