2 issues with ListDensityPlot

Question

I am using Mathematica Version Number 12.0.0.0 Platform: Microsoft Windows (64-bit)

The FIRST issue is that the ListDensityPlot is not plotting values of x[Tfinal] when this value is near zero (plotting white instead of brown). I illustrate this issue for the case in which x[0]=0.1; Tfinal=1500; b=1; e=8/10; a=36/203; cs=1/10; ce=17/3114; L=79/102.

(*Defining the initial condition, parameter values, and difference equation *)

Tfinal=1500; (*Number of interactions*)
step=0.01;

x0=0.1;     (*Initial condition which is any real value in the interval [0,1]*)

(*Parameters*)
b=1;        (*constant which can be {1/2, 1, 2}*)
e=8/10;     (*0 <= e <= 1*)
a=36/203;   (*0 <= a <= 1/2*)
cs=1/10;    (*0 <= cs <= 1/2*)
ce=17/3114; (*0 <= ce <= 1/4*)
L=79/102;   (*0 <= L <= 1*)



f[L_,e_,a0_,a_,cs_,cE_,ce_,x_[t]]:= (x[t]*(1 - (ce + cE + cs)*(a0 + a*(L + x[t] - L*x[t])) + (e + x[t] - e*x[t])^b*(a0 + a*(L + x[t] - L*x[t]))))/
 ((1 - x[t])*(1 - a0*(ce + cs) + a0*e^b + (-((-1 + e)*x[t]))^b*(a0 + a*(L + x[t] - L*x[t]))) + 
  x[t]*(1 - (ce + cE + cs)*(a0 + a*(L + x[t] - L*x[t])) + (e + x[t] - e*x[t])^b*(a0 + a*(L + x[t] - L*x[t]))));

(* Organizing the data so I can use ListDensityPlot *)

dat=Table[{a0,cE,RecurrenceTable[{x[t+1]==f[L,e,a0,a,cs,cE,ce,x[t]],x[0]==x0},x,{t,0,Tfinal}]},{a0,0,1/2,step},{cE,0,1/4,step}];

dat // MatrixForm; (*the way that the data come out from Table[{a0,cE,RecurrenceTable[{x[t+1]\[Equal]f[L,e,a0,a,cs,cE,ce,x[t]],x[0]\[Equal]x0},x,{t,0,Tfinal}]},{a0,0,1/2,step},{cE,0,1/4,step}]*)


parameters = Take[dat, All, All, 2]; (*only getting parameter values used to run the model:=getting all rows and collumns of 2 first values*)
parameters// MatrixForm;


d=Dimensions[parameters];
d[[2]] ;(*colecting the number of columns*)

dat[[;; , ;; , 3, -1]] // MatrixForm; (*only getting values of x[Tfinal]*) 
xFinal=Flatten[dat[[;; , ;; , 3, -1]]]; (*putting x[Tfinal] into a single list*)
xFinal2=Partition[xFinal,1];(*first step in x[Tfinal] partitioning*)
xFinal3=Partition[xFinal2,d[[2]]]; (*last step in x[Tfinal] partitioning*)

dataOrg=Join[parameters,xFinal3,3];(*combining the parameters and x[Tfinal] lists by at each 3 location of "parameters" list inputinng "xFinal3"*)
dataOrg//MatrixForm;

dataOrg2=Flatten[dataOrg,1]; (*colapting the data in one list*)
dataOrg2//MatrixForm;

ListDensityPlot[dataOrg2
,FrameLabel->{Style["\!\(\*SubscriptBox[\(a\), \(0\)]\)",15,"DisplayFormula"],Style["\!\(\*SubscriptBox[\(c\), \(E\)]\)",15,"DisplayFormula"]}
,ColorFunction->"BrownCyanTones"
,PlotLegends->Placed[BarLegend[Automatic,LegendLabel->"x[t]"],After]]

Notice that the heatmap is correctly plotting when x[t]==1 (in blue), but not when x[t] is near zero (which should be brown instead of white). The time series gives an example that the blue area is correct but that the white area should be brown: At a0=0.4 and cE=0.2, x[Tfinal] = 8.9566*10^-8, which should be brown in the heatmap, instead of white.

(*Now calculating a time series *)
Tfinal=1500;

a0=0.4;  cE=0.20;

timeSeries=RecurrenceTable[{x[t+1]==f[L,e,a0,a,cs,cE,ce,x[t]],x[0]==x0},x,{t,0,Tfinal}];

ListPlot[timeSeries, PlotRange->{{0.0,1.05}}]

timeSeries[[1]](*value of x[0]*)
timeSeries[[Tfinal]] (*value of x[Tfinal]*)

At a0=0.4 and cE=0.1, x[Tfinal] = 1, which is show correctly in the heatmap as blue.

Tfinal=1500;
a0=0.4;  cE=0.1;

timeSeries=RecurrenceTable[{x[t+1]==f[L,e,a0,a,cs,cE,ce,x[t]],x[0]==x0},x,{t,0,Tfinal}];

ListPlot[timeSeries, PlotRange->{{0.0,1.05}}]

timeSeries[[1]](*value of x[0]*)
timeSeries[[Tfinal]] (*value of x[Tfinal]*)

The issue disappears by doing any of the following:

1. By changing the initial condition of the variable, e.g., x[0]=x0=0.2;
2. By using other parameter values. However, for certain parameter values, e.g., ce={17/3114, 18/3114}, the problem is maintained.
3. To change the number of interactions. Bug in the heatmap when assuming Tfinal = {300, 400,500,600,700,800,900,1000,1100,1200,1300, 1400,1500}, in which among those two types of bug in the bar legend occur. One bug is having several denominator happens when Tfinal ={700,800,900,1000,1100,1200,1300}. The other bug is having all value of the legend being "1", this issue occurs when TFinal ={1400,1500}. Examples of Tfinal values in which is no bug in the graph Tfinal= {100,200, 1600,1700,1800, 1900}. Detail, when I run the same code in Mathematica Version 12.1.1.0, Platform: Linux x86 (64-bit) the following Tfinal ={900, 1000,1500} that in the Version 12.0.0.0 were a issue, is not an issue anymore. Examples of the same issue in Mathematica Version 12.1.1.0 are found when Tfinal = {800, 700, 600, 500, 400, 300}.

PS.:The issue does not seem to be related to the choice of ColorFunctions, because I tried other ColorFunctions, and the problem didn't change.

---

The SECOND issue is that all values of x[Tfinal] are 1 for all {a0,0,1/2,step},{cE,0,1/4,step}, thus the heatmap should only have one color, but instead of that the heatmap has a mosaic pattern. For instance, using Tfinal=1500; step=0.01; b=2; x0=0.9; e=8/10; a=36/203; cs=1/10; ce=17/3114; L=79/102;:

Tfinal=1500; step=0.01; b=2; x0=0.9; e=8/10; a=36/203; cs=1/10; ce=17/3114; L=79/102;

(*Other option of parameter combinations that generate PROBLEM TWO*)
(*Tfinal=1500; step=0.01; b=2; x0=0.4; e=8/10; a=36/203; cs=1/10; ce=17/3114; L=79/102;*)
(*Tfinal=1500; step=0.01; b=2; x0=0.9; e=8/10; a=36/203; cs=1/10; ce=17/3114; L=79/102;*)
(*Tfinal=1500; step=0.01; b=2; x0=0.9; e=8/10; a=36/203; cs=1/10; ce=300/3114; L=79/102;*)
(*Tfinal=1500; step=0.01; b=2; x0=0.9; e=8/10; a=36/203; cs=5/10; ce=17/3114; L=79/102;*)


(* *********** Problem 1 and Problem 2 use the same function  *********** *)
f[L_,e_,a0_,a_,cs_,cE_,ce_,x_[t]]:= (x[t]*(1 - (ce + cE + cs)*(a0 + a*(L + x[t] - L*x[t])) + (e + x[t] - e*x[t])^b*(a0 + a*(L + x[t] - L*x[t]))))/
 ((1 - x[t])*(1 - a0*(ce + cs) + a0*e^b + (-((-1 + e)*x[t]))^b*(a0 + a*(L + x[t] - L*x[t]))) + 
  x[t]*(1 - (ce + cE + cs)*(a0 + a*(L + x[t] - L*x[t])) + (e + x[t] - e*x[t])^b*(a0 + a*(L + x[t] - L*x[t]))));

dat=Table[{a0,cE,RecurrenceTable[{x[t+1]==f[L,e,a0,a,cs,cE,ce,x[t]],x[0]==x0},x,{t,0,Tfinal}]},{a0,0,1/2,step},{cE,0,1/4,step}];

(* ********************** Organizing the Data ********************** *)
dat // MatrixForm; (*the way that the data come out from Table[{c,e,RecurrenceTable[{x[t+1]\[Equal]f[c,e,x[t]],x[0]\[Equal]0.5},x,{t,0,1}]},{c,0,1,0.5},{e,0,1,0.5}]*)

parameters = Take[dat, All, All, 2]; (*only getting parameter values used to run the model:=getting all rows and collumns of 2 first values*)
parameters// MatrixForm;

d=Dimensions[parameters];
d[[2]] ;(*colecting the number of columns*)

dat[[;; , ;; , 3, -1]] // MatrixForm; (*only getting values of x[tFinal]*) 
xFinal=Flatten[dat[[;; , ;; , 3, -1]]]; (*putting x[tFinal] into a single list*)
xFinal2=Partition[xFinal,1];(*first step in x[tFinal] partitioning*)
xFinal3=Partition[xFinal2,d[[2]]]; (*last step in x[tFinal] partitioning*)

dataOrg=Join[parameters,xFinal3,3];(*combining the parameters and x[tFinal] lists by at each 3 location of "parameters" list inputinng "xFinal3"*)
dataOrg//MatrixForm;

dataOrg2=Flatten[dataOrg,1]; (*colapting the data in one list*)
dataOrg2//MatrixForm;

(* ********************** Plotting Heatmap ********************** *)

ListDensityPlot[dataOrg2
,FrameLabel->{Style["\!\(\*SubscriptBox[\(a\), \(0\)]\)",15,"DisplayFormula"],Style["\!\(\*SubscriptBox[\(c\), \(E\)]\)",15,"DisplayFormula"]}
,ColorFunction->"BrownCyanTones"
,PlotRange->All
,PlotLegends->Placed[BarLegend[Automatic,LegendLabel->"x[t]"],After]]

We can verify that all values of x[Tfinal] are 1 by:

Length[dataOrg2[[;;,3]]] (*Total number of x[Tfinal] points*)
Total[dataOrg2[[;;,3]]]//Simplify(*Sum of x[Tfinal], (PS.: x[t] is btw zero and 1 for all t*)
ListPlot[dataOrg2[[All,3]],PlotRange->{-0.1,1.1},PlotStyle -> PointSize[0.01]]

Answer 1

ListDensityPlot scales the function values so that {min, max} is rescaled to {0, 1}. When comparing two functions, you need the scaling to be the same. It won't be the same if the minimum and maximum values are different. In this case the functions are already supposed to range from 0 to 1, so no rescaling is necessary. Hence, a solution is to add the option

ColorFunctionScaling -> False

One also has to prevent the legend from rescaling. This can be done by adding the explicit range:

BarLegend[{Automatic, {0, 1}}, LegendLabel -> "x[t]"]

White on a ListDensityPlot indicates plot-range clipping. The solution is to set the plot range explicitly to the full codomain of the function:

PlotRange -> {0, 1}

First plot, with the first version of dataOrg2. As mentioned above, the issue is with PlotRange clipping by the automatically determined plot range. The heuristics for determining the plot range may change from version to version, so we don't see the issue in every version of Mathematica.

ListDensityPlot[dataOrg2, 
 FrameLabel -> {Style["\!\(\*SubscriptBox[\(a\), \(0\)]\)", 15, 
    "DisplayFormula"], 
   Style["\!\(\*SubscriptBox[\(c\), \(E\)]\)", 15, 
    "DisplayFormula"]},
 ColorFunction -> "BrownCyanTones", ColorFunctionScaling -> False,
 PlotRange -> {0, 1},
 PlotLegends -> 
  Placed[BarLegend[Automatic, LegendLabel -> "x[t]"], After]]

The second plot, with the second version of dataOrg2 (why do they have the same name? -- it's confusing). Here the function values are all very nearly 1, each with a little, negligible round-off error. However, when the values are rescaled to {0, 1}, the negligible noise becomes quite visible.

ListDensityPlot[dataOrg2, 
 FrameLabel -> {Style["\!\(\*SubscriptBox[\(a\), \(0\)]\)", 15, 
    "DisplayFormula"], 
   Style["\!\(\*SubscriptBox[\(c\), \(E\)]\)", 15, 
    "DisplayFormula"]},
 ColorFunction -> "BrownCyanTones", ColorFunctionScaling -> False,
 PlotRange -> {0, 1}, 
 PlotLegends -> 
  Placed[BarLegend[{Automatic, {0, 1}}, LegendLabel -> "x[t]"], 
   After]]

The third question is completely different and really should be asked in a separate question.

Answer 2

I am using M12.0.0.0 on Ubuntu and confirm the problem, but a simple solution to that is to use PlotRange->All

ListDensityPlot[dataOrg2
,PlotRange->All,FrameLabel->{Style["\!\(\*SubscriptBox[\(a\), \(0\)]\)",15,"DisplayFormula"],Style["\!\(\*SubscriptBox[\(c\), \(E\)]\)",15,"DisplayFormula"]}
,ColorFunction->"BrownCyanTones"
,PlotLegends->Placed[BarLegend[Automatic,LegendLabel->"x[t]"],After]]  

Answer 3

Here I present the solution for the SECOND ISSUE regarding having a heatmap that is uniform instead of a mosaic.

The reason why in the SECOND issue a mosaic pattern is shown instead of a completely uniform color:

In the SECOND issue, @HD2006 pointed out that mosaic pattern is shown instead of completely uniform color because the data in the third column of dataOrg2 is numeric. That is, it is not precisely 1, but in the form 0.99999999999983, 0.0.99999999999987, so Mathematica considers even the last digits.

To solve the SECOND issue, we can use the function Round together with a conditional. Using Round without a conditional creates a new problem: values of x[Tfinal] bellow 0.5 will become zero, and above 0.5 will become 1.

zeroThreshold = 0.00009; (*threshold to approximate to 0*)
onethreshold  = 0.99999; (*threshold to approximate to 1*)

(*Rounding up values of x[Tfinal] that are very close to 1 or 0*)
dataBeforeAfterConditional=Table[
{If[dataOrg2[[i,3]] < zeroThreshold ,dataOrg2[[i,3]]=Round[dataOrg2[[i,3]]] ,dataOrg2[[i,3]]] (*rounding up to zero*)
,If[dataOrg2[[i,3]] > onethreshold  ,dataOrg2[[i,3]]=Round[dataOrg2[[i,3]]] ,dataOrg2[[i,3]]] (*rounding up to one*)}
,{i,1,Length[dataOrg2]}]; (*dataBeforeAfterConditional contains: {{original value, value after conditional},...,{original  value, value after conditional}}*)

(*HeatMap*)
ListDensityPlot[dataOrg2
,FrameLabel->{Style["\!\(\*SubscriptBox[\(a\), \(0\)]\)",15,"DisplayFormula"],Style["\!\(\*SubscriptBox[\(c\), \(E\)]\)",15,"DisplayFormula"]}
,PlotRange->All
,ColorFunction->"BrownCyanTones"
,PlotLegends->Placed[BarLegend[Automatic,LegendLabel->"x[t]"],After]]

(*Values x[Tfinal]*)
Length[dataOrg2[[;;,3]]]
Total[dataOrg2[[;;,3]]](*Sum of x[Tfinal] (which is btw zero and 1*)
ListPlot[dataOrg2[[All,3]],PlotRange->{-0.1,1.1},PlotStyle -> PointSize[0.01]]