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