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))))
Related
I am new to R and trying to understand this function call below:
mle_mos <- function (n, m1, m2, x, x1, x2, initial, iters)
mvnewton (function (p) log_likelihood_gradient(p,n,m1,m2,x,x1,x2),
function (p) -fisher_information(p,n,m1,m2,x,x1,x2),
initial, iters)
mvnewton <- function (f, g, x, n)
{
print(f)
if (n < 1)
stop("invalid number of iterations")
for (i in 1:n) {
cat("\nAt iteration",i,":\n\n")
cat("x =",x,"\n")
cat("f(x) =",f(x),"\n")
cat("g(x) =\n")
print(g(x));
x <- x - solve(g(x),f(x)) # computes inverse of g(x) times
f(x)
}
x
}
mvnnewton takes
(function (p) log_likelihood_gradient(p,n,m1,m2,x,x1,x2)
as the first parameter. Where is p getting it's value from? Where is it defined? Can someone explain where p is getting a value to be passed into log_likelihood_gradient as a parameter? I have been googling for the past 2 days and reading up a lot of stuff but am still not clear that I understand this properly.
Arguments
If we have a function fun
fun <- function(z) z+1
and then we call it
fun(1)
1 is said to be the actual argument and z is said to be the formal argument. The formal argument takes on the value of the actual argument so z takes on the value 1. (There are some technicalities which we have glossed over but these do not affect the situation in the question.)
mvnewton
When mvnewton is called the caller passes to it four actual arguments:
function (p) log_likelihood_gradient(p,n,m1,m2,x,x1,x2)
function (p) -fisher_information(p,n,m1,m2,x,x1,x2)
initial
iters
Note that the first two arguments are functions. It does not pass the result of calling the functions but passes the functions themselves.
Now within mvnewton these 4 actual arguments correspond to the formal arguments f, g, x and n so when mvnewton refers to f it is really referring to
function (p) log_likelihood_gradient(p,n,m1,m2,x,x1,x2)
Also within mvnewton the function f is called with actual argument x and x corresponds to formal argument p within f (and similarly for g).
Example
For example, suppose we call
f <- function(x) x^2
g <- function(x) 2*x
mvnewton(f, g, 1, 20)
Then x is 1 and the first time f(x) and g(x) are called within mvnewton they are called as f(1) and g(1) and within f and g the formal argument p takes the value 1. mvnewton then updates x to a new value, calls f and g again with the new value of x and so on.
I am currently trying to implement a bigger simulation exercise but i'm stuck with this bit.
The aim is to find the vector p* (2x1) that maximizes this function (p* = argmax of h):
Equation
Also Y and q are given and all other quantities in the function are defined using them.
P_priority_i <- function(unknown, arg1, arg2, i){
mu = 2
delta = 0.00001
c <- c(pbar[i,] + rep(delta,m))
e <- rep(0,2)
s <- rep(0,2)
for (j in 1:m){
e[j] <- x[i,j] + sum(A[[j]][i,]*min(pbar[i,j],arg1[i,j]))
}
if(y[i,'countries'] != 'IT'){
s[1] <- min(pbar[i,1],(max(0,sum(arg2*e)))/arg2[1])
s[2] <- min(pbar[i,2],(max(0,sum(arg2*e)-arg2[1]*s[1]))/arg2[2])
value <- -0.5*t(c-unknown)%*%diag(arg2/(c-s))%*%(c-unknown)
return(value)
} else {
s[2] <- min(pbar[i,2],(max(0,sum(arg2*e)))/arg2[2])
s[1] <- min(pbar[i,1],(max(0,sum(arg2*e)-arg2[2]*s[2]))/arg2[1])
value <- -0.5*t(c-unknown)%*%diag(arg2/(c-s))%*%(c-unknown)
return(value)
}}
I've checked the formulation of the function, whose output is a scalar, and it is correct.
I also have 3 constraints on p*:
Constraints
where \bar{p} and x are given quantities.
I've found quadprog package but I don't know how to solve this particular problem using solve.QP function () which supposes an objective function as (− d^T b + 0.5 b^T D b). The problem is that the argument of my maximization should be p and not (c-p) (also the constrains are formulated w.r.t p).
How can i set up this in R?
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
So, I have this function;
f <- function(a, b, q=1, f0=1000) {
#calculate R:
R <- (f0 - (a*b))*((q+1)/(a^(q+1)))
return(ifelse(a<=100,(R * a^q) + b, 0)) }
I am using it in another function, funk2
funk2 <- function(a,x,b,l,r) {
f(a-x,b) * exp(-(l/r)*(exp(-r*a)*(exp(r*x)-1))) }
funk2 is then used to evaluate another multi-variable function funk1 using integration;
funk1 <- function(x,b,l,r) {
sapply(x, function (s) {
integrate(funk2, lower = s, upper = s+56, x=s, b=b, l=l, r=r)$value }) }
when I try to evaluate funk1
funk1(10,100,1,1)
{or by putting any other values} I get an error saying that
Error in integrate(funk2, lower = s, upper = s + 100, x = s, b = b,
non-finite function value
I am not sure what am I doing wrong here? Please help!
Thanks in advance.
The problem is in f(a-x,b) inside funk2 when a is equal to x then f(0,b) will produce NaN. For example, if you modify your lower to lower = s*1.01 you get:
funk1(10,100,1,1)
[1] 4464.721
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.