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:
- By changing the initial condition of the variable, e.g., x[0]=x0=0.2;
- By using other parameter values. However, for certain parameter values, e.g., ce={17/3114, 18/3114}, the problem is maintained.
- 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]]