R/lasso.R

In lqa: Penalized Likelihood Inference for GLMs

lasso <-
function (lambda = NULL, ...)
{
  lambda.check (lambda)  

  if (length (lambda) != 1)        ## Check on dimensionality of lambda
    stop ("lambda must be a scalar \n")

  names (lambda) <- "lambda"


  getpenmat <- function (beta = NULL, c1 = lqa.control()$c1, ...)
  {
      if (is.null (beta))
        stop ("'beta' must be the current coefficient vector \n")
  
      if (c1 < 0)
        stop ("'c1' must be non-negative \n")

      penmat <- lambda * diag (1 / (sqrt (beta^2 + c1))) * as.integer (beta != 0)
      penmat
  }


  first.derivative <- function (beta, ...)
  {
    p <- length (beta) 
    return (rep (lambda, p))
  }

  structure (list (penalty = "lasso", lambda = lambda, getpenmat = getpenmat, first.derivative = first.derivative), class = "penalty")
}