So, I have these functions:
funk1 <- function(a,x,l,r) {
x^2*exp(-(l*(1-exp(-r*a))/r))}
funk2 <- function(x,l,r) {
sapply(x, function (s) {
integrate(funk1, lower = 0, upper = s, x=s, l=l, r=r)$value })}
which are used to explain the data y in,
z <- data.frame(ts = 1:100,
y = funk2(1:100, l = 1, r = 1) + rpois(100, 1:100))
I wish to use optim to maximise the likelihood, so I defined a likelihood function:
LL_funk <- function(l,r) {
n=nrow(z)
R = sum((funk2(ts,l,r) - y)^2)
logl = -((n/2)*log(R))
return(-logl)
}
and I tried to fit using optim
fit <- optim(par=c(0.5,0.5), fn= LL_funk, method="Nelder-Mead")
But I get an error:
Error in integrate(funk1, lower = 0, upper = s, x = s, l = l, r = r) :
a limit is missing
I am not sure why? I could run nls fitting funk2(x,l,r) to y
nls(y ~ funk2(ts,l,r), data = z, start = list(l = 0.5, r = 0.5))
That means funk2 is working. I guess its the problem with LL function that I have designed, which I cant figure out!! Please Help!
Yup! There were two problems with your function. This worked for me:
LL_funk <- function(params) {
n=nrow(z)
l = params[1]
r = params[2]
R = sum((funk2(z$ts,l,r) - z$y)^2)
logl = -((n/2)*log(R))
return(-logl)
}
Previous issues:
LL_funk only takes 1 argument, which is the vector of parameters.
In LHS of the assignment of R, ts and y were not actually referring to columns in your dataset.
Related
I'm trying to write the density of a mixture Gaussian distribution to an arbitrary power, b, in R. Currently, I have two methods that works, but I prefer if I could avoid a for loop.
dnorm_mix_tempered_unnorm <- function(x, w, m, s, b) {
value <- 0
for (i in 1:length(w)) {value <- value + w[i]*dnorm(x, mean = m[i], sd = s[i])}
value <- value^(b)
return(value)
}
Alternatively, I can vectorise this to avoid the for loop:
dnorm_mix_tempered_unnorm <- function(x, w, m, s, b) {
return(sum(w*dnorm(x, mean = m, sd = s))^b)
}
Both of these give the same result, but the second is more efficient since it is vectorised. But I need to next normalise this so that the density integrates to 1, I do this by using:
dnorm_mix_tempered <- function(x, weights, means, sds, beta) {
norm_constant <- integrate(function(x) dnorm_mix_tempered_unnorm(x, w = weights,
m = means, s = sds, b = 1/beta), lower = -Inf,
upper = Inf)$value
value <- dnorm_mix_tempered_unnorm(x, w = weights, m = means, s = sds, b = 1/beta)
/ norm_constant
return(value)
}
If I define dnorm_mix_tempered_unnorm with for loops, this works with no problem, and I can use curve() to plot the density. But if I define dnorm_mix_tempered_unnorm by using vectorisation, then I get the following error:
Error in integrate(function(x) dnorm_mix_tempered_unnorm(x, w = weights, :
evaluation of function gave a result of wrong length
Does anyone know what is going on when I am vectorising instead and trying to integrate?
Thanks in advance,
R.
A possible option is
dnorm_mix_tempered_unnorm <- function(x, w, m, s, b) {
return(rowSums(mapply(dnorm, mean = m, sd = m, MoreArgs = list(x = x)))^b)
}
But I think it is quite similar to your first proposal.
I am trying to simulate a model with this differential equation for concentration A:
dA/dt = (a-b)*exp^(d*(s-t))
(The equations has parameters: a, b, d, and s.) I can not figure out how to use R to solve differential equations that have a t (time step) variable? I tried it with the function radau of the package deSolve (See beneath). I did not get the code to work. I also do not understand how to define the index variable? Or if this is solvable with this function at all? (All my other simpler differential equations I have ran in the past with the ode function of deSolve, worked fine).
I hope you can help me!
My try:
#Defining parameters
parameter <- c(a=0.03, b=0.02, d=0.01, s=179)
#Defining Function
Function1 <- function(t, y, parameter) { with (as.list(Y),
list(c(dA = (a-b)*exp^(d*(s-t)))))}
#Initial conditions
yini <- c(A=1)
#Mass matrix
M <- diag(nrow=1)
M[5,5] <- 0
M
#index/times/output
index <- c(1)
times <- seq(from = 0, to = 10, by = 0.01)
out <- radau(y = yini, func = Function1, parms = parameters, times = times, mass = M, nind = index)
plot(out, type = "l", lwd = 2)
I'm not sure what's up with M or index as they don't appear in your model, but here's code that runs and produces results based on your code.
#Defining parameters
parameter <- c(a=0.03, b=0.02, d=0.01, s=179)
#Defining Function
model <- function(t, y, parameter) {
with(as.list(parameter),{
dA <- (a - b) * exp(d * (s - t))
list(dA)
})
}
#Initial conditions
yini <- 1
# Output times
times <- seq(from = 0, to = 10, by = 0.01)
# Solve model
out <- ode(y = yini, func = model, parms = parameter, times = times)
# Plot results
plot(out, type = "l", lwd = 2)
I'm doing Maximum Likelihood Estimation using maxLik, which requires specifying starting values. Instead of specifying a single value, is there any way that allows me to use all the values from a matrix as the start value?
My current code of maxLik is:
f12 <- function(param){
alpha <- param[1]
rho <- param[2]
lambda <- param[3]
u <- 0.5*(p12$v_50_1)^alpha + 0.5*lambda*(p12$v_50_2)^alpha
p <- 1/(1 + exp(-rho*u))
f <- sum(p12$gamble*log(p) + (1-p12$gamble)*log(1-p))}
ml <- maxLik(f12, start = c(alpha = 1, rho=2, lambda = 1), method = "NM")
I create a dataframe with the upper and lower bounds of potential start values:
st <- expand.grid(alpha = seq(0, 2, len = 100),rho = seq(0, 1, len = 100),lambda = seq(0,2, length(100))
There are 3 parameters in my function, and my goal is to loop all the values in the above dataframe st and select the best vector of start values after running the model from a variety of starting parameters.
Thanks!
Consider Map (wrapper to mapply) to pass the st columns elementwise through your methods. Here, Map will return a list of maxLik objects, specifically inherited maxim class objects containing a list of other components. The number of items in this list will be equal to rows of st.
Notice input parameters, a, r, and l being passed into start argument of maxLik() and no longer hard-coded integers. And f12 is left untouched.
maxLik_run <- function(a, r, l) {
tryCatch({
f12 <- function(param){
alpha <- param[1]
rho <- param[2]
lambda <- param[3]
u <- 0.5*(p12$v_50_1)^alpha + 0.5*lambda*(p12$v_50_2)^alpha
p <- 1/(1 + exp(-rho*u))
f <- sum(p12$gamble*log(p) + (1-p12$gamble)*log(1-p))
}
return(maxLik(f12, start = c(alpha = a, rho = r, lambda = l), method = "NM"))
}, error = function(e) return(NA))
}
st <- expand.grid(alpha = seq(0, 2, len = 100),
rho = seq(0, 1, len = 100),
lambda = seq(0, 2, length(100)))
maxLik_list <- Map(maxLik_run, st$alpha, st$rho, st$lambda)
And to answer the question --best vector of start values after running the model from a variety of starting parameters-- requires a particular definition of "best". Once you define this, you can use Filter() on your returned list of objects to select the one or more element that yields this "best".
Below is a demonstration to find the highest value across each maximum likelihood's maximum. Use estimate if needed. Do note, this returned list can have more than one if the highest value is shared by other list items:
highest_value <- max(sapply(maxLik_list, function(item) item$maximum))
maxLik_item_list <- Filter(function(i) i$maximum == highest_value, maxLik_list)
What you are doing in your logLik function is that you are calculating alpha,lambda,rho whereas your data already has them.Those are the lines with u,p and f12(that is also your function name!). Also it is possible to calculate log likelihood for one row as your log likelihood function has single indices. So you run the code using apply like this
#create a function to find mle estimate for first row
maxlike <- function(a) {
f12 <- function(param){
alpha <- param[1]
rho <- param[2]
lambda <- param[3]
#u <- 0.5*(p12$v_50_1)^alpha + 0.5*lambda*(p12$v_50_2)^alpha
#p <- 1/(1 + exp(-rho*u))
#f12 <- sum(p12$gamble*log(p) + (1-p12$gamble)*log(1-p))
}
ml <- maxLik(f12, start = c(alpha = 1, rho=2, lambda = 1), method = "NM")
}
#then using apply with data = st, 2 means rows and your mle function
mle <- apply(st,2,maxlike)
mle
I would like to compute an integral where the integrand is a function of the solution of an ODE.
In order to solve the integral, R needs to solve an ODE for each value the integration algorithm uses. This is what I have done so far:
require(deSolve)
# Function to be passed to zvode in order to solve the ODE
ODESR <- function(t, state, parameters) {
with(as.list(c(state, parameters)),{
dPSI <- -kappa*PSI+0.5*sigma^2*PSI^2
dPHI <- kappa*theta*PSI
return(list(c(dPSI, dPHI)))
})
}
# For a given value of p this code should return the solution of the integral
pdfSRP <- function (p) {
integrand <- function (u) {
state <- c(PSI = u*1i, PHI = 0)
out <- as.complex(zvode(y = state, times = times, parms = parameters, fun = ODESR)[2, 2:3])
Re(exp(out[2] + out[1]*x)*exp(-u*1i*p))
}
integrate(f = integrand, lower = -Inf, upper = Inf)$value/(2*pi)
}
For the following given values:
parameters <- c(kappa = 1, theta = 0.035, sigma = 0.05)
times <- c(0,1)
x <- 0.1
running:
pdfSRP(p = 2)
produces the following error:
Error in eval(expr, envir, enclos) : object 'PSI' not found
I just cannot figure out why. I'm quite sure it is due to a syntax error, because running:
integrand <- function (u) {
state <- c(PSI = u*1i, PHI = 0)
out <- as.complex(zvode(y = state, times = times, parms = parameters, fun = ODESR)[2, 2:3])
Re(exp(out[2] + out[1]*x)*exp(-u*1i*p))
}
with p <- 2 and (for example) u <- 3 works.
Can you help me spot the mistake?
It seems to be a vectorization problem in the integrand input u. If I understand correctly, PSI should be a number for each calculation and not a vector of numbers (which will give a dimensional problem between PSI and PHI. Hence
integrand <- Vectorize(integrand)
should resolve your issue. From ?integrate:
f must accept a vector of inputs and produce a vector of function evaluations at those points.
However, this leads to a different error.
pdfSRP(p = 2)
## Error in integrate(f = integrand, lower = -Inf, upper = Inf) :
## the integral is probably divergent
If we plot the integrand, we may spot the divergence problem
p <- 2
par(mfrow = c(1,2))
curve(integrand,-1e3,1e3,n = 100)
curve(integrand,-1e3,1e3,n = 1e3)
Assuming the integrand converges sufficiently fast to zero in both tails, the divergence of the integral could be a result from numerical imprecision. We can increase precision by increasing the number of subintervals for the integral, which does give a result - I suppose, as expected by heuristically looking at the plot.
pdfSRP <- function (p) {
int <- integrate(f = integrand, lower = -Inf, upper = Inf,
subdivisions = 1e3)
int$value/(2*pi)
}
## [1] 2.482281e-06
I was playing around with the nlsLM function, from the minpack.lm library, and encountered some behaviour that I don't understand.
Given that the following function produces output when I supply a numeric vector 'b' as input I wanted to use this function to fit a nonlinear model to my data.
volEquation <- function(DBH, PHt, b){
b[1] * DBH^b[2] * PHt^b[3]
}
However I have become stuck when it comes to correctly specifying the initial parameter values. R code follows:
library(minpack.lm)
n <- 20
x <- seq(12, 60, length.out = n)
y <- seq(22, 45, length.out = n)
z <- x^2 * y ^ 3 + rnorm(n, 0, 0.1)
Data <- data.frame(DBH = x, PHt = y, TVT = z)
nlsFormula <- "TVT ~ volEquation(DBH, PHt, b)"
nlsInitial <- list(b = c(0.5, 2.25, 3.25))
nlsLMOutput <- nlsLM(formula = nlsFormula, data = Data, start = nlsInitial)
nlsOutput <- nls(formula = nlsFormula, data = Data, start = nlsInitial
nls was successful at fitting the data while nlsLM gave me this error message,
Error in rownames<-(*tmp*, value = "b") :
length of 'dimnames' [1] not equal to array extent
Can anyone provide insight as to why this problem occurs in the nlsLM function? I've tried sifting through the nlsLM code but I still don't understand what's going on.
Try separating your parameters
volEquation <- function(DBH, PHt, x,y,z){
x * DBH^y * PHt^z
}
nlsFormula <- "TVT ~ volEquation(DBH, PHt, x, y, z)"
nlsInitial <- c(x=5e-3, y=2, z=1)
nlsOutput <- nlsLM(formula = nlsFormula, data = Data, start = nlsInitial, control=nls.lm.control(maxiter=100))