[R] Logistic Regression using optim() give "L-BFGS-B" error, please help

[ashky]

Sorry, I deleted my old post. Pasting the new query below.

Dear R Users/Experts, 

I am using a function called logitreg() originally described in MASS (the
book 4th Ed.) by Venebles & Ripley, p445. I used the code as provided but
made couple of changes to run a 'constrained' logistic regression, I set the
method = "L-BFGS-B", set lower/upper values for the variables. 

Here is the function, 

logitregVR <- function(x, y, wt = rep(1, length(y)), intercept = T, start =
rep(0, p), ...)
{
#-------------------------------------------#
# A function to be minimized (or maximized) #
#-------------------------------------------#
fmin <- function(beta, X, y, w) 
{
  p <- plogis(X %*% beta)
  #p <- ifelse(1-p < 1e-6, 1-1e-6, p) 
 cat("----------", "\n")
 cat(paste("X = "), X, "\n")
 cat(paste("beta = "), beta, "\n")
 cat(paste("p = "), p, "\n")
 cat(paste("1-p = "), 1-p, "\n")
 cat(paste("y = "), y, "\n")
 cat(paste("length(p) ="), length(p), "\n")
 cat(paste("class(p) ="), class(p), "\n")
 cat("----------", "\n")

 -sum(2*w*ifelse(y, log(p), log(1-p))) # Residual Deviance: D =
-2[Likelihood Ratio]
 print(-sum(2*w*ifelse(y, log(p), log(1-p))))
}

#----------------------------------------------------------------------#
# A function to return the gradient for the "BFGS", "L-BFGS-B" methods #
#----------------------------------------------------------------------#
gmin <- function(beta, X, y, w) 
{
  eta <- X %*% beta; p <- plogis(eta)
  #p <- ifelse(1-p < 1e-6, 1-1e-6, p) 
  -2*matrix(w*dlogis(eta)*ifelse(y, 1/p, -1/(1-p)), 1) %*% X # Gradient
  print(-2*matrix(w*dlogis(eta)*ifelse(y, 1/p, -1/(1-p)), 1) %*% X)
}

  if(is.null(dim(x))) dim(x) <- c(length(x), 1)
  dn <- dimnames(x)[[2]]
  if(!length(dn)) dn <- paste("Slope", 1:ncol(x), sep="")
  p <- ncol(x) + intercept # 1 + 1
  if(intercept) {x <- cbind(1, x); dn <- c("(Intercept)", dn)}
  if(is.factor(y)) y <- (unclass(y) != 1)

#fit <- optim(start, fmin, gmin, X = x, y = y, w = wt, method = "L-BFGS-B",
lower = c(-Inf, 0.05), upper = c(Inf, Inf), ...)
fit <- optim(start, fmin, gmin, X = x, y = y, w = wt, control = list(trace =
6), method = "L-BFGS-B", lower = c(-Inf, 0.05), upper = c(Inf, Inf), ...)

  names(fit$par) <- dn
  cat("\nCoefficients:\n"); print(fit$par)
  cat("\nResidual Deviance:", format(fit$value), "\n")
  if(fit$convergence > 0) cat("\nConvergence code:", fit$convergence, "\n")
  return(list(fitpar = fit$par))
  invisible(fit)
}

And here is my data, 

# ---------------------- 
# Dose 0 1 emp.prop 
# ---------------------- 
# 1 3 0 0.000 
# 2 1 0 0.000 
# 3.3 4 0 0.000 
# 5.016 3 0 0.000 
# 7.0224 4 0 0.000 
# 9.3398 2 0 0.000 
# 12.4219 2 0 0.000 
# 16.5211 47 1 0.021 
# 21.9731 1 1 0.500 
# ---------------------- 

I have used the glm(family = binomial) and the lrm() function. But my
interest is to constraint the slope parameter (beta) to some specified value
(say, a non negative number, 0.05 for instance). If you notice in the above
code by Venebles and Ripley, for the optim() part I chose method =
"L-BFGS-B" and set lower and upper values for my two parameters. Here is the
code and the error I am getting, 

y <- c(rep(0,3), rep(0,1), rep(0,4), rep(0,3), rep(0,4), rep(0,2), rep(0,2),
rep(0,47), rep(1,1), rep(0,1), rep(1,1)) 
x <- c(rep(1,3), rep(2,1), rep(3.3,4), rep(5.016,3), rep(7.0224,4),
rep(9.3398,2), rep(12.4219,2), rep(16.5211,48), rep(21.9731,2)) 

length(x) 
length(y) 

#------------------# 
# Method 1 - Works # 
#------------------# 
glm(y~x, family = binomial)$coefficients 

# summary(glm(y~x, family = binomial)) 

#------------------# 
# Method 2 - Works # 
#------------------# 
  library(Design) 
  lrm(y ~ x)$coef 

#-------------------# 
# Method 3 - Works # 
#-------------------# 
lgtreg <- function(beta, x, y) 
{ 
       eta <- exp(beta[1] + beta[2]*x) 
       p <- eta/(1+eta) 
       return(-sum(ifelse(y,log(p),log(1-p)))) # This is the log-likelihood 
} 

optim(c(0,0), lgtreg, x = x, y = y, method = "BFGS", hessian = TRUE)$par 

#-----------------------------------------------------------------# 
# Method 4 - Veneble and Ripley's Method with different start values # 
#-----------------------------------------------------------------# 

logitregVR(x, y) # No error 
logitregVR(x, y, start = rep(0.1, 2)) # Gives error 
logitregVR(x, y, start = rep(0.5, 2)) # No error 
logitregVR(x, y, start = rep(1, 2)) # Gives error 

I am getting this error, 

Error in optim(start, fmin, gmin, X = x, y = y, w = wt, method = "L-BFGS-B",
: L-BFGS-B needs finite values of 'fn'

If you see, at each iteration I printed the X, beta, p, Deviance etc. But
for certain start values this function is failing on me and giving an
infinite value for Deviance. Can someone please help me and tell what I am
doing wrong.

Any comments/replies highly appreciated, 

Thank you very much,
Ashky
-- 
View this message in context: http://www.nabble.com/Logistic-Regression-using-optim%28%29-give-%22L-BFGS-B%22-error%2C-please-help-tp19733974p19733974.html
Sent from the R help mailing list archive at Nabble.com.