1

I am working on multinomial logistic regression with the mlogit package. I would like to add the elastic net penalty (Hastie and Zou, 2005) to the likelihood function. As in: https://web.stanford.edu/~hastie/Papers/B67.2%20(2005)%20301-320%20Zou%20&%20Hastie.pdf

I have tried the glmnet package, but it seems that it doesn't work like the way mlogit does: it doesn't seem to recognize data in long format and varying choice set. It somehow produces an unexpected result. (It is working fine in mlogit, but without penalty in the likelihood.)

I am trying to change the code in the package, the mlogit.lnl.R file seems to contain the likelihood function, I have tried to add a lasso term to "lnl" in the mlogit.lnl.R file, but it produced the same result as if i didn't add it.

Inside the mlogit.lnl.R file:

lnl.slogit <- function(param, X, y, weights = NULL, gradient = FALSE,
                    hessian = FALSE, opposite, direction = rep(0, length(param)),
                    initial.value = NULL,stptol = 1E-01){
  balanced <- FALSE
  step <- 2
  repeat{
    step <- step / 2
    if (step < stptol) break
    eXb <- lapply(X, function(x) exp(crossprod(t(x), param + step * direction)))
    seXb <- suml(eXb)
    P <- lapply(eXb, function(x){v <- x/seXb; v[is.na(v)] <- 0; as.vector(v)})
    Pch <- Reduce("+", mapply("*", P, y, SIMPLIFY = FALSE))
    lnl <- sum(opposite * weights * log(Pch)) 
    if (is.null(initial.value) || lnl <= initial.value) break
  }
  if (gradient | hessian) PX <- suml(mapply("*", X, P, SIMPLIFY = FALSE))
  if (gradient){
    Xch <- suml(mapply("*", X, y, SIMPLIFY = FALSE))
    gradi <-  opposite * weights * (Xch - PX)
    attr(lnl, "gradi") <- gradi
    attr(lnl, "gradient") <- if (is.matrix(gradi)) apply(gradi,2,sum) else 
sum(gradi)
  }
  if (hessian){
    XmPX <- lapply(X, function(x){g <- x - PX; g[is.na(g)] <- 0; g})
    hessian <-   - suml( mapply(function(x, y) crossprod(x * y, y),
                            P, XmPX, SIMPLIFY = FALSE))
    attr(lnl, "hessian") <- opposite * hessian
  }
  if (step < stptol) lnl <- NULL
  else{
    P <- Reduce("cbind", P)
    colnames(P) <- names(y)
    attr(lnl, "probabilities") <- P
    attr(lnl, "fitted") <- Pch
    attr(lnl, "step") <- step
  }
  lnl + 0.5*sum(abs(param)) #I added the lasso here, the shrinkage factor here is 0.5
                              #but eventually, i want the elastic net penalty
}

Any ideas on how to add the penalty term in mlogit package? Or is there any other packages that can do what i want?

Thanks in advance.

PS: the code of the package is available here: https://github.com/cran/mlogit/tree/master/R

John
  • 309
  • 3
  • 12
  • I found that the code is right, the problem is because I didn't restart R sesssion after re-installing the package. – John Apr 03 '18 at 02:47

0 Answers0