1#' @templateVar class glmnet 2#' @template title_desc_tidy 3#' 4#' @param x A `glmnet` object returned from [glmnet::glmnet()]. 5#' @param return_zeros Logical indicating whether coefficients with value zero 6#' zero should be included in the results. Defaults to `FALSE`. 7#' @template param_unused_dots 8#' 9#' @evalRd return_tidy( 10#' "term", 11#' "step", 12#' "estimate", 13#' "lambda", 14#' "dev.ratio" 15#' ) 16#' 17#' @details Note that while this representation of GLMs is much easier 18#' to plot and combine than the default structure, it is also much 19#' more memory-intensive. Do not use for large, sparse matrices. 20#' 21#' No `augment` method is yet provided even though the model produces 22#' predictions, because the input data is not tidy (it is a matrix that 23#' may be very wide) and therefore combining predictions with it is not 24#' logical. Furthermore, predictions make sense only with a specific 25#' choice of lambda. 26#' 27#' @examples 28#' 29#' if (requireNamespace("glmnet", quietly = TRUE)) { 30#' 31#' library(glmnet) 32#' 33#' set.seed(2014) 34#' x <- matrix(rnorm(100 * 20), 100, 20) 35#' y <- rnorm(100) 36#' fit1 <- glmnet(x, y) 37#' 38#' tidy(fit1) 39#' glance(fit1) 40#' 41#' library(dplyr) 42#' library(ggplot2) 43#' 44#' tidied <- tidy(fit1) %>% filter(term != "(Intercept)") 45#' 46#' ggplot(tidied, aes(step, estimate, group = term)) + 47#' geom_line() 48#' ggplot(tidied, aes(lambda, estimate, group = term)) + 49#' geom_line() + 50#' scale_x_log10() 51#' 52#' ggplot(tidied, aes(lambda, dev.ratio)) + 53#' geom_line() 54#' 55#' # works for other types of regressions as well, such as logistic 56#' g2 <- sample(1:2, 100, replace = TRUE) 57#' fit2 <- glmnet(x, g2, family = "binomial") 58#' tidy(fit2) 59#' 60#' } 61#' 62#' @export 63#' @aliases glmnet_tidiers 64#' @family glmnet tidiers 65#' @seealso [tidy()], [glmnet::glmnet()] 66tidy.glmnet <- function(x, return_zeros = FALSE, ...) { 67 beta <- coef(x) 68 69 if (inherits(x, "multnet")) { 70 beta_d <- purrr::map_df(beta, function(b) { 71 as_tidy_tibble(as.matrix(b), 72 new_names = 1:ncol(b)) 73 }, .id = "class") 74 ret <- beta_d %>% 75 pivot_longer( 76 cols = c(everything(), -term, -class), 77 names_to = "step", 78 values_to = "estimate" 79 ) 80 } else { 81 beta_d <- as_tidy_tibble( 82 as.matrix(beta), 83 new_names = 1:ncol(beta) 84 ) 85 86 ret <- pivot_longer(beta_d, 87 cols = c(dplyr::everything(), -term), 88 names_to = "step", 89 values_to = "estimate" 90 ) 91 } 92 # add values specific to each step 93 ret <- ret %>% 94 mutate( 95 step = as.numeric(step), 96 lambda = x$lambda[step], 97 dev.ratio = x$dev.ratio[step] 98 ) 99 100 if (!return_zeros) { 101 ret <- filter(ret, estimate != 0) 102 } 103 104 as_tibble(ret) 105} 106 107 108#' @templateVar class glmnet 109#' @template title_desc_glance 110#' 111#' @inherit tidy.glmnet params examples 112#' 113#' @evalRd return_glance("nulldev", "npasses", "nobs") 114#' 115#' @export 116#' @family glmnet tidiers 117#' @seealso [glance()], [glmnet::glmnet()] 118glance.glmnet <- function(x, ...) { 119 as_glance_tibble( 120 nulldev = x$nulldev, 121 npasses = x$npasses, 122 nobs = stats::nobs(x), 123 na_types = "rii" 124 ) 125} 126