I am trying to fit SIRD model in R to real data. However, the observed values are lying nowhere on the fitted curve. I can't understand what the error is or how to resolve it, but I have noticed that changing the value of "state" produces the error
DLSODA- Warning..Internal T (=R1) and H (=R2) are
such that in the machine, T + H = T on the next step
(H = step size). Solver will continue anyway.
In above message, R1 = 0.1, R2 = 9.94667e-21
Here is my entire code. Any help is greatly appreciated!
library(deSolve)
state<-c(S=10000,I=1000,R=5000,D=100)
parameters <- c(a=180,b=0.4,g=0.2)
eqn<-function(t, state, parameters) {
with(as.list(c(state, parameters)),{
dS <- -a*I*S
dI <- a*I*S-g*I-b*I
dR <- g*I
dD <-b*I
list(c(dS,dI,dR,dD))
})
}
times <- seq(0.1,2.6,by=0.1)
out <- ode(y = state, times = times, func = eqn, parms = parameters)
out
plot(out)
library(FME)
data <- data.frame(
time = seq(0.1,2.6,0.1),
S=c(11417747943,11417733626,11417717809,11417702207,11417685587,11417670536,
11417652672,11417629493,11417603660,11417577979,11417550853,11417520318,
11417495673,11417466974,11417435119,11417399167,11417362265,11417326539,
11417286125,11417254482,11417226564,11417187020,11417143837,11417095924,
11417046477,11416989403),
I=c(3686,7062,4415,8040,7706,4316,8266,13947,13593,11207,13446,19114,5121,15400,
16658,15386,19766,21024,22426,10683,3958,15701,10290,23299,11340,29331),
R=c(9913,7193,11344,7467,8861,10671,9510,9138,12174,14400,13588,11314,19463,13165,
15098,20444,17019,14523,17874,20854,23820,23600,32641,24126,37821,27508),
D=c(54,57,56,88,50,48,87,84,58,70,92,99,58,132,95,111,112,166,108,102,139,
227,249,481,277,222)
)
cost <- function(p) {
out <- ode(state, times, eqn, p)
modCost(out, data, weight = "none")
}
fit <- modFit(f = cost, p = parameters)
summary(fit)
out1 <- ode(state, times, eqn, parameters)
out2 <- ode(state, times, eqn, coef(fit))
plot(out1, out2, obs=data, obspar=list(pch=16, col="red"))
Your code has several issues:
the order of magnitude of state variables differs, so you need weight="std" or weight = "mean"
the initial values of the state variables are far away. This is the most critical error. You may either set it manually to a reasonable value (see below) or even better, fit it, see FME documentation how this can be done.
Start parameters are far away from optimum. While it is desirable that the algorithm converges to an optimum from arbitrary naive start values, this is rarely the case. Therefore, some careful consideration or trial and error is unavoidable.
The mass balance is violated, i.e. the sum of all 4 states changes over time. Check rowSums(data[-1]).
Here an approach that handles parts of the problem. The next step would then be to fix the mass balance and to include the ode initial states of the ode model as parameters of the nonlinear optimization.
library(deSolve)
library(FME)
eqn<-function(t, state, parameters) {
with(as.list(c(state, parameters)),{
dS <- -a*I*S
dI <- a*I*S - g*I - b*I
dR <- g*I
dD <- b*I
list(c(dS,dI,dR,dD))
})
}
data <- data.frame(
time = seq(0.1,2.6,0.1),
S=c(11417747943,11417733626,11417717809,11417702207,11417685587,11417670536,
11417652672,11417629493,11417603660,11417577979,11417550853,11417520318,
11417495673,11417466974,11417435119,11417399167,11417362265,11417326539,
11417286125,11417254482,11417226564,11417187020,11417143837,11417095924,
11417046477,11416989403),
I=c(3686,7062,4415,8040,7706,4316,8266,13947,13593,11207,13446,19114,5121,15400,
16658,15386,19766,21024,22426,10683,3958,15701,10290,23299,11340,29331),
R=c(9913,7193,11344,7467,8861,10671,9510,9138,12174,14400,13588,11314,19463,13165,
15098,20444,17019,14523,17874,20854,23820,23600,32641,24126,37821,27508),
D=c(54,57,56,88,50,48,87,84,58,70,92,99,58,132,95,111,112,166,108,102,139,
227,249,481,277,222)
)
state <- c(S=11417747943, I=5000, R=8000, D=50)
parameters <- c(a=1e-10, b=0.001, g=0.1)
times<-seq(0.1,2.6,by=0.01)
cost <- function(p) {
out <- ode(state, times, eqn, p)
modCost(out, data, weight = "mean")
}
fit <- modFit(f = cost, p = parameters)
summary(fit, corr=TRUE)
out2 <- ode(state, times, eqn, coef(fit))
plot(out2, obs=data, obspar=list(pch=16, col="red"), ylim=list(c(0, 2e10), c(0, 50000), c(0, 50000), c(0, 600)))
Edit
The following approach improves the fit by:
fixing mass balance by setting total population to be constant over time
re-scale data to improve stability of optimization
guessing initial values from data
It would (in theory) be even better to include initial values in the optimization, but this would lead again to non-identifiability of parameters
due to the intrinsic characteristics of the given model and data. See twocomp_final.R for a related tutorial example.
Instead of data rescaling, one may also consider to adapt control parameters
of the optimizer(s) and of the ode function, or to rescale individual state variables differently.
However, it is easiest here just to rescale the population to "million people".
## fix mass balance, i.e. make sum of all states constant
## an alternative would be an additional process in the model
## for migration and / or birth and natural death
Population <- rowSums(data[c("S", "I", "R", "D")])
data$S <- Population[1] - rowSums(data[c("I", "R", "D")])
## rescale state variables to numerically more convenient numbers
## here simply: million people
scaled_data <- cbind(
time = data$time,
data[c("S", "I", "R", "D")] * 1e-6
)
## guess initial values from data (of course a little bit subjective)
state <- c(
S = scaled_data$S[1],
I = mean(scaled_data$I[1:3]),
R = mean(scaled_data$R[1:5]),
D = mean(scaled_data$D[1:3])
)
## use good initial parameters by thinking and some trial and error
parameters <- c(a = 0.0001, b = 0.01, g = 1)
cost2 <- function(p) {
out <- ode(state, times, eqn, p)
modCost(out, scaled_data, weight = "mean")
}
## fit model, enable trace with option nprint
fit <- modFit(f = cost2, p = parameters, control = list(nprint = 1))
summary(fit, corr=TRUE)
out2 <- ode(state, times, eqn, coef(fit))
plot(out2, obs = scaled_data, obspar = list(pch = 16, col = "red"))
Related
I am using the deSolve package to solve a differential equation describing predator-prey dynamics. As an example, below is a simple L-V predator-prey model. I would like some of the parameters in the model to vary through time. I can vary state variable (e.g. prey density) no problem using the event argument in the ode function.
But I cannot use the event argument to alter parameters.
Here is the simple L-V model with no events added (works fine)
# Lotka-Volterra Predator-Prey model from ?deSolve::ode
# define model
LVmod <- function(Time, State, Pars) {
with(as.list(c(State, Pars)), {
Ingestion <- rIng * Prey * Predator
GrowthPrey <- rGrow * Prey * (1 - Prey/K)
MortPredator <- rMort * Predator
dPrey <- GrowthPrey - Ingestion
dPredator <- Ingestion * assEff - MortPredator
return(list(c(dPrey, dPredator)))
})
}
# parameters
pars <- c(rIng = 0.2, # rate of ingestion
rGrow = 1.0, # growth rate of prey
rMort = 0.2 , # mortality rate of predator
assEff = 0.5, # assimilation efficiency
K = 10) # carrying capacity
# initial densities (state variables)
yini <- c(Prey = 1, Predator = 2)
# time steps
times <- seq(0, 200, by = 1)
# run model
out <- ode(yini, times, LVmod, pars)
## plot
plot(out)
Here is the L-V model with state variable Prey multiplied by some rnorm()every 5 timesteps (works fine).
# add prey every 5 timesteps using events
add_prey <- function(t, var, parms){
with(as.list(var),{
Prey <- Prey * rnorm(1, 1, 0.05)
return(c(Prey, Predator))
})
}
# run ode - works fine
out <- ode(y = yini,
times = times,
func = LVmod,
parms = pars,
method = "ode45",
events = list(func = add_prey, time = seq(0, 200, by = 5)))
plot(out)
Here is my attempt to increase K every 5 timesteps (does not work)
# vary K through time
add_k <- function(t, var, parms){
with(as.list(var),{
K <- K + 2
return(c(Prey, Predator))
})
}
# run ode
out <- ode(y = yini,
times = times,
func = LVmod,
parms = pars,
method = "ode45",
events = list(func = add_k, time = seq(0, 200, by = 5)))
Which produces this error:
Error in eval(substitute(expr), data, enclos = parent.frame()) :
object 'K' not found
Based on the error K is not being passed to add_k, in add_k the line with(as.list(var) is obviously only accessing the variables Prey and Predator. In the ode and event helpfiles I can only find information regarding altering state variables (Prey and Predator in this case), and no information about altering other parameters. I am new to ODEs, so maybe I am missing something obvious. Any advice would be much appreciated.
Events are used to modify state variables. This means that at each event time, the ode solver is stopped, then states are modified and then the solver is restarted. In case of time-dependent *parameters, this can be done much easier without events. We call this a "forcing function" (or forcing data).
A modified version of the original code is shown below. Here a few explanations:
approxfun is a function that returns a function. We name it K_t that interpolates between the data timesteps t and the parameter values K. The argument rule = 2 is important. It describes how interpolation is to take place outside the range of t, where 2means that the closest value is returned, because some solvers overshoot the end of the simulation and then interpolate back. The method can be constant or linear, whatever is more appropriate.
The interpolation function of the variable model parameter K_t can be added to the function as an optional argument at the end. It is also possible to define it globally or to include it in parmsif it is defined as a list, not a vector.
The LVmod function checks if this additional parameter exists and if yes overwrites the default of K.
At the end of the LVmodfunction we return the actual value of K as an optional (auxiliary) variable, so that it is included in the model output.
library(deSolve)
LVmod <- function(Time, State, Pars, K_t) {
with(as.list(c(State, Pars)), {
if (!is.null(K_t)) K <- K_t(Time)
Ingestion <- rIng * Prey * Predator
GrowthPrey <- rGrow * Prey * (1 - Prey/K)
MortPredator <- rMort * Predator
dPrey <- GrowthPrey - Ingestion
dPredator <- Ingestion * assEff - MortPredator
list(c(dPrey, dPredator), K = K)
})
}
pars <- c(rIng = 0.2, # rate of ingestion
rGrow = 1.0, # growth rate of prey
rMort = 0.2 , # mortality rate of predator
assEff = 0.5, # assimilation efficiency
K = 10) # carrying capacity
yini <- c(Prey = 1, Predator = 2)
times <- seq(0, 200, by = 1)
# run model with constant parameter K
out <- ode(yini, times, LVmod, pars, K_t=NULL)
## make K a function of t with given time steps
t <- seq(0, 200, by = 5)
K <- cumsum(c(10, rep(2, length(t) - 1)))
K_t <- approxfun(t, K, method = "constant", rule = 2)
out2 <- ode(yini, times, LVmod, pars, K_t=K_t)
plot(out, out2, mfrow=c(1, 3))
I have a model, and I want to generate random initial conditions, run the model, and save the output so that each simulation is a replicate. But I have a hard time interpreting and implementing loops (and I also know they are not always the best to use in R), so I'm struggling.
My ultimate goal is to iterate the simulation across 10 different random initial conditions, and save the output of the ODE including a column for simulation number.
First I have my random initial conditions:
library(deSolve)
states <- c(r=runif(1, min=0.1, max=25), # resource state variable
c=runif(1, min=0.1, max=10)) # consumer state variable
Then I have my parameters and model:
parameters <- c(g=5, # resource growth rate )
K=25, # resource carrying capacity
a=1, # consumer attack rate
h=1, # consumer handling time
e=0.9, # consumer conversion efficiency
m=0.5, # consumer mortality rate
avgrain = 1500, # average rainfall
A = 1000,
w = 0.6,
phi = 8.5,
ropt1 = 1500, # optimal rainfall for resource growth
s1 = 1000, # standard deviation for plant growth rate as a function of rainfall
ropt2 = 1000, # optimal rainfall for herbivore attack (feeding) rate
s2 = 500, # standard deviation for herbivore attack rate as a function of rainfall
avgtemp = 20, # average temperature
A_temp = 7,
w_temp = 0.5,
phi_temp = 0.5,
topt1 = 13, # optimal temperature for resource growth
ts1 = 10 # standard deviation for plant growth rate as a function of temperature
)
model <- function(t, states, parameters) {
with(as.list(c(states, parameters)), {
# rainfall time series function
rain <- avgrain + (A*sin((w*t)+phi)) # rainfall function
# temperature time series function
temp = avgtemp + (A_temp*sin((w_temp*t)+phi_temp))
# dynamic g and a equations
dg_both <- (exp(-(rain - ropt1)^2/(s1^2))) + (exp(-(temp - topt1)^2/(ts1^2)))
da = exp(-(rain - ropt2)^2/(s2^2))
# rate of change of state variables
dr <- dg_both*r*(1-(r/K)) - ((c*da*r)/(1+(da*h*r)))
dc <- ((c*e*da*r)/(1+(da*h*r)))- c*m
# return rate of change
list(c(dr, dc), rain=rain, temp=temp, dg_both=dg_both, da=da)
})
}
times <- seq(0, 200, by = 1)
out <- ode(y = states, times = times, func = model, parms = parameters, method="lsoda")
Would I do this with a for loop? Thank you in advance!
Here one of the other approaches, mentioned by #Ben Bolker. Here we use replicate instead of a loop. This has the advantage, that we don't need to create a list() for the results beforehand.
N <- 10
res <- replicate(N, ode(y = c(r = runif(1, min = 0.1, max = 25),
c = runif(1, min = 0.1, max = 10)),
times = times, func = model,
parms = parameters, method="lsoda"),
simplify = FALSE)
plot(out, res)
As an additional goody, we can also plot the results using deSolve's built-in plotting function. This works of course also with res in Ben's approach. The resulting data structure can then be simplified to something like a matrix or array, either with do.call(rbind, res) as in Ben's example, or with option simplify directly in replicate.
Yes, a for loop will be fine. There are lots of other slightly fancier ways to do this (replicate or lapply from base R, purrr::map_dfr from tidyverse ...), but they won't save you any time or memory — they're just a slightly more elegant way to do the same thing.
set.seed(101)
N <- 10
res <- list()
for (i in 1:N) {
## pick new initial conditions
cur_states <- c(r=runif(1, min=0.1, max=25),
c=runif(1, min=0.1, max=10))
## run model and attach index column to the matrix
res[[i]] <-
cbind(run = i,
ode(y = cur_states, times = times, func = model,
parms = parameters, method="lsoda")
)
}
## combine individual runs into one long matrix
res_final <- do.call(rbind,res)
I am trying to simulate a realistic age structured model where all individuals could shift into the following age group at the end of the time step (and not age continuously at a given rate) using ODE from the deSolve package.
Considering for example a model with two states Susceptible (S) and Infectious (I), each state being divided in 4 age groups (S1, S2, S3, S4, and I1, I2, I3, I4), all individuals in S1 should go into S2 at the end of the time step, those in S2 should go into S3, and so on.
I tried to make this in two steps, the first by solving the ODE, the second by shifting individuals into the following age group at the end of the time step, but without success.
Below is one of my attempts :
library(deSolve)
times <- seq(from = 0, to = 100, by = 1)
n_agecat <- 4
#Initial number of individuals in each state
S_0 = c(999,rep(0,n_agecat-1))
I_0 = c(1,rep(0,n_agecat-1))
si_initial_state_values <- c(S = S_0,
I = I_0)
# Parameter values
si_parameters <- c(beta = 0.01) #contact rate assuming random mixing
si_model <- function(time, state, parameters) {
with(as.list(c(state, parameters)), {
n_agegroups <- 4
S <- state[1:n_agegroups]
I <- state[(n_agegroups+1):(2*n_agegroups)]
# Total population
N <- S+I
# Force of infection
lambda <- beta * I/N
# Solving the differential equations
dS <- -lambda * S
dI <- lambda * S
# Trying to shift all individuals into the following age group
S <- c(0,S[-n_agecat])
I <- c(0,I[-n_agecat])
return(list(c(dS, dI)))
})
}
output <- as.data.frame(ode(y = si_initial_state_values,
times = times,
func = si_model,
parms = si_parameters))
Any guidance will be much appreciated, thank you in advance!
I had a look at your model. Implementing the shift in an event function works, in principle, but the main model has still several problems:
die out: if the age groups are shifted per time step and the first element is just filled with zero, everything is shifted to the end within 4 time steps and the population dies out.
infection: in your case, the infected can only infect the same age group, so you need to summarize over the "age" groups before calculating lambda.
Finally, what is "age" group? Do you want the time since infection?
To sum up, there are several options: I would personally prefer a discrete model for such a simulation, i.e. difference equations, a age structured matrix model or an individual-based model.
If you want to keep it an ODE, I recommend to let the susceptible together as one state and to implement only the infected as stage structured.
Here a quick example, please check:
library(deSolve)
times <- seq(from = 0, to = 100, by = 1)
n_agegroups <- 14
n_agecat <- 14
# Initial number of individuals in each state
S_0 = c(999) # only one state
I_0 = c(1, rep(0,n_agecat-1)) # several stages
si_initial_state_values <- c(S = S_0,
I = I_0)
# Parameter values
si_parameters <- c(beta = 0.1) # set contact parameter to a higher value
si_model <- function(time, state, parameters) {
with(as.list(c(state, parameters)), {
S <- state[1]
I <- state[2:(n_agegroups + 1)]
# Total population
N <- S + sum(I)
# Force of infection
#lambda <- beta * I/N # old
lambda <- beta * sum(I) / N # NEW
# Solving the differential equations
dS <- -lambda * S
dI <- lambda * S
list(c(dS, c(dI, rep(0, n_agegroups-1))))
})
}
shift <- function(t, state, p) {
S <- state[1]
I <- state[2:(n_agegroups + 1)]
I <- c(0, I[-n_agecat])
c(S, I)
}
# output time steps (note: ode uses automatic simulation steps!)
times <- 1:200
# time step of events (i.e. shifting), not necessarily same as times
evt_times <- 1:200
output <- ode(y = si_initial_state_values,
times = times,
func = si_model,
parms = si_parameters,
events=list(func=shift, time=evt_times))
## default plot function
plot(output, ask=FALSE)
## plot totals
S <- output[,2]
I <- rowSums(output[, -(1:2)])
par(mfrow=c(1,2))
plot(times, S, type="l", ylim=c(0, max(S)))
lines(times, I, col="red", lwd=1)
## plot stage groups
matplot(times, output[, -(1:2)], col=rainbow(n=14), lty=1, type="l", ylab="S")
Note: This is just a technical demonstration, not a valid stage structured SIR model!
I am trying to establish a method of estimating infectious disease parameters by comparing real epidemic curves with simulations of a stochastic SIR model. To construct the stochastic SIR model, I am using the deSolve package and instead of using fixed parameter values I would like to draw the parameter value used in the equations at each time point from a Poisson distribution centered on the original parameter values.
Using the parameter beta as an example, beta represents the average number of transmission events per capita and is the product of the average number of contacts and the probability that transmission occurs upon contact. Realistically, there is variation in the number of contacts a person will have and since transmission is also a probabilistic event there is variation surrounding this too.
So even if the average transmission rate were to be 2.4 (for example), an individual can go on to infect 0, 1, 2 or 3 ... etc. people with varying probabilities.
I have tried to incorporate this into my code below using the rpois function and reassigning the parameters used in the equations to the outputs of the rpois.
I have run my code with the same initial values and parameters multiple times and all the curves are different indicating that SOMETHING "stochastic" is going on, but I am unsure whether the code is sampling using the rpois at each time point or just once at the beginning. I have only started coding very recently so do not have much experience.
I would be grateful if anyone more experienced than myself could verify what my code is ACTUALLY doing and whether it is sampling using rpois at each time point or not. If not I would be grateful for any suggestions for achieving this. Perhaps a loop is needed?
library('deSolve')
library('reshape2')
library('ggplot2')
#MODEL INPUTS
initial_state_values <- c(S = 10000,
I = 1,
R = 0)
#PARAMETERS
parameters <- c(beta = 2.4,
gamma = 0.1)
#POISSON MODELLING OF PARAMETERS
#BETA
beta_p <- rpois(1, parameters[1])
#GAMMA
infectious_period_p <- rpois(1, 1/(parameters[2]))
gamma_p <- 1/infectious_period_p
#TIMESTEPS
times <- seq(from = 0, to = 50,by = 1)
#SIR MODEL FUNCTION
sir_model <- function(time, state, parameters) {
with(as.list(c(state, parameters)), {
N <- S + I + R
lambda <- beta_p * I/N
dS <- -lambda * S
dI <- lambda*S - gamma_p*I
dR <- gamma_p*I
return(list(c(dS, dI, dR)))
})
}
output<- as.data.frame(ode(y= initial_state_values,
times = times,
func = sir_model,
parms = parameters))
The code given in the question runs the model with constant parameters over time. Here an example with parameters varying over time. However, this setting assumes that for a given time step, the parameters are equal for all indidividuals of the population. If you want to have individual variability, one can either use a matrix formulation for different sub-populations or use an individual model instead.
Model with fluctuating population parameters:
library('deSolve')
initial_state_values <- c(S = 10000,
I = 1,
R = 0)
parameters <- c(beta = 2.4, gamma = 0.1)
times <- seq(from = 0, to = 50, by = 1) # note time step = 1!
# +1 to add one for time = zero
beta_p <- rpois(max(times) + 1, parameters[1])
infectious_period_p <- rpois(max(times) + 1, 1/(parameters[2]))
gamma_p <- 1/infectious_period_p
sir_model <- function(time, state, parameters) {
# cat(time, "\n") # show time steps for debugging
with(as.list(c(state, parameters)), {
# this overwrites the parms passed via parameters
beta <- beta_p[floor(time) + 1]
gamma <- gamma_p[floor(time) + 1]
N <- S + I + R
lambda <- beta * I/N
dS <- -lambda * S
dI <- lambda * S - gamma * I
dR <- gamma * I
list(c(dS, dI, dR))
})
}
output <- ode(y = initial_state_values,
times = times,
func = sir_model,
parms = parameters)
plot(output)
Here another, slightly more generalized version. It is added as a second answer, to keep the original version compact and simple. The new version differs with respect to the following:
generalized, so that it can work with fixed parameters and stochastic forcing
pass parameters as list
run a basic Monte-Carlo simulation
library('deSolve')
sir_model <- function(time, state, parameters) {
with(as.list(c(state, parameters)), {
# this overwrites the parms passed via parameters
if (time_dependent) {
beta <- beta_p[floor(time) + 1]
gamma <- gamma_p[floor(time) + 1]
}
N <- S + I + R
lambda <- beta * I/N
dS <- -lambda * S
dI <- lambda * S - gamma * I
dR <- gamma * I
list(c(dS, dI, dR))
})
}
initial_state_values <- c(S = 10000, I = 1, R = 0)
times <- seq(from = 0, to = 50, by = 1) # note time step = 1!
## (1) standard simulation with constant parameters
parameters <- c(beta = 2.4, gamma = 0.1)
out0 <- ode(y= initial_state_values,
times = times,
func = sir_model,
parms = c(parameters, time_dependent = FALSE))
plot(out0)
## (2) single simulation with time varying parameters
beta_p <- rpois(max(times) + 1, parameters[1])
infectious_period_p <- rpois(times + 1, 1/(parameters[2]))
gamma_p <- 1/infectious_period_p
## here we need pass the vectorized parameters globally
## for simplicity, it can also be done as list
out1 <- ode(y = initial_state_values, times = times,
func = sir_model, parms = c(time_dependent = TRUE))
plot(out0, out1)
## (3) a sample of simulations
monte_carlo <- function(i) {
#parameters <- c(beta = 2.4, gamma = 0.1)
beta_p <- rpois(max(times) + 1, parameters[1])
infectious_period_p <- rpois(max(times) + 1, 1 / (parameters[2]))
gamma_p <- 1/infectious_period_p
ode(y = initial_state_values, times = times,
func = sir_model, parms = list(beta_p = beta_p,
gamma_p = gamma_p,
time_dependent = TRUE))
}
## run 10 simulations
out_mc <- lapply(1:10, monte_carlo)
plot(out0, out_mc, mfrow=c(1, 3))
I'm trying to fit an ODE model to some data and solve for the values of the parameters in the model.
I know there is a package called FME in R which is designed to solve this kind of problem. However, when I tried to write the code like the manual of this package, the program could not run with the following traceback information:
Error in lsoda(y, times, func, parms, ...) : illegal input detected before taking any integration steps - see written message
The code is the following:
x <- c(0.1257,0.2586,0.5091,0.7826,1.311,1.8636,2.7898,3.8773)
y <- c(11.3573,13.0092,15.1907,17.6093,19.7197,22.4207,24.3998,26.2158)
time <- 0:7
# Initial Values of the Parameters
parms <- c(r = 4, b11 = 1, b12 = 0.2, a111 = 0.5, a112 = 0.1, a122 = 0.1)
# Definition of the Derivative Functions
# Parameters in pars; Initial Values in y
derivs <- function(time, y, pars){
with(as.list(c(pars, y)),{
dx <- r + b11*x + b12*y - a111*x^2 - a122*y^2 - a112*x*y
dy <- r + b12*x + b11*y - a122*x^2 - a111*y^2 - a112*x*y
list(c(dx,dy))
})
}
initial <- c(x = x[1], y = y[1])
data <- data.frame(time = time, x = x, y = y)
# Cost Computation, the Object Function to be Minimized
model_cost <- function(pars){
out <- ode(y = initial, time = time, func = derivs, parms = pars)
cost <- modCost(model = out, obs = data, x = "time")
return(cost)
}
# Model Fitting
model_fit <- modFit(f = model_cost, p = parms, lower = c(-Inf,rep(0,5)))
Is there anyone that knows how to use the FME package and fix the problem?
Your code-syntax is right and it works until the last line.
you can check your code with
model_cost(parms)
This works fine and you can see with
model_cost(parms)$model
that your "initial guess" is far away from the observed data (compare "obs" and "mod"). Perhaps here is a failure so that the fitting procedure will not reach the observed data.
So much for the while ... I also checked different methods with parameter "methods = ..." but still does not work.
Best wishes,
Johannes
edit: If you use:
model_fit <- modFit(f = model_cost, p = parms)
without any lower bounds, then you will get an result (even there are warnings), but then a112 is negative what you wanted to omit.