R/coef.autotune_lasso_path.R

In autotune: Faster and more Efficient Lasso (than 'glmnet' and 'scalreg') with Data-Driven Tuning

#' @rdname coef.autotune_lasso
#' @method coef autotune_lasso_path
#' @export
coef.autotune_lasso_path <- function(object,
                                intercept = TRUE,
                                a0 = NULL, ...) {
  
  if (!requireNamespace("Matrix", quietly = TRUE)) {
    stop("Package 'Matrix' must be installed to return sparse coefficients.")
  }
  
  beta_mat <- object[["beta_matrix"]]  # (k+1) x p
  if (is.null(beta_mat)) {
    stop("'object' does not contain a 'beta_matrix' component.")
  }
  if (!is.matrix(beta_mat)) beta_mat <- as.matrix(beta_mat)
  
  beta_sp <- Matrix::Matrix(t(beta_mat), sparse = TRUE)  # p x (k+1)
  
  n_solutions <- ncol(beta_sp)
  k <- n_solutions - 1L
  p <- nrow(beta_sp)
  
  soln_names <- if (k > 0L) {
    c(paste0("lambda_", seq_len(k)), "final_lambda")
  } else {
    "final_lambda"
  }
  colnames(beta_sp) <- soln_names
  varnames <- colnames(beta_mat)
  if (is.null(varnames)) varnames <- paste0("V", seq_len(p))
  rownames(beta_sp) <- varnames
  if (intercept) {
    if (is.null(a0)) {
      stop("'a0' must be supplied when 'intercept = TRUE'.")
    }
    if (length(a0) == 1L) a0 <- rep(a0, n_solutions)
    if (length(a0) != n_solutions) {
      stop("'a0' must have length 1 or the number of path solutions.")
    }
    beta_sp <- rbind(a0, beta_sp)
    rownames(beta_sp) <- c("(Intercept)", varnames)
  }
  beta_sp
}