Likelihood maximization in R - r

In R, I wrote a log-likelihood function containing two recursive calculation. The log-likelihood function works properly (it gives answer for known values of parameters), but when I try to maximize it using optim(), it takes too much time. How can I optimize the code? Thanks in advance for ideas.
This is the log-likelihood function for a markov regime switching model with a dependence structure using copula functions.
Named g in the for loop:
Named p in the for loop:
Named f in the codes:
Some data:
u <- cbind(rt(100,10),rt(100,13))
f function:
f=function(u,p,e1,e2){
s=diag(2);s[1,2]=p
ff=dcopula.gauss(cbind(pt(u[,1],e1),pt(u[,2],e2)),Sigma=s)*dt(u[,1],e1)*dt(u[,2],e2)
return(ff)
}
log-likelihood function:
loglik=function(x){
p11<-x[1];p12<-x[2];p21<-x[3];p22<-x[4];p31<-x[5];p32<-x[6];r<-x[7];a1<-x[8];a2<-x[9];s<-x[10];b1<-x[11];b2<-x[12];t<-x[13];c1<-x[14];c2<-x[15]
p1=c(numeric(nrow(u)));p2=c(numeric(nrow(u)));p3=c(numeric(nrow(u)))
g=c(numeric(nrow(u)))
p1_0=.3
p2_0=.3
g[1]<-(p1_0*f(u,r,a1,a2)[1])+(p2_0*f(u,s,b1,b2)[1])+((1-(p1_0+p2_0))*f(u,t,c1,c2)[1])
p1[1]<-((p1_0*p11*f(u,r,a1,a2)[1])+(p2_0*p21*f(u,r,a1,a2)[1])+((1-(p1_0+p2_0))*p31*f(u,r,a1,a2)[1]))/g[1]
p2[1]<-((p1_0*p12*f(u,s,b1,b2)[1])+(p2_0*p22*f(u,s,b1,b2)[1])+((1-(p1_0+p2_0))*p32*f(u,s,b1,b2)[1]))/g[1]
p3[1]<-((p1_0*(1-(p11+p12))*f(u,t,c1,c2)[1])+(p2_0*(1-(p21+p22))*f(u,t,c1,c2)[1])+((1-(p1_0+p2_0))*(1-(p31+p32))*f(u,t,c1,c2)[1]))/g[1]
for(i in 2:nrow(u)){
g[i]<-(p1[i-1]*p11*f(u,r,a1,a2)[i])+(p1[i-1]*p12*f(u,s,b1,b2)[i])+(p1[i-1]*(1-(p11+p12))*f(u,t,c1,c2)[i])+
(p2[i-1]*p21*f(u,r,a1,a2)[i])+(p2[i-1]*p22*f(u,s,b1,b2)[i])+(p2[i-1]*(1-(p21+p22))*f(u,t,c1,c2)[i])+
(p3[i-1]*p31*f(u,r,a1,a2)[i])+(p3[i-1]*p32*f(u,s,b1,b2)[i])+(p3[i-1]*(1-(p31+p32))*f(u,t,c1,c2)[i])
p1[i]<-((p1[i-1]*p11*f(u,r,a1,a2)[i])+(p1[i-1]*p12*f(u,s,b1,b2)[i])+(p1[i-1]*(1-(p11+p12))*f(u,t,c1,c2)[i]))/g[i]
p2[i]<-((p2[i-1]*p21*f(u,r,a1,a2)[i])+(p2[i-1]*p22*f(u,s,b1,b2)[i])+(p2[i-1]*(1-(p21+p22))*f(u,t,c1,c2)[i]))/g[i]
p3[i]<-((p3[i-1]*p31*f(u,r,a1,a2)[i])+(p3[i-1]*p32*f(u,s,b1,b2)[i])+(p3[i-1]*(1-(p31+p32))*f(u,t,c1,c2)[i]))/g[i]
}
return(-sum(log(g)))
}
Optimization:
library(QRM)
library(copula)
start=list(0,1,0,0,0,0,1,9,7,-1,10,13,1,6,4)
##
optim(start,loglik,lower=c(rep(0,6),-1,1,1,-1,1,1,-1,1,1),
upper=c(rep(1,6),1,Inf,Inf,1,Inf,Inf,1,Inf,Inf),
method="L-BFGS-B") -> fit

This looks like a question for Stack-Overflow.
Something that springs to my mind is:
Define a vector containing the values f(.,.,.,.) in order to avoid doing k*nrow(u) evaluations of the same function and simply call those entries of interest.
It seems like the loop could be replaced by matrix and/or vector products. However, without further information it is unclear what the code is doing and it would take eons to extract this information from the code.

Related

optim in R when the function to minimize depends implicitely on the parameters to adjust

I am trying to use the optim function in R to match theoretical data with experimental data.
Basically, I have a function f which computes an output (say a matrix), depending on some parameters defined outside that function. For example, simplifying for clarity:
a=0.2
b=-5
c=9
f=function(dx,Xmax){
Nx=round(Xmax/dx) #Nb of columns
out=matrix(0,2,Nx) #Matrix initialization
for (i in 1:Nx){
out[1,i]=(a^2*dx*i)/b #random example
out[2,i]=(c*(dx*i)^2-b)/a #random example
}
return(out)
}
result=f(0.1,10)
(The actual function f calls lots of functions outside, which use the parameters say a,b,c).
I have some experimental datas for some values of x, say (random again)
expr=data.frame(x=c(0,2,5,7),y=c(1,8,14,23))
I would like to use optim to adjust parameters a,b,c such that the function
WLS=function(theo,expr){
#theo is extracted from the output of f
out=sum((theo-y)/theo)^2) #weighted least squares
}
is minimized, where theo is given by function f for x related to expr (as the experimental data are for some values on x only)
The issue here is, from all the examples of optim I saw, the function to minimize (here WLS) must contain the parameters to vary as an argument. Is my only option is to insert a,b,c into the arguments of f (so we would have f=function(dt,Xmax,a,b,c)), then having something like for WLS
WLS=function(expr,param){
theo=f(dt,Xmax,param[1],param[2],param[3])
#then extract the values of theo for only the x I am interested in (not written here) and plugged
#into theo again
out=sum((theo-y)/theo)^2) #weighted least squares
}
Or are there better ways to deal with that problem?
Thanks in adavance

Computing ECDF of a data for parameter estimation using weighted nonlinear least square in R

I am writing a code for estimating the parameter of a GPD using weighted nonlinear least square(WNLS) method.
The WNLS method consist of 2 steps
step 1: $(\hat{\xi_1} , \hat{b_1}) = arg\ \min_{(\xi,b)} \sum_{i=1}^{n} [\log(1-F_n(x_i)) - log(1-G_{\xi,b}(x_i))]$,
here $F_n$ is the ECDF and $1-G_{\xi,b}$ is the generalized pareto distribution.
Can anyone let me know how to calculate EDF function $F_n$ for a data "X" in R?
Does ecdf(X)(X) will calculate the ECDF? If so then, what is the need for ecdf(X) other than plotting? Also it would be really helpful if someone share some example code which involves the calculation of ECDF for data.
The ecdf call creates a function. That is, you can apply ecdf(X) to other data, as your ecdf(X)(X) call does. However, you might want to apply ecdf(X) to something other than X itself. If you want to know the empirical quantile to which three numbers a, b, and c_ correspond, an easy way to do that is to call ecdf(X)(c(a, b, c_)).

Two calculation formulas of density (pdf) of a bivariate normal distribution returning different results

With the code I’m calculating the density of a bivariate normal distribution. Here I use two formulas which should return the same result.
The first formula uses the dmvnorm of the mvtnorm package and the second formula uses the formula from Wikipedia (https://en.wikipedia.org/wiki/Multivariate_normal_distribution).
When the standard deviation of both distributions equals one (the covariance matrix has only ones on primary diagonal), the results are the same. But when you vary the two entries in the covariance matrix to two or one third… the results aren’t both identical.
(I hope) I have read the help properly and also this document (https://cran.r-project.org/web/packages/mvtnorm/vignettes/MVT_Rnews.pdf).
Here on stackoverflow (How to calculate multivariate normal distribution function in R) I found this because perhaps my covariance matrix is wrong defined.
But until now I couldn’t find an answer…
So my question: Why is my code returning different results when the standard deviation not equals one?
I hope I gave enough information... but when something is missing please comment. I will edit my question.
Many thanks in advance!
And now my code:
library(mvtnorm) # for loading the package if necessary
mu=c(0,0)
rho=0
sigma=c(1,1) # the standard deviation which should be changed to two or one third or… to see the different results
S=matrix(c(sigma[1],0,0,sigma[2]),ncol=2,byrow=TRUE)
x=rmvnorm(n=100,mean=mu,sigma=S)
dim(x) # for control
x[1:5,] # for visualization
# defining a function
Comparison=function(Points=x,mean=mu,sigma=S,quantity=4) {
for (i in 1:quantity) {
print(paste0("The ",i," random point"))
print(Points[i,])
print("The following two results should be the same")
print("Result from the function 'dmvnorm' out of package 'mvtnorm'")
print(dmvnorm(Points[i,],mean=mu,sigma=sigma,log=FALSE))
print("Result from equation out of wikipedia")
print(1/(2*pi*S[1,1]*S[2,2]*(1-rho^2)^(1/2))*exp((-1)/(2*(1-rho^2))*(Points[i,1]^2/S[1,1]^2+Points[i,2]^2/S[2,2]^2-(2*rho*Points[i,1]*Points[i,2])/(S[1,1]*S[2,2]))))
print("----")
print("----")
} # end for-loop
} # end function
# execute the function and compare the results
Comparison(Points=x,mean=mu,sigma=S,quantity=4)
Remember that S is the variance-covariance matrix. The formula you use from Wikipedia uses the standard deviation and not the variance. Hence you need to plug in the square root of the diagonal entries into the formula. This is also the reason why it works when you choose 1 as the diagonal entries (both the variance and the SD is 1).
See your modified code below:
library(mvtnorm) # for loading the package if necessary
mu=c(0,0)
rho=0
sigma=c(2,1) # the standard deviation which should be changed to two or one third or… to see the different results
S=matrix(c(sigma[1],0,0,sigma[2]),ncol=2,byrow=TRUE)
x=rmvnorm(n=100,mean=mu,sigma=S)
dim(x) # for control
x[1:5,] # for visualization
# defining a function
Comparison=function(Points=x,mean=mu,sigma=S,quantity=4) {
for (i in 1:quantity) {
print(paste0("The ",i," random point"))
print(Points[i,])
print("The following two results should be the same")
print("Result from the function 'dmvnorm' out of package 'mvtnorm'")
print(dmvnorm(Points[i,],mean=mu,sigma=sigma,log=FALSE))
print("Result from equation out of wikipedia")
SS <- sqrt(S)
print(1/(2*pi*SS[1,1]*SS[2,2]*(1-rho^2)^(1/2))*exp((-1)/(2*(1-rho^2))*(Points[i,1]^2/SS[1,1]^2+Points[i,2]^2/SS[2,2]^2-(2*rho*Points[i,1]*Points[i,2])/(SS[1,1]*SS[2,2]))))
print("----")
print("----")
} # end for-loop
} # end function
# execute the function and compare the results
Comparison(Points=x,mean=mu,sigma=S,quantity=4)
So your comment when you define sigma is not correct. In your code, sigma is the variances, not the standard deviations if you judge by how you construct S.

R function for Likelihood

I'm trying to analyze repairable systems reliability using growth models.
I have already fitted a Crow-Amsaa model but I wonder if there is any package or any code for fitting a Generalized Renewal Process (Kijima Model I) or type II
in R and find it's parameters Beta, Lambda(or alpha) and q.
(or some other model for the mean cumulative function MCF)
The equation number 15 of this article gives an expression for the
Log-likelihood
I tried to create the function like this:
likelihood.G1=function(theta,x){
# x is a vector with the failure times, theta vector of parameters
a=theta[1] #Alpha
b=theta[2] #Beta
q=theta[3] #q
logl2=log(b/a) # First part of the equation
for (i in 1:length(x)){
logl2=logl2 +(b-1)*log(x[i]/(a*(1+q)^(i-1))) -(x[i]/(a*(1+q)^(i-1)))^b
}
return(-logl2) #Negavite of the log-likelihood
}
And then use some rutine for minimize the -Log(L)
theta=c(0.5,1.2,0.8) #Start parameters (lambda,beta,q)
nlm(likelihood.G1,theta, x=Data)
Or also
optim(theta,likelihood.G1,method="BFGS",x=Data)
However it seems to be some mistake, since the parameters it returns has no sense
Any ideas of what I'm doing wrong?
Thanks
Looking at equation (16) of the paper you reference and comparing it with your code it looks like you are missing one term in the for loop. It seems that each data point contributes to three terms of the log-likelihood but in your code (inside the loop) you only have two terms (not considering the updating term)
Specifically, your code does not include the 4th term in equation (16):
and neither it does the 7th term, and so on. This is at least one error in the code. An extra consideration would be that α and β are constrained to be greater than zero. I am not sure if the solver you are using is considering this constraint.

Find the second derivative of a log likelihood function

I'm interested in finding the values of the second derivatives of the log-likelihood function for logistic regression with respect to all of my m predictor variables.
Essentially I want to make a vector of m ∂2L/∂βj2 values where j goes from 1 to m.
I believe the second derivative should be -Σi=1n xij2(exiβ)/((1+exiβ)2) and I am trying to code it in R. I did something dumb when trying to code it and was wondering if there was some sort of sapply function I could use to do it more easily.
Here's the code I tried (I know the sum in the for loop doesn't really do anything, so I wasn't sure how to sum those values).
for (j in 1:m)
{
for (i in 1:n)
{
d2.l[j] <- -1*(sum((x.center[i,j]^2)*(exp(logit[i])/((1 + exp(logit[i])^2)))))
}
}
And logit is just a vector consisting of Xβ if that's not clear.
I'm hazy on the maths (and it's hard to read latex) but purely on the programming side, if logit is a vector with indices i=1,...,n and x.center is a nxm matrix:
for (j in 1:m)
dt.l[j] <- -sum( x.center[,j]^2 * exp(logit)/(1+exp(logit))^2 )
where the sum sums over i.
If you want to do it "vector-ish", you can take advantage of the fact that if you do matrix * vector (your x.center * exp(logit)/...) this happens column-wise in R which suits your equation:
-colSums(x.center^2 * exp(logit)/(1+exp(logit))^2)
For what it's worth, although the latter is "slicker", I will often use the explicit loop (as with the first example), purely for readability. Or else when I come back in a month's time I get very confused about my is and js and what is being summed over when.

Resources