tidymodels / broom
1
#' @templateVar class gam
2
#' @template title_desc_tidy
3
#'
4
#' @param x A `gam` object returned from a call to [mgcv::gam()].
5
#' @param parametric Logical indicating if parametric or smooth terms should
6
#'   be tidied. Defaults to `FALSE`, meaning that smooth terms are tidied
7
#'   by default.
8
#' @template param_confint
9
#' @template param_exponentiate
10
#' @template param_unused_dots
11
#'
12
#' @evalRd return_tidy(
13
#'   "term",
14
#'   "estimate",
15
#'   "std.error",
16
#'   "statistic",
17
#'   "p.value",
18
#'   edf = "The effective degrees of freedom. Only reported when
19
#'     `parametric = FALSE`",
20
#'   ref.df = "The reference degrees of freedom. Only reported when
21
#'     `parametric = FALSE`"
22
#' )
23
#'
24
#' @details When `parametric = FALSE` return columns `edf` and `ref.df` rather
25
#'   than `estimate` and `std.error`.
26
#'
27
#'
28
#' @examples
29
#'
30
#' g <- mgcv::gam(mpg ~ s(hp) + am + qsec, data = mtcars)
31
#'
32
#' tidy(g)
33
#' tidy(g, parametric = TRUE)
34
#' glance(g)
35
#' augment(g)
36
#' @export
37
#' @aliases mgcv_tidiers gam_tidiers tidy.gam
38
#' @family mgcv tidiers
39
#' @seealso [tidy()], [mgcv::gam()]
40
tidy.gam <- function(x, parametric = FALSE, conf.int = FALSE,
41
                     conf.level = 0.95, exponentiate = FALSE, ...) {
42 1
  if (!parametric && conf.int) {
43 0
    message("Confidence intervals only available for parametric terms.")
44
  }
45 1
  if (!parametric && exponentiate) {
46 0
    message("Exponentiating coefficients only available for parametric terms.")
47
  }
48 1
  if (parametric) {
49 1
    px <- summary(x)$p.table
50 1
    ret <- as_tidy_tibble(
51 1
      px, 
52 1
      new_names = c("estimate", "std.error", "statistic", "p.value")
53
    )
54 1
    if (conf.int) {
55
      # avoid "Waiting for profiling to be done..." message
56
      # This message doesn't seem to happen with confint.default
57 1
      CI <- suppressMessages(
58 1
        stats::confint.default(x, level = conf.level)[rownames(px), , drop = FALSE]
59
      )
60
      # Think about rank deficiency
61 1
      colnames(CI) <- c("conf.low", "conf.high")
62 1
      ret <- cbind(ret, unrowname(CI))
63 1
      ret <- as_tibble(ret)
64
    }
65
  } else {
66 1
    sx <- summary(x)$s.table
67 1
    sx <- as.data.frame(sx)
68 1
    class(sx) <- c("anova", "data.frame")
69 1
    ret <- tidy(sx)
70
  }
71
  
72 1
  if (exponentiate && parametric) {
73 1
    ret <- exponentiate(ret)  
74
  }
75
  
76 1
  ret
77
}
78

79
#' @templateVar class gam
80
#' @template title_desc_glance
81
#'
82
#' @inherit tidy.gam params examples
83
#'
84
#' @evalRd return_glance(
85
#'   "df",
86
#'   "logLik",
87
#'   "AIC",
88
#'   "BIC",
89
#'   "deviance",
90
#'   "df.residual",
91
#'   "nobs"
92
#' )
93
#'
94
#'
95
#' @export
96
#' @family mgcv tidiers
97
#' @seealso [glance()], [mgcv::gam()]
98
glance.gam <- function(x, ...) {
99 1
  as_glance_tibble(
100 1
    df = sum(x$edf),
101 1
    logLik = as.numeric(stats::logLik(x)),
102 1
    AIC = stats::AIC(x),
103 1
    BIC = stats::BIC(x),
104 1
    deviance = stats::deviance(x),
105 1
    df.residual = stats::df.residual(x),
106 1
    nobs = stats::nobs(x),
107 1
    na_types = "irrrrii"
108
  )
109
}
110

111

112
#' @templateVar class gam
113
#' @template title_desc_augment
114
#'
115
#' @inherit tidy.gam params examples
116
#' @template param_data
117
#' @template param_newdata
118
#' @template param_type_predict
119
#' @template param_type_residuals
120
#'
121
#' @evalRd return_augment(
122
#'   ".se.fit",
123
#'   ".resid",
124
#'   ".hat",
125
#'   ".sigma",
126
#'   ".cooksd"
127
#' )
128
#'
129
#' @details For additional details on Cook's distance, see
130
#'   [stats::cooks.distance()].
131
#'
132
#' @seealso [augment()], [mgcv::gam()]
133
#' @export
134
augment.gam <- function(x, data = model.frame(x), newdata = NULL,
135
                        type.predict, type.residuals, ...) {
136 1
  augment_columns(
137 1
    x, data, newdata,
138 1
    type.predict = type.predict,
139 1
    type.residuals = type.residuals
140
  )
141
}

Read our documentation on viewing source code .

Loading