Forcing function in ODE - r

I have a system of Ordinary Differential equation which contains a forcing function R_0. The forcing function has a formula to be calculated at each time step. I tried to use approxfunc() in R, but when I print R_0_matrix I got (?) on the R_0 column at each time point and I got this error message when I run R_0_value
Error in xy.coords(x, y) :
(list) object cannot be coerced to type 'double'
I don't know where is my mistake in the code,any help will be appreciated
Here is a part of my code:
# define model paramters
parameters <- c(N = 3.2*10^6,L =1000/15,dimm = 1/1.07, d_in = 75/365, d_treat0 = 2/52, p1 = 0.87, p2 = 0.08, k = 0.082, eta0 = 0.05, R_m =1.23,amp = 0.67,phi = 3/12)
# R_0 Forcing Function
t <- seq(0, 100, by = 0.1)
R_0 <-function(t,paramters){
with(as.list(parameters),{
R_0=R_m*amp*cos(2*pi*(t-phi))+R_m
return(R_0)
})
}
R_0_matrix <-cbind(t,R_0)
R_0_value<- approxfun(x=R_0_matrix[,1], y= R_0_matrix[,2], method="linear", rule=2)

R_0 is a function. So cbind(t, R_0) is probably not what you intended, since it tries to create a matrix where one column is numeric and the other is a function. See what happens, for example, if you type this into the console: cbind(1:10, function(x) {x}). Probably you meant to do this:
R_0_t = R_0(t, parameters)
R_0_matrix <- cbind(t, R_0_t)
R_0_value <- approxfun(x=R_0_matrix[,1], y= R_0_matrix[,2], method="linear", rule=2)
Naming the function R_0 and then also calling the calculated object within the function environment R_0 may have caused some confusion. Even though the function creates an object called R_0 inside the function environment, the object R_0 that exists in the global environment is the function itself. To avoid confusion it's better to use different names for the function and any objects created inside the function environment.
Furthermore, the function does not return an object called R_0 to the global environment. It just returns the vector of numbers that result from evaluating the function R_0. The name of this returned vector in the global environment is whatever you assign when you call the function (R_0_t in the code sample above).
And just to check the approximation function:
plot(t[1:30], R_0_t[1:30], type="l", lwd=2)
lines(t[1:30], R_0_value(t[1:30]), col="red", lwd=6, lty=3)

Related

Partially differentiate a function in R using the 'Deriv' package

I need to write a function in R which depends on a vector x (which changes with every simulation) and has parameters beta_0, beta_1, beta_2. I'm trying to find the partial derivative of this function with respect to beta_0, beta_1 and beta_2.
I have written a code for the same but its repeatedly returning errors.
My R code is as follows:
func_1 <- function(x,beta_0,beta_1,beta_2){
k <- beta_0+(x[1]*beta_1)+(x[2]*beta_2)
k <- exp(k)/(1+exp(k))
}
Deriv(func_1(x=c(2,3)), 'beta_0')
The following error is being returned:
Error in func_1(x = c(2, 3)) :
argument "beta_0" is missing, with no default
In addition: Warning message:
In Deriv(func_1(x = c(2, 3)), "beta_0") :
restarting interrupted promise evaluation
If you want the partial derivative with respect to beta_0 you still need to specify values for all of the parameters. You also need to pass Deriv a function (or an expression); in your example you're trying to evaluate the function at x=c(2,3) (without specifying values of the other arguments/parameters). In other words, if you have a function foo you need to pass foo, not foo([something]). So for example:
library(Deriv)
dd <- Deriv(func_1, "beta_0")
dd(x=c(2,3), beta_0 = 1, beta_1 = 1, beta_2 =1)
## beta_0
## 0.002466509
Here dd is the partial derivative with respect to beta_0, which is a function that can be evaluated at any numerical values you like. (if you need a symbolic partial derivative - i.e.. the value for arbitrary values of beta_0, beta_1, beta_2 - I'm not sure that Deriv will do that ...)

how to use Vector of two vectors with optim

I have a wrapper function of two functions. Each function has its own parameters vectors. The main idea is to pass the vectors of parameters (which is a vector or two vectors) to optim and then, I would like to maximize the sum of the function.
Since my function is so complex, then I tried to provide a simple example which is similar to my original function. Here is my code:
set.seed(123)
x <- rnorm(10,2,0.5)
ff <- function(x, parOpt){
out <- -sum(log(dnorm(x, parOpt[[1]][1], parOpt[[1]][2]))+log(dnorm(x,parOpt[[2]][1],parOpt[[2]][2])))
return(out)
}
# parameters in mu,sd vectors arranged in list
params <- c(set1 = c(2, 0.2), set2 = c(0.5, 0.3))
xy <- optim(par = params, fn=ff ,x=x)
Which return this error:
Error in optim(par = params, fn = ff, x = x) :
function cannot be evaluated at initial parameters
As I understand, I got this error because optim cannot pass the parameters to each part of my function. So, how can I tell optim that the first vector is the parameter of the first part of my function and the second is for the second part.
You should change method parameter to use initial parameters.
You can read detailed instructions about optim function using ?optim command.
For example you can use "L-BFGS-B" method to use upper and lower constraints.

Debugging optimization of a function

I have a function that works just fine when asked to calculate the -logLik given parameters. However, if I try to optimize the function it returns an error message. I'm familiar with debug() to work through problems with a function, but how would I go about debugging optimization for a function that othwerwise works?
Lik <- function(params, data) {
....
return(-log( **likelihood equation** ))
}
These work!
Lik(params=c(3,10,2,9,rowMeans(data[1,])[1]), data = data1)
Lik(params=c(3,10,2,9.5,rowMeans(data[1,])[1]), data = data1)
GENE1 32.60705
GENE1 32.31657
This doesn't work!
optim(params=c(3,10,2,9,rowMeans(data[1,])[1]), data = data1, Lik, method = "BFGS")
Error in optim(params = c(3, 10, 2, 9, rowMeans(data[1, ])[1]), data = data1, :
cannot coerce type 'closure' to vector of type 'double'
The optim parameter name for the parameters to optimize over is par, not params. You don't need to change your Lik function, it just needs to have the parameters to optimize over as the first argument, the name doesn't matter.
This should work. Here I name the fn argument too, but because the others are named the positional finding works.
optim(par=c(3, 10, 2, 9, rowMeans(data[1, ])[1]),
data=data1, fn=Lik, method="BFGS")
So what was happening in your code was that it was saving both params and data to send to the function, and then the first unnamed parameter was Lik so it was getting matched to the first parameter of optim, which is par, the parameters to optimize over. That parameter should be a numeric (a double, technically) but you were sending it a function (a closure, technically), hence the error message.
To debug, you could have turned on debugging for optim debug(optim) and then at the first browse, explored what the parameters were that it was using. You would have found exactly this, though simply in exploring the parameters, you would have discovered you named them incorrectly.
Browse[2]> print(par)
function(params, data) {... return(-log( **likelihood equation** ))}
Browse[2]> print(fn)
Error in print(fn) : argument "fn" is missing, with no default
It is bad practice to use built-in function names as object names created (or to be created) by the user.
When there is no "data" object (a matrix or a data frame) yet created by the user, R interpreter scans the environments and finds that the only object named "data" is the built in "data" function:
> class(data)
[1] "function"
> str(data)
function (..., list = character(), package = NULL, lib.loc = NULL, verbose = getOption("verbose"),
envir = .GlobalEnv)
Hence R treats the "data" object as a closure (a function declaration) that cannot be subsetted:
> data[1]
Error in data[1] : object of type 'closure' is not subsettable
So you should change the name of the parameter to sth other than data.
And a second point, the syntax of optim is:
optim(par, fn, gr = NULL, ...,
method = c("Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN",
"Brent"),
lower = -Inf, upper = Inf,
control = list(), hessian = FALSE)
So in your example, the second parameter supplied to optim should be the function Lik, not the data. And the interpreter tries to interpret data1 as a closure. You can try to swap the positions of data1 and Lik.
And more importantly as #李哲源ZheyuanLi also points, there is no parameter in optim named as "data". You should just write it as "data1" in place of the additional function parameters "...".
And last, as also #Aaron pointed out, the first parameter is named "par" not params".

MLE function with array of parameters

I would like to know how to do the maximum likelihood estimation in R when fitting parameters are given in an array. This is needed when the number of parameters is large. So basically, to fit a normal distribution to the data x, I would like to do something like the following
LL <- function(param_array) {
R = dnorm(x, param_array[1], param_array[2])
-sum(log(R))
}
mle(LL, start = list(param_array = c(1,1)))
(Instead of this original code in the first section of http://www.r-bloggers.com/fitting-a-model-by-maximum-likelihood/)
If I ran the code above I will get an error
Error in dnorm(x, param_array[1], param_array[2]) : argument
"param_array" is missing, with no default
Could anyone let me know how to achieve what I want in the correct way?
stats4::mle is not a long function, you can inspect it in your R console:
> stats4::mle
Note how start is handled:
start <- sapply(start, eval.parent)
nm <- names(start)
case 1
If you do:
LL <- function(mu, sigma) {
R = dnorm(x, mu, sigma)
-sum(log(R))
}
mle(LL, start = list(mu = 1, sigma = 1))
you get:
nm
#[1] "mu" "sigma"
Also,
formalArgs(LL)
#[1] "mu" "sigma"
case 2
If you do:
LL <- function(param_array) {
R = dnorm(x, param_array[1], param_array[2])
-sum(log(R))
}
mle(LL, start = list(param_array = c(1,1)))
you get
nm
#[1] NULL
but
formalArgs(LL)
#[1] param_array
The problem
The evaluation of function LL inside stats::mle is by matching nm to the formal arguments of LL. In case 1, there is no difficulty in matching, but in case 2 you get no match, thus you will fail to evaluate LL.
So what do people do if they have like 50 parameters? Do they type them in by hand?
Isn't this a bogus argument, after a careful reflection? If you really have 50 parameters, does using an array really save your effort?
First, inside your function LL, you have to specify param_array[1], param_array[2], ..., param_array[50], i.e., you still need to manually input 50 parameters into the right positions. While when specifying start, you still need to type in a length-50 vector element by element, right? Isn't this the same amount of work, compared with not using an array but a list?

R : Function doesn't work when I change the parameters order

I'm using the nls.lm function from the minpack.lm package and something "weird" happens when I change the order of the parameters in the residual function
This code works :
install.packages('minpack.lm')
library(minpack.lm)
## values over which to simulate data
x <- seq(0,100,length=100)
## model based on a list of parameters
getPrediction <- function(parameters, x)
parameters$A*exp(-parameters$alpha*x) + parameters$B*exp(-parameters$beta*x)
## parameter values used to simulate data
pp <- list(A = 2, B = 0.8, alpha = 0.6, beta = 0.01)
## simulated data, with noise
simDNoisy <- getPrediction(pp,x) + rnorm(length(x),sd=.01)
#simDNoisy[seq(1,10)] = rep(10,11)
simDNoisy[1] = 4
## plot data
plot(x,simDNoisy, main="data")
## residual function
residFun <- function(parameters, observed, xx)
sqrt(abs(observed - getPrediction(parameters, xx)))
## starting values for parameters
parStart <- list(Ar = 3, Br = 2, alphar = 1, betar = 0.05)
## perform fit
rm(nls.out)
nls.out <- nls.lm(par=parStart,
fn = residFun,
observed = simDNoisy,
xx = x,
control = nls.lm.control(nprint=1))
nls.out
It doesn't work if I replace the residual function by this (just change parameters order)
residFun <- function(xx, parameters, observed )
sqrt(abs(observed - getPrediction(xx, parameters)))
Error in parameters$A : $ operator is invalid for atomic vectors
Why does it cause this error ?
Parameters should match the order of the parameters as defined in the function. The only exception you should use is if you explicitly name them out of order. Consider this example of what the function thinks are two parameters
theParameters=function(X,Y){
print(paste("I think X is",X))
print(paste("I think Y is",Y))
}
theParameters(X=2,Y=10)
theParameters(Y=10,X=2)
#you can change the parameter order if you identify them with parameter=...
#but if you don't, it assumes it's in the order of how the function is defined.
# which of these is X and which is Y?
theParameters(10,2)
It's preferable to always identify the parameters, but nececessary if it's out of order. (Other languages don't even let you change the order of parameters when you call them).
getPrediction(xx=xx,parameters=parameters)
In this case the reason is the function treats xx and parameters as if it had created its own local copy. Without the identification this line
getPrediction(xx,parameters)
means this to R
getPrediction(parameters=xx,xx=parameters)
because that matches the original signature of the function.
So the function's version of parameters is what you pass in as xx, and so on.
Because you called the parameters the same thing as variable names, it can be confusing. It works easier if you vary the dummy version of variable names slightly. Alternatively if scopes of variables allow it, you don't even have to pass in the parameters, but be careful with that practice because it can cause tracing headaches.

Resources