I am trying to estimate the below log function using maximum likelihood method in R, but I get the following error:
Error in optim(start, f, method = method, hessian = TRUE, ...) : objective function in optim evaluates to length 10 not 1
My attempt was as follows:
Generating data
set.seed(101)
n <- 10
u <- runif(n)
theta1 <- 1
lamba1 <- 0.5
Generating PTIR data using quantile function
x <- function(u, theta1, lamba1) {
(-theta1/(log((1+lamba1)-sqrt((1+lamba1)^2-(4*lamba1*u)))/(2*lamba1)))^(1/(2))
}
x <- x(u = u, theta1 = theta1, lamba1 = lamba1)
Declaring the Log-Likelihood function
LL <- function(theta, lamba) {
R = suppressWarnings((n*log(2))+
(n*log(theta))-(((2)+1)*sum(log(x)))-
(sum(theta/(x^(2))))+
(log(1+lamba-(2*lamba*exp(-theta/(x^(2)))))))
return(-R)
}
mle(LL, start = list(theta = 5, lamba=0.5))
Any advice would be greatly appreciated.
I don't know how to fix your problem, but hopefully I can help you diagnose it. As #KonradRudolph suggests in comments, This may be a case where the usual advice "add more parentheses if you're not sure" may do more harm than good ... I've rewritten your function in a way that matches what you've got above, but has fewer parentheses and more consistent line breaking/indentation. Every line below is a separate additive term. Your specific problem is that the last term involves x (which has length 10 in this case), but is not summed, so the return value ends up being a length-10 vector.
LL2 <- function(theta, lambda) {
R <- n*log(2)+
n*log(theta)-
((2)+1)*sum(log(x))-
sum(theta/(x^2))+
log(1+lambda-(2*lambda*exp(-theta/x^2)))
return(-R)
}
all.equal(LL(1,1),LL2(1,1)) ## TRUE
length(LL2(1,1)) ## 10
Related
I'm trying to compute a kind of Gini index using a generated dataset.
But, I got a problem in the last integrate function.
If I try to integrate the function named f1,
R says
Error in integrate(Q, 0, p) : length(upper) == 1 is not TRUE
My code is
# set up parameters b>a>1 and the number of observations n
n <- 1000
a <- 2
b <- 4
# generate x and y
# where x follows beta distribution
# y = 10x+3
x <- rbeta(n,a,b)
y <- 10*x+3
# the starting point of the integration having problem
Q <- function(q) {
quantile(y,q)
}
# integrate the function Q from 0 to p
G <- function(p) {
integrate(Q,0,p)
}
# compute a function
L <- function(p) {
numer <- G(p)$value
dino <- G(1)$value
numer/dino
}
# the part having problem
d <- 3
f1 <- function(p) {
((1-p)^(d-2))*L(p)
}
integrate(f1,0,1) # In this integration, the aforementioned error appears
I think, the repeated integrate could make a problem but I have no idea what is the exact problem.
Please help me!
As mentioned by #John Coleman, integrate needs to have a vectorized function and a proper subdivisions option to fulfill the integral task. Even if you have already provided a vectorized function for integral, it is sometimes tricky to properly set the subdivisions in integrate(...,subdivisions = ).
To address your problem, I recommend integral from package pracma, where you still a vectorized function for integral (see what I have done to functions G and L), but no need to set subdivisions manually, i.e.,
library(pracma)
# set up parameters b>a>1 and the number of observations n
n <- 1000
a <- 2
b <- 4
# generate x and y
# where x follows beta distribution
# y = 10x+3
x <- rbeta(n,a,b)
y <- 10*x+3
# the starting point of the integration having problem
Q <- function(q) {
quantile(y,q)
}
# integrate the function Q from 0 to p
G <- function(p) {
integral(Q,0,p)
}
# compute a function
L <- function(p) {
numer <- Vectorize(G)(p)
dino <- G(1)
numer/dino
}
# the part having problem
d <- 3
f1 <- function(p) {
((1-p)^(d-2))*L(p)
}
res <- integral(f1,0,1)
then you will get
> res
[1] 0.1283569
The error that you reported is due to the fact that the function in integrate must be vectorized and integrate itself isn't vectorized.
From the help (?integrate):
f must accept a vector of inputs and produce a vector of function
evaluations at those points. The Vectorize function may be helpful to
convert f to this form.
Thus one "fix" is to replace your definition of f1 by:
f1 <- Vectorize(function(p) {
((1-p)^(d-2))*L(p)
})
But when I run the resulting code I always get:
Error in integrate(Q, 0, p) : maximum number of subdivisions reached
A solution might be to assemble a large number of quantiles and then smooth it out and use that rather than your Q, although the error here strikes me as odd.
So im trying to solve an equation that have 3 unknown factor. I decided to use nlm.
I defined my function F that take 3 parameters that are put in a vector, and what im trying to find is the vetor X that verify the following equation :
F(X)-F(X1)-F(X2)-F(X3)=0
so I applied nlm to the LHS. but i get some weird results, instead of having a solution that make the LHS close to zero, it give solution that make the LHS converge to -infinite
Can anyone point me to the right direction.
Thank you all in advance :)
rm(list=ls())
Ta <- 30 #commun parameter
c <- 0.09 #commun parameter
Delta_T <- c( 10, 20, 30 ) #vector containing X1(1), X2(1) and X3(1)
tetha <- c( 0.9, 1.1, 1.5 ) #vector containing X1(2), X2(2) and X3(2)
t <- c( 300, 400, 100 )
N <- t/tetha #vector containing X1(3), X2(3) and X3(3)
F <- function(X){ #definition of function F
x <- X[1]
y <- X[2]
N <- X[3]
N*(min(c(y,2))/2)^1/3*x^1.9*exp(-1414/(x+Ta+273))*(1+c*(x/20)^2.1*(2/min(y,2))^1/3)
}
S <- vector("numeric",length(t)) #creation of F(X1) F(X2) and F(X3)
for (i in 1:length(t)) {
S[i]=F(c(Delta_T[i],tetha[i],N[i]))
}
Eq <- function(X){ #creation of F(X)-F(X1)-F(X2)-F(X3)
F(X)-sum(S)}
p <- c(min(Delta_T),min(tetha),min(N))
Sol = nlm(Eq,p)
EDIT : so I found the solution to the problem, instead of writing
Eq <- function(X){ #creation of F(X)-F(X1)-F(X2)-F(X3)
F(X)-sum(S)}
I applied abs() to the function Eq
Eq <- function(X){ #creation of F(X)-F(X1)-F(X2)-F(X3)
abs(F(X)-sum(S)) }
I dont get satisfying results doe, the error is close to 0 but X[2] is way bigger then 2 because of the min(2,X[2])
So i found the solution to this problem, instead of using the function nlm to solve my non linear equation, I used the function auglag from the package nloptr.
Eq <- function(X){ #creation of F(X)-F(X1)-F(X2)-F(X3)
F(X)-sum(S)}
p <- c(min(Delta_T),min(tetha),min(N))
Sol = auglag(p,Eq,hin = Eq)
auglag is a very strong non linear optimization algorithme. And the results are very satisfying as i get an error 10e-7
So I have a system of ode's and some data I am using the R packages deSolve and FME to fit the parameters of the ode system to data. I am getting a singular matrix result when I fit the full parameter set to the data. So I went back and looked at the collinearity of the parameters using a collinearity index cut-off of 20 as suggested in all the FME package documentation I then picked a few models with subsets of parameters to fit. Then when I run modFit I get this error:
Error in approx(xMod, yMod, xout = xDat) :
need at least two non-NA values to interpolate
Can anyone enlighten me as to a fix for this. Everything else is working fine. So this is not a coding problem.
Here is a minimal working example (removing r=2 in modFit creates the error which I can fix in the minimal working example but not in my actual problem so I doubt a minimal working example helps here):
`## =======================================================================
## Now suppose we do not know K and r and they are to be fitted...
## The "observations" are the analytical solution
## =======================================================================
# You need these packages
library('deSolve')
library('FME')
## logistic growth model
TT <- seq(1, 100, 2.5)
N0 <- 0.1
r <- 0.5
K <- 100
## analytical solution
Ana <- cbind(time = TT, N = K/(1 + (K/N0 - 1) * exp(-r*TT)))
time <- 0:100
parms <- c(r = r, K = K)
x <- c(N = N0)
logist <- function(t, x, parms) {
with(as.list(parms), {
dx <- r * x[1] * (1 - x[1]/K)
list(dx)
})
}
## Run the model with initial guess: K = 10, r = 2
parms["K"] <- 10
parms["r"] <- 2
init <- ode(x, time, logist, parms)
## FITTING algorithm uses modFit
## First define the objective function (model cost) to be minimised
## more general: using modFit
Cost <- function(P) {
parms["K"] <- P[1]
parms["r"] <- P[2]
out <- ode(x, time, logist, parms)
return(modCost(out, Ana))
}
(Fit<-modFit(p = c(K = 10,r=2), f = Cost))
summary(Fit)`
I think the problem is in your Cost function. If you don't provide both K and r, then the cost function will override the start value of r to NA. You can test this:
Cost <- function(P) {
parms["K"] <- P[1]
parms["r"] <- P[2]
print(parms)
#out <- ode(x, time, logist, parms)
#return(modCost(out, Ana))
}
Cost(c(K=10, r = 2))
Cost(c(K=10))
This function works:
Cost <- function(P) {
parms[names(P)] <- P
out <- ode(x, time, logist, parms)
return(modCost(out, Ana))
}
The vignette FMEDyna is very helpful: https://cran.r-project.org/web/packages/FME/vignettes/FMEdyna.pdf See page 14 on how to specify the Objective (Cost) function.
I'm working on a problem where a parameter is estimated through minimizing the sum of squares. The equations needed are:
I used optim in the package stats:
# provide the values for a test dataset (the y estimated should be 1.41)
pvector <- c(0.0036,0.0156,0.0204,0.0325,0.1096,0.1446,0.1843,0.4518)
zobs <- c(0.0971,0.0914,0.1629,0.1623,0.3840,0.5155,0.3648,0.6639)
# make input of the C value
c <- function(y){
gamma(y)/((gamma(y*(1-pvector)))*(gamma(y*pvector)))
}
# make input of the gamma function
F1 <- function(y){
f1 <- function(x){
c*(1-x)^(y*(1-pvector)-1)*x^(y*pvector-1)
}
return (f1)
}
# integration over x
int <- function(y){
integrate (F1(y),lower =0.001, upper =1)
}
# write the function for minimization
f2 <- function(y) {
sum ((int-zobs)^2)
}
# minimization
optim(0.01,f2, method = "Brent", lower =0, upper = 1000, hessian=TRUE)
Which didn't work. I received the following error message:
Error in int - zobs : non-numeric argument to binary operator
I think there must be something fundamentally wrong with the way how the function was written.
This is my code. The kum.loglik function returns negative loglikelihood and takes two arguments a and b. I need to find a and b that minimize this function using optim function. (n1,n2,n3 is pre-specified and passed to optim function.
kum.loglik = function(a, b, n1, n2, n3) {
loglik = n1*log(b*beta(1+2/a,b)) + n2 * log(b*beta(1+2/a,b)-2*b*beta(1+1/a,b)+1) +
n3 * log(b*beta(1+1/a,b)-b*beta(1+2/a,b))
return(-loglik)
}
optim(par=c(1,1), kum.loglik, method="L-BFGS-B",
n1=n1, n2=n2, n3=n3,
control=list(ndeps=c(5e-4,5e-4)))
This code should work well but it gives error message
Error in b * beta(1 + 2/a, b) : 'b' is missing
What is wrong in this code?
The problem is (straight from the optim help):
fn: A function to be minimized (or maximized), with first
argument the vector of parameters over which minimization is
to take place.
Your kum.loglik function needs to take a vector v which you pull the parameters out of, e.g.:
kum.loglik=function(v) { a = v[1]; b = v[2]; ...}
I always use the following, it gives you the best results
p0 <- c(a,b) #example vector of starting values
m <- optim(p0, loglik, method="BFGS", control=list(fnscale=-1, trace=10),
hessian=TRUE, x=data.frame)
#for table of results
rbind(m$par, sqrt(diag(solve(-m$hessian))))