1#' @templateVar class ridgelm
2#' @template title_desc_tidy
3#'
4#' @param x A `ridgelm` object returned from [MASS::lm.ridge()].
5#' @template param_unused_dots
6#'
7#' @evalRd return_tidy("lambda", "GCV", "term",
8#'   estimate = "estimate of scaled coefficient using this lambda",
9#'   scale = "Scaling factor of estimated coefficient"
10#' )
11#'
12#' @examples
13#'
14#' if (requireNamespace("MASS", quietly = TRUE)) {
15#'
16#'
17#' names(longley)[1] <- "y"
18#' fit1 <- MASS::lm.ridge(y ~ ., longley)
19#' tidy(fit1)
20#'
21#' fit2 <- MASS::lm.ridge(y ~ ., longley, lambda = seq(0.001, .05, .001))
22#' td2 <- tidy(fit2)
23#' g2 <- glance(fit2)
24#'
25#' # coefficient plot
26#' library(ggplot2)
27#' ggplot(td2, aes(lambda, estimate, color = term)) +
28#'   geom_line()
29#'
30#' # GCV plot
31#' ggplot(td2, aes(lambda, GCV)) +
32#'   geom_line()
33#'
34#' # add line for the GCV minimizing estimate
35#' ggplot(td2, aes(lambda, GCV)) +
36#'   geom_line() +
37#'   geom_vline(xintercept = g2$lambdaGCV, col = "red", lty = 2)
38#'
39#' }
40#'
41#' @export
42#' @aliases ridgelm_tidiers
43#' @family ridgelm tidiers
44#' @seealso [tidy()], [MASS::lm.ridge()]
45tidy.ridgelm <- function(x, ...) {
46  if (length(x$lambda) == 1) {
47    # only one choice of lambda
48    ret <- tibble(
49      lambda = x$lambda,
50      GCV = unname(x$GCV),
51      term = names(x$coef),
52      estimate = x$coef,
53      scale = x$scales
54    )
55    return(ret)
56  }
57
58  # otherwise, multiple lambdas/coefs/etc, have to tidy
59  cotidy <- data.frame(unrowname(t(x$coef)),
60    lambda = x$lambda,
61    GCV = unname(x$GCV)
62  ) %>%
63    pivot_longer(
64      cols = c(dplyr::everything(), -lambda, -GCV),
65      names_to = "term",
66      values_to = "estimate"
67    ) %>%
68    as.data.frame() %>%
69    mutate(term = as.character(term)) %>%
70    mutate(scale = x$scales[term])
71
72  as_tibble(cotidy)
73}
74
75
76#' @templateVar class ridgelm
77#' @template title_desc_glance
78#'
79#' @inherit tidy.ridgelm params examples
80#'
81#' @evalRd return_glance(
82#'   kHKB = "modified HKB estimate of the ridge constant",
83#'   kLW = "modified L-W estimate of the ridge constant",
84#'   lambdaGCV = "choice of lambda that minimizes GCV"
85#' )
86#'
87#' @details This is similar to the output of `select.ridgelm`, but it is
88#'   returned rather than printed.
89#'
90#' @export
91#' @family ridgelm tidiers
92#' @seealso [glance()], [MASS::select.ridgelm()], [MASS::lm.ridge()]
93glance.ridgelm <- function(x, ...) {
94  as_glance_tibble(
95    kHKB = x$kHKB,
96    kLW = x$kLW,
97    lambdaGCV = x$lambda[which.min(x$GCV)],
98    na_types = "rrr"
99  )
100}
101