5
$\begingroup$

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

description

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]*)

enter image description here

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]*)

enter image description here

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

MosaicHeatMap

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

All_xTfinal_are_1

$\endgroup$
3
  • 3
    $\begingroup$ Just to verify, this works on Mac v12.1 and fails on v10.0, 11.2, 11.3, 12.0. $\endgroup$ – Chris K Dec 1 '20 at 22:34
  • 1
    $\begingroup$ Dear @ChrisK, thank you for verifying the issue! I notice that your field of work (theoretical evolutionary biology) is also mine, pleasant coincidence ^^ $\endgroup$ – Lucas Santana Souza Dec 2 '20 at 23:55
  • $\begingroup$ Nice to meet you! $\endgroup$ – Chris K Dec 3 '20 at 2:51
2
$\begingroup$

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.

$\endgroup$
5
  • $\begingroup$ I see that your elegant suggestion fixes the second issue, but I cannot understand why it does. (i) The usual default setting is ColorFunctionScaling->True, and Scaling is done so as to make the minimum and maximum values of all variables lie between 0 and 1. (ii) xTfinal is always btw [0,1]. Given i and ii, I don't understand why ColorFunctionScaling->True would create the Second Problem (mosaic heatmap). Could you help me with understanding that? (The page of Mathematica for ColorFunctionScaling isn't great) $\endgroup$ – Lucas Santana Souza Dec 6 '20 at 0:31
  • $\begingroup$ Also, could you clarify why PlotRange->{0,1} is preferred over PlotRange->All? They appear to generate the same result. $\endgroup$ – Lucas Santana Souza Dec 6 '20 at 0:31
  • $\begingroup$ About the third problem, I will follow your suggestion and create a new post. $\endgroup$ – Lucas Santana Souza Dec 6 '20 at 0:33
  • $\begingroup$ @Lucas The actual range of the data, not the theoretical range {0, 1}, is used by ListDensityPlot to compute the PlotRange and to do the color function scaling. If the data varies from plot to plot, the coloring and scale will vary, too. When the variation is slight, it may not be noticeable. In the second plot, I get that the data range is InputForm@MinMax[dataOrg2[[All, 3]]], which gives {0.999999999999998, 0.9999999999999999}, which means all computed values are very close to 1.. With ColorFunctionScaling -> True, this is rescaled to {0, 1}. $\endgroup$ – Michael E2 Dec 6 '20 at 0:49
  • $\begingroup$ Consequently, I think it's better to set the range to the theoretical range, so that the scale and its colors mean the same thing from one data set to another. (If it's just one data set and there are no theoretical limits, like with temperature, say, then PlotRange -> All is better.) $\endgroup$ – Michael E2 Dec 6 '20 at 0:50
4
$\begingroup$

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

enter image description here

$\endgroup$
6
  • $\begingroup$ @LucasSantanaSouza, First, you do not need to post your question as an answer as you did below, comment or update the question would be better-:). If you check using ListPlot[dataOrg2[[All, 3]], PlotRange -> {0, 1}] you will see that there are some points at zero. $\endgroup$ – valar morghulis Dec 3 '20 at 8:49
  • $\begingroup$ thank you for your advice. I updated the original question and deleted the comment. Notice that ListPlot[dataOrg2[[All, 3]], PlotRange -> {0, 1}] has values that are not 1 when assuming x[0]=0.1, Tfinal=1500, b=1, e=8/10, a=36/203, cs=1/10, ce=17/3114, L=79/102. However, when assuming Tfinal=1500; step=0.01; x0=0.9; e=8/10; a=36/203; cs=1/10; ce=17/3114; L=79/102; all values of x[Tfinal] are equal to 1. $\endgroup$ – Lucas Santana Souza Dec 3 '20 at 20:47
  • $\begingroup$ @LucasSantanaSouza I could not produce the second issue, can you put the whole code that produce the densityplot with red spots? I used the parameters you mentioned but still get zeros in the output. $\endgroup$ – valar morghulis Dec 3 '20 at 22:49
  • $\begingroup$ I forgot to specify that in the second problem, b=2. Sorry for the mistake. In any case, I inserted the code for the second problem in the description of the question. Thank you for all the help! $\endgroup$ – Lucas Santana Souza Dec 4 '20 at 4:55
  • 1
    $\begingroup$ Thank your valuable feedback. PlotRange->{0,1} does not fx the issue. Data = Table[{dataOrg2[[i, 1]], dataOrg2[[i, 2]], Round[dataOrg2[[1, 3]]]}, {i, 1, 1326}]; and then ListDensityPlot[Data] almost fix the issue. The problem with this solution is that any value of x[Tfinal] bellow 0.5 will become zero and above 0.5 will become 1. I modified your suggestion and posted the code in a answer $\endgroup$ – Lucas Santana Souza Dec 5 '20 at 3:02
1
$\begingroup$

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

enter image description here

$\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.