0
$\begingroup$

I have an image showing a density plot from a paper, as well as the corresponding color bar. I am trying to convert this back to a 2D array of intensities.

enter image description here

2

Here's what I did, which works but seems to be imperfect.

imagedata = ImageData[plotimage]
colordata = ImageData[colorimage][[row]]

where row is a number which selects a single row out of the center of the color bar. imagedata is a rank 2 array of {R,G,B} values, while colordata is a rank 1 array of {R,G,B} values (between 0 and 1). I assume the color bar goes from 2 to 7. I then sample a number of colors from the bar with equal spacings,

colorbar = colordata[[1;;-1;;step]] for some integer step such as step = Round[Length@colordata/30.]. Let ncols = Length@colorbar, the number of color samples. This looks like

cols = RGBColor@@#&/@colordata[[2 ;;]] enter image description here

Since the image has a lot of white space which I want to differentiate, I add a single white element as the first element: colorbar = Prepend[colorbar,{1,1,1}].

Now my basic strategy is to get each pixel's {R,G,B} (I downsample the image to make this process not take forever because it's rather inefficient) and associate it to a single element of colorbar. I don't know the best way to do this, but my strategy right now is to minimize Norm[{R,G,B}-{R',G',B'}], to find the {R',G',B'} in colorbar which is "closest" by this metric to the color of the pixel, I don't know if this is a good method of color matching though. I define a function

f[c_] := Module[{n},
  n = First@First@Position[colordata,#]&@First@MinimalBy[colordata,Norm[c-#]&]-1;
  If[n==0, 0, 2. + 5 n/ncols]
]

which takes an {R,G,B} vector, uses MinimalBy to find the element of colorbar for which the Norm of the difference is minimal, and returns its index minus one. Since white was the first index, if the result it zero I return 0 while for non-white colors I scale the output between 2 and 5 like the original color scale.

Defining a color function from the sampled colors,

colorf[x_] := Blend[cols,(x-2)/5]

the plotted result looks like this:

imagedataConverted = ParallelTable[
   f[imagedata[[j, i]]],
   {j, 1, Dimensions[imagedata][[1]], 1},
   {i, 1, Dimensions[imagedata][[2]], 1}
];

ListDensityPlot[imagedataConverted,
 ColorFunction -> colorf,
 ColorFunctionScaling -> False,
 InterpolationOrder -> 0,
 PlotLegends -> Placed[BarLegend[{colorf, {2, 7}}], Above],
 PlotRange -> {2, 7},
 ImageSize -> Small]

enter image description here

This seems to work, but there are some subtle differences in the output. Overall it seems to me that the output is on average a bit lighter, and especially so near the edges. This is causing me some issues because I want the match to be as close as possible, and I cannot find a way to improve the accuracy of this method. Is there a simpler/more accurate way to do this? Bonus for efficiency.

$\endgroup$
2
  • $\begingroup$ I think it's also flipped compared to the source. Try Reverse-ing your data at level 1, 2, or both? $\endgroup$ – thorimur May 12 at 0:24
  • $\begingroup$ @thorimur it is but I'm not worried about that $\endgroup$ – Kai May 12 at 0:34
0
$\begingroup$

My method seems to work, the only thing I needed to change is the color norm. Using ColorDistance improved the results significantly.

f[c_] := Module[{n},
  n = First@First@Position[colordata,#]&@First@MinimalBy[colordata,ColorDistance[RGBColor@c,RGBColor@#]&]-1;
  If[n==0, 0, 2.+5n/ncols]
]
$\endgroup$

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.