# How can I make a density plot (or contour plot) with an arbitrary nonlinear scale (e.g. arcsinh, log, biexponential)?

I was inspired by this question, which showed how we can apply logarithmic scaling to a density plot.

But I'm not always a fan of a logarithmic scale - it tends to overemphasize smaller features. Consider the example from the post linked above, $\mathrm{sinc}(x)^2$. Here is a comparison of linear and log scaling,

GraphicsRow[{Plot[Sinc[x]^2, {x, -20, 20}, PlotRange -> All],
LogPlot[Sinc[x]^2, {x, -20, 20}]}, ImageSize -> 500]


Now look at the same plot using an arcsinh scale

Plot[ArcSinh[100 Sinc[x]^2]/ArcSinh[100], {x, -20, 20},
PlotRange -> All]


This is a useful scale since it has odd symmetry (ArcSinh[-x] = -ArcSinh[x]), and it is defined for x=0. And we can see below how it interpolates between linear and logarithmic scaling,

GraphicsRow[{Plot[ArcSinh[x], {x, -1, 1}, PlotRange -> All],
Plot[ArcSinh[x], {x, -1000, 1000}]}, ImageSize -> 500]


So what is the best way to implement this in a density or contour plot? How can the legend be modified to show the scale in an easy-to-read fashion? And would it be possible to make the plotting function versitile so that it can take other scaling functions? Ideally the function could handle negative values.

I had previously worked out a function to plot 2D spectroscopy signals using this scale, but looking at it now I'm a little embarrassed at how hacky it is.

Here is a slight simplification of Jason's code for scaled density plots:

Needs["CustomTicks"];
Options[nonLinearDensityPlot] =
{"ColorFunction" -> Automatic, "ScalingFactor" -> 100,
"ScalingFunction" -> Automatic, "SignedData" -> Automatic};

nonLinearDensityPlot[func_, {x_, xmin_, xmax_}, {y_, ymin_, ymax_},
plotopts : OptionsPattern[{nonLinearDensityPlot, DensityPlot}]] :=
Module[{col, legend, minval, maxval, scalingfunction, sf, sfun, signed},

{minval, maxval} =
Table[op[{func, xmin <= x <= xmax && ymin <= y <= ymax},
{x, y}], {op, {NMinValue, NMaxValue}}];

signed = OptionValue["SignedData"] /.
Automatic -> If[Abs[minval/maxval] < 0.01, False, True];

col = OptionValue["ColorFunction"] /.
{Automatic -> If[signed, ColorData[{"ThermometerColors", {-1, 1}}],
s_String :> If[signed, ColorData[{s, {-1, 1}}], ColorData[s]]};

sf = OptionValue["ScalingFunction"] /.
Automatic -> (ArcSinh[#1 #2/#3]/ArcSinh[#2] &);
scalingfunction = sf[#, OptionValue["ScalingFactor"], maxval, minval] &;

legend = BarLegend[{col, {-Boole[signed], 1}},
Ticks -> LinTicks[-1, 1,
TickPostTransformation ->
(scalingfunction[# maxval] &)] /.
Indeterminate -> 0];

DensityPlot[func, {x, xmin, xmax}, {y, ymin, ymax},
ColorFunction -> (Composition[col, scalingfunction][#] &),
ColorFunctionScaling -> False, PlotLegends -> legend,
Evaluate[FilterRules[{plotopts}, Options[DensityPlot]]],
PlotPoints -> 100, PlotRange -> All]]


Some examples:

nonLinearDensityPlot[Sinc[x]^2 Sinc[y]^2, {x, -20, 20}, {y, -20, 20},
ColorFunction -> "DeepSeaColors"]


nonLinearDensityPlot[x y Sinc[x]^2 Sinc[y]^2, {x, -20, 20}, {y, -20, 20},
ColorFunction -> "TemperatureMap"]


I haven't quite yet thought about how to cleanly re-implement the scaled contour plotting; I'll edit this if I come up with something.

• J.M. - looking into this now, thank you for your attention. Do you mind if I blatantly rip this off, and turn my answer into a community wiki? I want to get these optimized and wrap it up into a package (with attribution to contributors) Dec 16, 2015 at 11:20
• Certainly, you can use it as you see fit; as I said on my profile, my licensing is very permissive. ;) Dec 16, 2015 at 12:06
• A few points, so you may want to answer me in chat. How do you get such nice indentation? I had given up on it, and just let the front end blast it all to hell as it sees fit. Also, such a better way to treat an Automatic option than what I was doing with SameQ. Last, why does it not matter whether you use "ColorFunction" or ColorFunction as an option, when you've clearly defined only the string version to be an option? Dec 16, 2015 at 13:07
• Also, I thought the coloring was odd in your last plot, it seems there is some problem with the NMinValue function and how the constraints are applied. Dec 16, 2015 at 13:42
• (I warned you, lol) - Which of these color bars do you think goes better to display the nonlinear scaling? Dec 16, 2015 at 14:27

In order to make the legend properly, I elected to use the CustomTicks package, available here.

The code for the density plotting function is

<< "CustomTicks";

Options[nonLinearDensityPlot] = {"SignedData" -> Automatic,
"ScalingFactor" -> 100, "Color" -> Automatic,
"ScalingFunction" -> (ArcSinh[#1 #2 / #3]/ArcSinh[#2] &)};
nonLinearDensityPlot[func_, xvar_, yvar_,
plotopts : OptionsPattern[{DensityPlot, nonLinearDensityPlot}]] :=
Module[{scalingfunction, minval, maxval, legend, sf, col, signed},

sf = OptionValue["ScalingFactor"];

{minval,maxval} = Reap[
DensityPlot[func, xvar, yvar,
PlotRange -> All, PlotPoints -> 50,
EvaluationMonitor :> Sow[func]
]][[2, 1]] // MinMax;

signed = If[
SameQ[OptionValue["SignedData"], Automatic],
If[Abs[minval/maxval] < 0.01, False, True],
OptionValue["SignedData"]];

col = If[SameQ[OptionValue["Color"], Automatic],
If[signed, (ColorData[
"ThermometerColors"][.5 # + .5] &), (ColorData[
OptionValue["Color"]
];
scalingfunction[dat_] :=
OptionValue["ScalingFunction"][dat, sf, maxval, minval];

legend = BarLegend[{col, {If[signed, -1, 0], 1}},
Ticks ->
LinTicks[maxval If[signed,{-1.,-.4,-.2,0,.2,.4,1.0},{0,.2,.4,1.0}],
maxval If[signed,{-0.9,-0.8,-0.7,-0.6,-0.5,-0.3,0.1,0.3,0.5,0.6,0.7,0.8,0.9},{0.1,.3,.5,.6,.7,0.8,.9}],
TickPostTransformation -> (scalingfunction[# ] &),
TickLabelFunction->(NumberForm[#,ExponentFunction->(If[-2<#<2,Null,#]&)]&),
TickLabelStep -> 1] /.
Indeterminate -> 0];

DensityPlot[func, xvar, yvar,
PlotPoints -> 100,
PlotRange -> All,
PlotLegends -> legend, ColorFunction -> (col[scalingfunction[#]] &),
ColorFunctionScaling -> False,
Evaluate[FilterRules[{plotopts}, Options[Plot]]]
]

]


It can be called via

nonLinearDensityPlot[Sinc[x]^2 Sinc[y]^2, {x, -20, 20}, {y, -20, 20}]


It has it's own options, and can also take the options of DensityPlot (unfortunately, the color function has to be entered in this awkward way)

nonLinearDensityPlot[40 Sinc[x]^2 Sinc[y]^2, {x, -20, 20}, {y, -20, 20},
BaseStyle -> 18, "ScalingFactor" -> 1000,


You can even get the log plot from 's post by giving a custom scaling function,

nonLinearDensityPlot[Sinc[x]^2 Sinc[y]^2, {x, -20, 20}, {y, -20, 20},
"Color" -> (ColorData["DeepSeaColors"][#] &),
"ScalingFunction" -> (Log[#1/.00003]/Log[#3/.00003] &)]


And, finally, it can deal with data that takes positive and negative values.

nonLinearDensityPlot[
x y Sinc[x]^2 Sinc[y]^2, {x, -20, 20}, {y, -20, 20}]


The ContourPlot counterpart is a bit more complicated, as we need to use an inverse function to decide where to draw the contour lines,

     Options[nonLinearContourPlot] = {"SignedData" -> Automatic,
"ScalingFactor" -> 100, "Color" -> Automatic,
"ScalingFunction" -> (ArcSinh[#1 #2 / #3]/ArcSinh[#2] &),"NContours"->20};
nonLinearContourPlot[func_, xvar_, yvar_,
plotopts : OptionsPattern[{ContourPlot, nonLinearContourPlot}]] :=
Module[{scalingfunction, minval, maxval, legend, sf, col, signed,
inversescalingfunction, contourlevels},

sf = OptionValue["ScalingFactor"];

{minval,maxval} = Reap[
DensityPlot[func, xvar, yvar,
PlotRange -> All, PlotPoints -> 50,
EvaluationMonitor :> Sow[func]
]][[2, 1]] // MinMax;

signed       = If[
SameQ[OptionValue["SignedData"], Automatic],
If[Abs[minval/maxval] < 0.01, False, True],
OptionValue["SignedData"]];

col = If[SameQ[OptionValue["Color"], Automatic],
If[signed, (ColorData[
"ThermometerColors"][.5 # + .5] &), (ColorData[
"Rainbow"][#] &)],
OptionValue["Color"]
];
scalingfunction[dat_] :=
OptionValue["ScalingFunction"][dat, sf, maxval, minval];

inversescalingfunction = InverseFunction[scalingfunction[#] &];

contourlevels = ({inversescalingfunction[#/maxval] ,
col[#/maxval]} &) /@
Range[If[signed, -maxval, 0], maxval, maxval/OptionValue["NContours"]];

legend = BarLegend[{col, {If[signed, -1, 0], 1}},
Ticks ->
LinTicks[maxval If[signed,{-1.,-.4,-.2,0,.2,.4,1.0},{0,.2,.4,1.0}],
maxval If[signed,{-0.9,-0.8,-0.7,-0.6,-0.5,-0.3,0.1,0.3,0.5,0.6,0.7,0.8,0.9},{0.1,.3,.5,.6,.7,0.8,.9}],
TickPostTransformation -> (scalingfunction[# ] &),
TickLabelFunction->(NumberForm[#,ExponentFunction->(If[-2<#<2,Null,#]&)]&),
TickLabelStep -> 1] /.
Indeterminate -> 0];

ContourPlot[func, xvar, yvar,
PlotPoints -> 100,
PlotRange -> All,
PlotLegends -> legend,
Contours -> contourlevels,
ColorFunction -> (col[scalingfunction[#]] &),
ColorFunctionScaling -> False,
Evaluate[FilterRules[{plotopts}, Options[ContourPlot]]],
]

]


It can be called via

nonLinearContourPlot[
3 Sinc[x]^2 Sinc[y]^2, {x, -20, 20}, {y, -20, 20}, "NContours" -> 60]


Turning on ContourShading slows it down a good deal, and ends up making a similar plot to the DensityPlot

nonLinearContourPlot[
3 Sinc[x]^2 Sinc[y]^2, {x, -20, 20}, {y, -20, 20},