dyn_rpro = Csnippet("
double Sn_term, In_term, F_term, P_term , Si_term, Ii_term,Jn_term,Ji_term;
double noiSn, noiIn, noiSi , noiIi ,noiF, noiP,noiJn,noiJi;
double delta = 0.013; //fraction of volume replaced day-1
noiSn = rnorm(0, sigSn * sqrt(dt));
noiIn = rnorm(0, sigIn * sqrt(dt));
noiSi = rnorm(0, sigSi * sqrt(dt));
noiIi = rnorm(0, sigIi * sqrt(dt));
noiJn = rnorm(0, sigJn * sqrt(dt));
noiJi = rnorm(0, sigJi * sqrt(dt));
noiF = rnorm(0, sigF * sqrt(dt));
noiP = rnorm(0, sigP * sqrt(dt));
//------------Sn-------------
Sn_term = 0.1 * Jn * dt - theta_Sn * Sn * dt - probn * f_Sn * Sn * P * dt - delta * Sn * dt + Sn * noiSn;
//-----------Jn-------------
Jn_term = rn * f_Sn * F * Sn * dt - 0.1 * Jn * dt - theta_Jn * Jn * dt - delta * Jn * dt + Jn * noiJn;
//------------In--------------
In_term = probn * f_Sn * Sn * P * dt - theta_In * In *dt - delta * In * dt + In * noiIn;
//------------Si-------------
Si_term = 0.1 * Ji * dt - theta_Si * Si * dt - probi * f_Si * Si * P * dt -
delta * Si * dt + Si * noiSi;
//-----------Ji-------------
Ji_term = ri * f_Si *F * Si * dt - 0.1 * Ji * dt -
theta_Ji * Ji * dt - delta * Ji * dt + Ji * noiJi;
//------------Ii--------------
Ii_term = probi * f_Si * Si * P * dt - theta_Ii * Ii *dt - delta * Ii * dt + Ii * noiIi;
//-----------F---------------
F_term = F * noiF - f_Sn * F * (Sn + xi * In + 1 * Jn) * dt -
f_Si * F * (Si + xi * Ii + 1 * Ji) * dt - delta * F * dt + 0.37 * dt;
//----------P---------------
P_term = 30 * theta_In * In * dt + 30 * theta_Ii * Ii * dt -
f_Sn * (Sn + xi * In) * P * dt - f_Si * (Si + xi * Ii) * P * dt-
theta_P * P * dt - delta * P * dt + P * noiP;
//T_D and T_I are the S and I Daphnia sample out
F += F_term;
Sn += Sn_term;
In += In_term;
Si += Si_term;
Ji += Ji_term;
Jn += Jn_term;
Ii += Ii_term;
P += P_term;
//Trace time
if (t - 4.0 < 0.001 && t - 4.0 > -0.001){
//Initial statement
P += 25;
}
if (Sn < 0.0 || Sn > 1e5) {
Sn = 0.0;
error_count += 1;
}
if (Si < 0.0 || Si > 1e5) {
Si = 0.0;
error_count += 1000000;
}
if (F < 0.0 || F > 1e20) {
F = 0.0;
error_count += 1000;
}
if (In < 0.0 || In > 1e5) {
In = 0.0;
error_count += 0.001;
}
if (Ii < 0.0 || Ii > 1e5) {
Ii = 0.0;
error_count += 0.000000001;
}
if (Jn < 0.0 || Jn > 1e5) {
Jn = 0.0;
error_count += 0.001;
}
if (Ji < 0.0 || Ji > 1e5) {
Ji = 0.0;
error_count += 0.000000001;
}
if ((P < 0.0 || P > 1e20)&& t > 3.9) {
P = 0.0;
error_count += 0.000001;
}
//T_Sn = 15 * delta * Sn * dt;
//T_In = 15 * delta * In * dt;
//T_Si = 15 * delta * Si * dt;
//T_Ii = 15 * delta * Ii * dt;
T_Sn = fabs(Sn);
T_In = fabs(In);
T_Si = fabs(Si);
T_Ii = fabs(Ii);
")
# Initial state. Assume t0 = day 4
dyn_init = Csnippet("
Sn = 2.333; //2.3333 = 35/15L
Si = 0.667; //0.667 = 10/15L
F = 16.667;
Jn = 0;
Ji = 0;
T_Sn = 0.0;
T_Si = 0.0;
T_In = 0.0;
T_Ii = 0.0;
In = 0.0;
Ii = 0.0;
error_count = 0.0;
//add 25 P at day 4
P = 0;
")
dmeas = Csnippet("
if (error_count > 0.0) {
lik = -150;
}
else{
if(give_log){
lik = dnbinom_mu(lumadult,k_Si,T_Si,give_log) +
dnbinom_mu(luminf,k_Ii,T_Ii,give_log) +
dnbinom_mu(dentadult,k_Sn,T_Sn,give_log) +
dnbinom_mu(dentinf,k_In,T_In,give_log);
}
else{
lik = dnbinom_mu(lumadult,k_Si,T_Si,give_log) *
dnbinom_mu(luminf,k_Ii,T_Ii,give_log) *
dnbinom_mu(dentadult,k_Sn,T_Sn,give_log) *
dnbinom_mu(dentinf,k_In,T_In,give_log);
}
}
")
rmeas = Csnippet("
dentadult = rnbinom_mu(k_Sn,T_Sn);
dentinf = rnbinom_mu(k_In,T_In);
lumadult = rnbinom_mu(k_Si,T_Si);
luminf = rnbinom_mu(k_Ii,T_Ii);
")
pt = parameter_trans(
#Without death part
log = c( "sigSn", "sigIn", "sigSi", "sigIi", "sigF","sigP","f_Sn","f_Si",
"rn","ri","k_Ii","k_In","k_Sn","k_Si","sigJi","sigJn","probn","probi",
"theta_Sn","theta_In","theta_Si","theta_Ii","theta_P","theta_Jn","theta_Ji","xi"),
)
pomplist=list()
parameters = c( 8.34e-06, 0.4, 0.5, 0.8, 0.2, 0.01, 0.2, 0.15,
0.07 , 0.2, 0.01, 0.096 , 0.0035 ,0.003 , 0.2 ,
0.4, 0.6 ,0.8 ,8,8,8,8,1,1,0.1,0.1)
names(parameters) = c("xi", "sigSn", "sigIn", "sigSi", "sigIi", "sigF","sigP","theta_Sn",
"theta_In","theta_Si","theta_P","theta_Ii","f_Sn","f_Si","rn","ri","probn",
"probi","k_Ii","k_In","k_Sn","k_Si","sigJi","sigJn","theta_Jn","theta_Ji")
dentNoPara = Mesocosm_data[91:170, ]
dentNoPara = subset(dentNoPara, select = c(rep, day, dent.adult,dent.inf,lum.adult,lum.adult.inf))
dentNoPara = dentNoPara[80: 1, ]
dentNoPara$day = (dentNoPara$day - 1) * 5 + 7
data = list()
trails = c("K","L","M","N","O","P","Q","S")
for (i in 1: length(trails)){
data[[i]]=subset(dentNoPara, select = c("day", "dent.adult","dent.inf","lum.adult","lum.adult.inf"),
dentNoPara$rep == trails[i])
}
for (i in 1:8){
colnames(data[[i]]) = c('day', 'dentadult', 'dentinf','lumadult','luminf')
pomp(data = data[[i]],
times = "day",
t0=1,
rprocess=euler(dyn_rpro,delta.t=1/4),
rinit = dyn_init,
dmeasure = dmeas,
rmeasure = rmeas,
partrans = pt,
obsnames = c("dentadult", "dentinf","lumadult","luminf"),
accumvars = c("error_count"),
paramnames = c("xi","sigSn", "sigIn", "sigSi", "sigIi",
"sigF","sigP","theta_Sn","theta_In","theta_Si","theta_P",
"theta_Ii","f_Sn","f_Si","rn","ri","probn",
"probi","k_Ii","k_In","k_Sn","k_Si","sigJi",
"sigJn","theta_Jn","theta_Ji"),
statenames = c("Sn", "In", "Si","Jn","Ji" , "Ii","error_count",
"F", "T_Sn","T_In","T_Si","T_Ii","P")
) -> pomplist[[i]]
coef(pomplist[[i]])=parameters
}
names(pomplist)=paste("u", 1:8,sep = "")
shared_parameter = c(
ri = 13076, rn = 59.04676, f_Si = 1.838259e-05, f_Sn = 0.001105668, probi = 31.10083,
probn = 0.2565626, xi = 28.6562, theta_Sn = 0.1479834, theta_Si = 0.0318604,
theta_Ii = 0.3531879, theta_In = 0.5489315, theta_P = 0.02024991, theta_Ji = 0.0001299562,
theta_Jn = 0.0001532613, sigSn = 0, sigSi = 0, sigIn = 0.0003063207,
sigIi = 0.02208698, sigJi = 0.2727418, sigJn = 0.2836891, sigF = 0.1551729, sigP = 0.238589,
k_Ii = 1.241092, k_In = 1.005756, k_Si = 4.715556, k_Sn = 4.282648
)
panelfood = panelPomp(pomplist, shared=shared_parameter)
algorithmic.params = list(
Np = c(50, 500, 1000),
Np_rep = c( 2, 10, 10),
Mp = c(50, 500, 1000),
Nmif = c( 2, 300, 250)
)
dent_rw.sd= 0.05
parameter_candidates = list(shared_parameter)
names(parameter_candidates)=c("shared")
U = length(panelfood)
{
foreach(
i = 1:(2*getDoParWorkers()),
.packages = c("pomp", "panelPomp"),
.inorder = FALSE,
.options.multicore = list(set.seed = TRUE)
) %dopar%
{
guessed.parameter.values = parameter_candidates
mif2(
panelfood,
Nmif = algorithmic.params$Nmif[run_level],
block = TRUE,
shared.start = guessed.parameter.values$shared,
rw.sd = rw_sd(xi=dent_rw.sd,
sigSn=0,
sigIn=dent_rw.sd,
sigSi=0,
sigIi=dent_rw.sd,
sigF=dent_rw.sd,
theta_Sn=dent_rw.sd,
theta_In=dent_rw.sd,
theta_Si=dent_rw.sd,
theta_P=dent_rw.sd,
theta_Ii=dent_rw.sd,
k_Sn = dent_rw.sd,
k_In = dent_rw.sd,
k_Si = dent_rw.sd,
k_Ii = dent_rw.sd,
f_Sn=dent_rw.sd,
f_Si=dent_rw.sd,
rn=dent_rw.sd,
ri=dent_rw.sd,
probn=dent_rw.sd,
probi=dent_rw.sd,
sigP = dent_rw.sd,
sigJi = dent_rw.sd,
sigJn = dent_rw.sd,
theta_Jn = dent_rw.sd,
theta_Ji = dent_rw.sd),
cooling.type = "geometric",
cooling.fraction.50 = 0.7,
Np = algorithmic.params$Mp[run_level]
) -> m1
ll = replicate(n = algorithmic.params$Np_rep[run_level],
unitLogLik(pfilter(m1,
Np = algorithmic.params$Np[run_level])))
list(mif = m1,
ll = panel_logmeanexp(x = ll,
MARGIN = 1,
se = TRUE))
}
} -> mf_with_block
{
foreach(
i = 1:(2*getDoParWorkers()),
.packages = c("pomp", "panelPomp"),
.inorder = FALSE,
.options.multicore = list(set.seed = TRUE)
) %dopar%
{
guessed.parameter.values = parameter_candidates
mif2(
panelfood,
Nmif = algorithmic.params$Nmif[run_level],
block = FALSE,
shared.start = guessed.parameter.values$shared,
rw.sd = rw_sd(xi=dent_rw.sd,
sigSn=0,
sigIn=dent_rw.sd,
sigSi=0,
sigIi=dent_rw.sd,
sigF=dent_rw.sd,
theta_Sn=dent_rw.sd,
theta_In=dent_rw.sd,
theta_Si=dent_rw.sd,
theta_P=dent_rw.sd,
theta_Ii=dent_rw.sd,
k_Sn = dent_rw.sd,
k_In = dent_rw.sd,
k_Si = dent_rw.sd,
k_Ii = dent_rw.sd,
f_Sn=dent_rw.sd,
f_Si=dent_rw.sd,
rn=dent_rw.sd,
ri=dent_rw.sd,
probn=dent_rw.sd,
probi=dent_rw.sd,
sigP = dent_rw.sd,
sigJi = dent_rw.sd,
sigJn = dent_rw.sd,
theta_Jn = dent_rw.sd,
theta_Ji = dent_rw.sd),
cooling.type = "geometric",
cooling.fraction.50 = 0.7,
Np = algorithmic.params$Mp[run_level]
) -> m1
ll = replicate(n = algorithmic.params$Np_rep[run_level],
unitLogLik(pfilter(m1,
Np = algorithmic.params$Np[run_level])))
list(mif = m1,
ll = panel_logmeanexp(x = ll,
MARGIN = 1,
se = TRUE))
}
} -> mf_without_block