I have read the maxLik document on how to do constrained optimization. However, I do not understand how I can do it. I have a custom likelihood function as below. The value of rho should be between 0 and 1 (making that two constraints). Now how exactly do I put those constraints? I have 3 parameters.
I have seen an almost similar question here with 3 constraints and 3 parameters but I am really a novice and do not understand the proposed hints on how to include the constraints ? how to use maxLik() to do the constrained optimization in R
require(maxLik)
data<- matrix(rnorm(3600,5,1),ncol=20)
Y=data[,c(1:20)]
Y <- as.matrix(Y, ncol=20)
p=4
T=nrow(Y)
X <- Y[p:(T-1),1:4]
unos <- rep(1,T)
X <- cbind(unos, X)
set.seed(101)
loglik <- function(theta) {
eta <- theta[1]
n <- theta[2]
rho <- theta[3]
coefis=as.matrix(c(mu0=0.0112, mu1=0.0115, mu2=0.009, mu3=0.021,
mu4=0.01237),ncol=1) #coefficients for the intercept and four lags
resi= Y- X%*%coefis
y <- Custom_lik(resi, eta, n, rho, T) #my custom likelihood function
return(-y[[1]])
}
m <- maxLik(loglik, start=c(eta=1.1, n=1.5, rho=0.5))
Related
I want compute a null model,saturated model and a proposed model for a poisson regression by hand. For that i designed a loglikelihood function and optimize it with the optim function. It worked well for the null and the proposed model. For the computation of the coefficients of the saturatetd model i get an error : "Error in beta %*% t(x) : non-conformable arguments". I know what the error means (dimensions of the matrices doesn't fit) but i dont know how to fix it, maybe you can help.
data <- as.data.frame(warpbreaks)
# Function for loglikelihood
LogLike <- function(y,x, par) {
beta <- par
# the deterministic part of the model:
lambda <- exp(beta%*%t(x))
# and here comes the negative log-likelihood of the whole dataset, given the
# model:
LL <- -sum(dpois(y, lambda, log = TRUE))
return(LL)
}
formula <- breaks~wool+tension
form <- formula(formula)
# dataFrame
model <- model.frame(formula, data = data)
# Designmatrix for proposed modell
x <- model.matrix(formula,data = data)
# Response Variable
y <- model.response(model)
# modelMatrix for null Modell
x1 <- as.matrix(x[,1])
# Computation Koef nullmodell
par1 <- rep(0,1)
koef <- round(optim(par=par1,fn=LogLike,x=x1,y=y)$par,4)
koef
# Computation koef proposed Modell
par2 <- rep(0,ncol(x))
koef2 <- round(optim(par=par2,fn=LogLike,x=x,y=y)$par,4)
koef2
# Computation koef saturated Modell
par3<- rep(0,length(y))
koef3 <- round(optim(par=par3,fn=LogLike,x=x,y=y)$par,4)
koef3
A saturated model is a model that have a many parameters as data points. You need to build such a x matrix and everything should work. So far, x is a 54x4 matrix while it should be a 54x54.
--- Advice (FWIW)
Avoid using functions' names as variables (beta and par in your case).
Hope this helps.
I need to fit x-y data with a model, which is non-analytic. I have a function f(x) that calculates the model for each x numerically, but there is no analytical equation. For the fit, I use optim in R. I minimise RMS between the model and the data. It works well and returns reasonable parameters.
I would like to find confidence intervals (or at least standard errors) on the best-fitting parameters. I found on internet that this can be done from the Hessian matrix, but only if maximising log-likelihood function. I don't know how to do this, all I have is x, y and f(x) from which I find RMS. Alas, I have no good way of estimating errors on y.
How can I find confidence intervals on my fit parameters?
Edit: perhaps an example in R might help explaining what I'm asking for. This example uses a simple analytic function to fit the data, in my real case the function is non-analytic, so I cannot use, e.g., nls.
set.seed(666)
# generate data
x <- seq(100) / 100
y <- 0.5 * x + rnorm(100, sd = 0.03) + 0.2
# function to fit
f <- function(x, a, b) {
a * x + b
}
# error function to minimise: RMS
errfun <- function(par, x, y) {
a <- par[1]
b <- par[2]
err <- sqrt(sum((f(x, a, b) - y)^2))
}
# use optim to fit the model to the data
par <- c(1, 0)
res <- optim(par, errfun, gr=NULL, x, y)
# best-fitting parameters
best_a <- res$par[1]
best_b <- res$par[2]
The best fitting parameters are a = 0.50 and b = 0.20. I need to find 95% confidence intervals on these.
This is a job for the bootstrap:
(1) create a large number of synthetic datasets x*. These are created by sampling from x with replacement the same number of data as were in x. For example, if your data is (1,2,3,4,5,6) an x* might be (5,2,4,4,2,3) (note that values might appear multiple times, or not at all because we are sampling with replacement)
(2) For each x*, calculate f(x*). If there are other parameters which don't depend on the data, don't change them. (so f(x,a,b,c) becomes f(x*,a,b,c) as long as a,b,c don't depend on x. Call these quantities f*.
(3) You can estimate anything you want from these f*. If you want the standard deviation of f(x), take the standard deviation of f*. If you want the 95% confidence interval, take the range from the 2.5 to the 97.5 percentiles of f*. More formally, if you want to estimate g(f(x)) you estimate it as g(f(x*)).
I should say this is a very practically-oriented explanation of the bootstrap. I have glossed over many theoretical details, but the bootstrap is near-universally applicable (basically as long as the thing you are trying to estimate actually exists, you are usually okay).
To apply this to the example you have given in your code:
x <- seq(100) / 100
y <- 0.5 * x + rnorm(100, sd = 0.03) + 0.2
# function to fit
f <- function(x, a, b) {
a * x + b
}
# error function to minimise: RMS
errfun <- function(par, x, y) {
a <- par[1]
b <- par[2]
err <- sqrt(sum((f(x, a, b) - y)^2))
}
# this is the part where we bootstrap
# use optim to fit the model to the data
best_a <- best_b <- numeric(10000)
for(i in 1:10000){
j <- sample(100,replace=TRUE)
x.boot <- x[j]; y.boot <- y[j]
par <- c(1, 0)
res <- optim(par, errfun, gr=NULL, x.boot, y.boot)
# best-fitting parameters
best_a[i] <- res$par[1]
best_b[i] <- res$par[2]
}
# now, we look at the *vector* best_a
# for example, if you want the standard deviation of a,
sd(best_a)
# or a 95% confidence interval for b,
quantile(best_b,c(0.025,0.975))
I would like to estimate the coefficients of a nonlinear model with a binary dependent variable. The nonlinearity arises because two regressors, A and B, depend on a subset of the dataset and on the two parameters lambda1 and lambda2 respectively:
y = alpha + beta1 * A(lambda1) + beta2 * B(lambda2) + delta * X + epsilon
where for each observation i, we have
Where a and Rs are variables in the data.frame. The regressor B(lambda2) is defined in a similar way.
Moreover, I need to include what in Stata are known as pweights, i.e. survey weights or sampling weights. For this reason, I'm working with the R package survey by Thomas Lumley.
First, I create a function for A (and B), i.e.:
A <- function(l1){
R <- as.matrix(data[,1:(80)])
a <- data[,169]
N = length(a)
var <- numeric(N)
for (i in 1:N) {
ai <- rep(a[i],a[i]-1) # vector of a(i)
k <- 1:(a[i]-1) # numbers from 1 to a(i)-1
num <- (ai-k)^l1
den <- sum((ai-k)^l1)
w <- num/den
w <- c(w,rep(0,dim(R)[2]-length(w)))
var[i] <- R[i,] %*% w
}
return(var)
}
B <- function(l2){
C <- as.matrix(data[,82:(161-1)])
a <- data[,169]
N = length(a)
var <- numeric(N)
for (i in 1:N) {
ai <- rep(a[i],a[i]-1) # vector of a(i)
k <- 1:(a[i]-1) # numbers from 1 to a(i)-1
num <- (ai-k)^l2
den <- sum((ai-k)^l2)
w <- num/den
w <- c(w,rep(0,dim(C)[2]-length(w)))
var[i] <- C[i,] %*% w
}
return(var)
}
But the problem is that I don't know how to include the nonlinear regressors in the model (or in the survey design, using the function svydesign):
d_test <- svydesign(id=~1, data = data, weights = ~data$hw0010)
Because, when I try to estimate the model:
# loglikelihood function:
LLsvy <- function(y, model, lambda1, lambda2){
aux1 <- y * log(pnorm(model))
aux2 <- (1-y) * log(1-pnorm(model))
LL <- (aux1) + (aux2)
return(LL)
}
fit <- svymle(loglike=LLsvy,
formulas=list(~y, model = ~ A(lambda1)+B(lambda2)+X,lambda1=~1,lambda2=~1),
design=d_test,
start=list(c(0,0,0,0),c(lambda1=11),c(lambda2=8)),
na.action="na.exclude")
I get the error message:
Error in eval(expr, envir, enclos) : object 'lambda1' not found
I think that the problem is in including the nonlinear part, because everything works fine if I fix A and B for some lambda1 and lambda2 (so that the model becomes linear):
lambda1=11
lambda2=8
data$A <- A(lambda1)
data$B <- B(lambda2)
d_test <- svydesign(id=~1, data = data, weights = ~data$hw0010)
LLsvylin <- function(y, model){
aux1 <- y * log(pnorm(model))
aux2 <- (1-y) * log(1-pnorm(model))
LL <- (aux1) + (aux2)
return(LL)
}
fitlin <- svymle(loglike=LLsvylin,
formulas=list(~y, model = ~A+B+X),
design=d_test,
start=list(0,0,0,0),
na.action="na.exclude")
On the contrary, if I don't use the sampling weights, I can easily estimate my nonlinear model using the function mle from package stats4 or the function mle2 from package bbmle.
To sum up,
how can I combine sampling weights (svymle) while estimating a nonlinear model (which I can do using mle or mle2)?
=========================================================================
A problem with the nonlinear part of the model arises also when using the function svyglm (with fixed lambda1 and lambda2, in order to get good starting values for svymle):
lambda1=11
lambda2=8
model0 = y ~ A(lambda1) + B(lambda2) + X
probit1 = svyglm(formula = model0,
data = data,
family = binomial(link=probit),
design = d_test)
Because I get the error message:
Error in svyglm.survey.design(formula = model0, data = data, family = binomial(link = probit), :
all variables must be in design= argument
This isn't what svymle does -- it's for generalised linear models, which have linear predictors and a potentially complicated likelihood or loss function. You want non-linear weighted least squares, with a simple loss function but complicated predictors.
There isn't an implementation of design-weighted nonlinear least squares in the survey package, probably because no-one has previously asked for one. You could try emailing the package author.
The upcoming version 4 of the survey package will have a function svynls, so if you know how to fit your model without sampling weights using nls you will be able to fit it with sampling weights.
So I used the rgl package and created my own likelihood function to output the log likelihood of a sample from a normal distribution. I was doing this really just to learn how to program this myself so I could better understand how likelihood works and also how MLE works. Anyways, I noticed something particularly strange and I wanted to know if someone knew the answer here. When I plot the graph, it comes out in a folded curve shape, but I supposed I was expecting more of a cone type shape. Basically, what im curious about is why when the plot peaks at the sigma^2 value (on this axis, there is a good decline on both sides of the peak), the mu value stays roughly the same? It's as if once the sigma^2 parameter has reached the optimal level, the differences in likelihood between mu values are pretty small. For example, when I check the variance of the likelihoods of the maximum point of sigma (keeping it constant), it's 11.5. In contrast, when I check the variance of the mu's across that same point, the variance is 23402. Since I can't yet post images since I don't have enough reputation, I will just post my R-code that produces the graph.
#Define LL function
LL <- function(X, theta)
{
mu <- theta[1]
sigma2 <- theta[2]
log.likelihood <- 0
n <- length(X)
for (i in 1:length(X))
{
log.likelihood <- log.likelihood - (((X[i]-mu)^2)/(2*sigma2)) -
log(sqrt(2*pi*sigma2))
}
return(log.likelihood)
}
#Parameters
Mu <- 100
Sigma2 <- 50
#Sample
N <- 100
set.seed(1)
IQs <- rnorm(N, mean=Mu, sd=sqrt(Sigma2))
#Possible values to test
x <- posMu <- seq(80, 120, length.out=200)
y <- posSig <- seq(20, 60, length.out=200)
#x1 <- sort(x, decreasing=T)
#Produce LLs for plotting
LLlist <- NULL
for (m in 1:length(posMu)){
LLs <- NULL
for(s in 1:length(posSig)){
posTheta <- cbind(posMu[m],posSig[s])
LLs <- c(LLs, LL(IQs,posTheta))
}
LLlist <- cbind(LLlist,LLs, deparse.level=0)
}
z <- LLlist
#Find the approximate MLE
mLL <- which(LLlist == max(LLlist), arr.ind=TRUE)
cbind(posMu[mLL[2]],posSig[mLL[1]],LLlist[mLL])
#Graph the LLs
library(rgl)
open3d()
plot3d(mean(x),mean(y),mean(z), xlab="Mu", ylab="Sigma2", zlab="log L", xlim=c(min(x),max(x)), ylim=c(min(y),max(y)), zlim=c(min(z),max(z)))
surface3d(x, y, z, color=rainbow(length(x)))
So, is my code just wrong? Or is this what a LL curve should look like? If so, why is it that sigma^2 seems to show a clear curve and height whereas mu hardly differs at the maximum? Thanks in advance!
In order to solve (c), I think I need a plot of the log-likelihood of the binomial distribution. Can anyone please help me do it in R? The data and the question is as follows;
I think I need this kind of plot:
Something like this should work:
F <- c(18,31,34,33,27,33,28,23,33,12,19,25,14,4,22,7)
M <- c(11,22,27,29,24,29,25,26,38,14,23,31,20,6,34,12)
Y <- F
N <- F + M
#a)
Y / N
#b)
sum(Y) / sum(N)
#c)
logL <- function(p) sum(log(dbinom(Y, N, p)))
#plot logL:
p.seq <- seq(0.01, 0.99, 0.01)
plot(p.seq, sapply(p.seq, logL), type="l")
#optimum:
optimize(logL, lower=0, upper=1, maximum=TRUE)
As noted by Ben (see comments), the numerical accuracy is increased by the use of: logL <- function(p) sum(dbinom(Y,N,p,log=TRUE)) instead, especially it can "rescue" you in cases where dbinom() returns 0 but the likelihood-score is actually just close to 0.