DensityPlot with only vertical color scaling

Questions
1

I am trying to make a DensityPlot employing a NormalDistribution. It works more or less as I want, but I would like to show the colors relative only to the vertical distribution of the function, instead of absolute to all the values in the plot.

Here is an example of what I am trying to make:

a = 0.1;
b = 0.01;
s0 = 0.1;

mu[x_] := 1./(1. + Exp[-a x]);
s[x_] := s0 Exp[-b x];

f[x_, y_] := PDF[NormalDistribution[mu[x], s[x]], y];

DensityPlot[f[x, y], {x, 0, 100}, {y, 0, 1}, 
 ColorFunction -> ColorData[{"SunsetColors", {1/2, 0}}], 
 ColorFunctionScaling -> True, PlotTheme -> "Scientific", 
 PlotLegends -> None, AspectRatio -> 1./GoldenRatio, 
 PlotRange -> {{0, 100}, {0, 1}, Full}, PlotPoints -> 50, 
 FrameLabel -> {"x", "y"}]

I would like to show how the standard deviation of the distribution decays in the horizontal direction, with all the mean values (peaks) with equal color intensity. However, I haven’t been successfull so far.

Any idea how can this be done in Mathematica?

Thanks in advance for any help!

2

Simply normalize the PDF so that its peaks to value 1:

DensityPlot[
 f[x, y]/PDF[NormalDistribution[mu[x], s[x]], mu[x]], {x, 0, 
  300}, {y, .4, 1.2}, 
 ColorFunction -> ColorData[{"SunsetColors", {1/2, 0}}], 
 ColorFunctionScaling -> True, PlotTheme -> "Scientific", 
 PlotLegends -> None, AspectRatio -> 1./GoldenRatio, 
 PlotPoints -> 100, FrameLabel -> {"x", "y"}, PlotRange -> All]
3

Thanks for your reply, Gianluca.

It looks like an interesting idea. However, the standard deviation is still shown as constant, while I would like it to decrease in the X axis.

4

But the “width” of the dark black area with @GianlucaGorni 's code which is related to the standard deviation does decrease with increasing values in the positive horizontal axis direction. It might “look” like it increases to a maximum around x=25 but that isn’t the case when you measure what’s on the screen.

5

I have been working in the previous example I showed. In fact, @Gianluca Gorni 's idea was really good. However, I am facing now a new problem. I have tried something similar using the beta distribution:

k1 = 2.;
k2 = 0.03;
k3 = 5.;
k4 = 0.04;

a[x_] := k1 + k2 x;
b[x_] := k3 - k4 x;

f[x_, y_] := 
  PDF[BetaDistribution[a[x], b[x]], y]/
   PDF[BetaDistribution[a[x], b[x]], (a[x] - 1)/(a[x] + b[x] - 2)];

DensityPlot[f[x, y], {x, 0, 100}, {y, 0, 1}, 
 ColorFunction -> ColorData[{"CherryTones", {1, 0}}], 
 ColorFunctionScaling -> True, PlotTheme -> "Scientific", 
 PlotLegends -> None, AspectRatio -> 1./GoldenRatio, 
 PlotRange -> {{0, 100}, {0, 1}, {0, 10}}, PlotPoints -> 100, 
 FrameTicksStyle -> Directive[20.]]

Obtaining a weird result:

plot.png
plot.png601×389 35.9 KB

Why are that sudden cuts happening? Has anyone experienced the same problem?

Thanks again for any help

6

What version of Mathematica and platform are you using? On Windows 10 with version 12.0 I get the same plot as you do. But with version 12.2 the desired plot is produced.

7

I am using Mathematica 12.1 in Ubuntu 20.04 (Linux).

It may be a bug that has been corrected in version 12.2