File: p_significance.R

package info (click to toggle)
r-cran-parameters 0.24.2-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 3,852 kB
  • sloc: sh: 16; makefile: 2
file content (336 lines) | stat: -rw-r--r-- 12,828 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
#' @importFrom bayestestR p_significance
#' @export
bayestestR::p_significance


#' @title Practical Significance (ps)
#'
#' @description Compute the probability of **Practical Significance** (*ps*),
#' which can be conceptualized as a unidirectional equivalence test. It returns
#' the probability that an effect is above a given threshold corresponding to a
#' negligible effect in the median's direction, considering a parameter's _full_
#' confidence interval. In other words, it returns the probability of a clear
#' direction of an effect, which is larger than the smallest effect size of
#' interest (e.g., a minimal important difference). Its theoretical range is
#' from zero to one, but the *ps* is typically larger than 0.5 (to indicate
#' practical significance).
#'
#' In comparison the the [`equivalence_test()`] function, where the *SGPV*
#' (second generation p-value) describes the proportion of the _full_ confidence
#' interval that is _inside_ the ROPE, the value returned by `p_significance()`
#' describes the _larger_ proportion of the _full_ confidence interval that is
#' _outside_ the ROPE. This makes `p_significance()` comparable to
#' [`bayestestR::p_direction()`], however, while `p_direction()` compares to a
#' point-null by default, `p_significance()` compares to a range-null.
#'
#' @param x A statistical model.
#' @inheritParams bayestestR::p_significance
#' @inheritParams model_parameters.default
#' @param verbose Toggle warnings and messages.
#' @param ... Arguments passed to other methods.
#'
#' @seealso For more details, see [`bayestestR::p_significance()`]. See also
#' [`equivalence_test()`], [`p_function()`] and [`bayestestR::p_direction()`]
#' for functions related to checking effect existence and significance.
#'
#' @details `p_significance()` returns the proportion of the _full_ confidence
#' interval range (assuming a normally or t-distributed, equal-tailed interval,
#' based on the model) that is outside a certain range (the negligible effect,
#' or ROPE, see argument `threshold`). If there are values of the distribution
#' both below and above the ROPE, `p_significance()` returns the higher
#' probability of a value being outside the ROPE. Typically, this value should
#' be larger than 0.5 to indicate practical significance. However, if the range
#' of the negligible effect is rather large compared to the range of the
#' confidence interval, `p_significance()` will be less than 0.5, which
#' indicates no clear practical significance.
#'
#' Note that the assumed interval, which is used to calculate the practical
#' significance, is an estimation of the _full interval_ based on the chosen
#' confidence level. For example, if the 95% confidence interval of a
#' coefficient ranges from -1 to 1, the underlying _full (normally or
#' t-distributed) interval_ approximately ranges from -1.9 to 1.9, see also
#' following code:
#'
#' ```
#' # simulate full normal distribution
#' out <- bayestestR::distribution_normal(10000, 0, 0.5)
#' # range of "full" distribution
#' range(out)
#' # range of 95% CI
#' round(quantile(out, probs = c(0.025, 0.975)), 2)
#' ```
#'
#' This ensures that the practical significance always refers to the general
#' compatible parameter space of coefficients. Therefore, the _full interval_ is
#' similar to a Bayesian posterior distribution of an equivalent Bayesian model,
#' see following code:
#'
#' ```
#' library(bayestestR)
#' library(brms)
#' m <- lm(mpg ~ gear + wt + cyl + hp, data = mtcars)
#' m2 <- brm(mpg ~ gear + wt + cyl + hp, data = mtcars)
#' # probability of significance (ps) for frequentist model
#' p_significance(m)
#' # similar to ps of Bayesian models
#' p_significance(m2)
#' # similar to ps of simulated draws / bootstrap samples
#' p_significance(simulate_model(m))
#' ```
#'
#' @note There is also a [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html)
#' implemented in the [**see**-package](https://easystats.github.io/see/).
#'
#' @inheritSection model_parameters Statistical inference - how to quantify evidence
#'
#' @references
#'
#'   - Amrhein, V., Korner-Nievergelt, F., and Roth, T. (2017). The earth is
#'     flat (p > 0.05): Significance thresholds and the crisis of unreplicable
#'     research. PeerJ, 5, e3544. \doi{10.7717/peerj.3544}
#'
#'   - Greenland S, Rafi Z, Matthews R, Higgs M. To Aid Scientific Inference,
#'     Emphasize Unconditional Compatibility Descriptions of Statistics. (2022)
#'     https://arxiv.org/abs/1909.08583v7 (Accessed November 10, 2022)
#'
#'   - Lakens, D. (2024). Improving Your Statistical Inferences (Version v1.5.1).
#'     Retrieved from https://lakens.github.io/statistical_inferences/.
#'     \doi{10.5281/ZENODO.6409077}
#'
#'   - Lakens, D., Scheel, A. M., and Isager, P. M. (2018). Equivalence Testing
#'     for Psychological Research: A Tutorial. Advances in Methods and Practices
#'     in Psychological Science, 1(2), 259–269. \doi{10.1177/2515245918770963}
#'
#'   - Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., and Lüdecke, D. (2019).
#'     Indices of Effect Existence and Significance in the Bayesian Framework.
#'     Frontiers in Psychology, 10, 2767. \doi{10.3389/fpsyg.2019.02767}
#'
#'   - Rafi Z, Greenland S. Semantic and cognitive tools to aid statistical
#'     science: replace confidence and significance by compatibility and surprise.
#'     BMC Medical Research Methodology (2020) 20:244.
#'
#'   - Schweder T. Confidence is epistemic probability for empirical science.
#'     Journal of Statistical Planning and Inference (2018) 195:116–125.
#'     \doi{10.1016/j.jspi.2017.09.016}
#'
#'   - Schweder T, Hjort NL. Frequentist analogues of priors and posteriors.
#'     In Stigum, B. (ed.), Econometrics and the Philosophy of Economics: Theory
#'     Data Confrontation in Economics, pp. 285-217. Princeton University Press,
#'     Princeton, NJ, 2003
#'
#'   - Vos P, Holbert D. Frequentist statistical inference without repeated sampling.
#'     Synthese 200, 89 (2022). \doi{10.1007/s11229-022-03560-x}
#'
#' @return A data frame with columns for the parameter names, the confidence
#' intervals and the values for practical significance. Higher values indicate
#' more practical significance (upper bound is one).
#'
#' @examplesIf requireNamespace("bayestestR") && packageVersion("bayestestR") > "0.14.0" && requireNamespace("sandwich")
#' data(qol_cancer)
#' model <- lm(QoL ~ time + age + education, data = qol_cancer)
#'
#' p_significance(model)
#' p_significance(model, threshold = c(-0.5, 1.5))
#'
#' # based on heteroscedasticity-robust standard errors
#' p_significance(model, vcov = "HC3")
#'
#' if (require("see", quietly = TRUE)) {
#'   result <- p_significance(model)
#'   plot(result)
#' }
#' @export
p_significance.lm <- function(x,
                              threshold = "default",
                              ci = 0.95,
                              vcov = NULL,
                              vcov_args = NULL,
                              verbose = TRUE,
                              ...) {
  # generate normal distribution based on CI range
  result <- .posterior_ci(x, ci, vcov = vcov, vcov_args = vcov_args, ...)

  # copy
  out <- result$out
  posterior <- result$posterior

  # calculate the ROPE range - for multiple thresholds, we have to check
  # each list element for "default", to replace it with the appropriate range
  if (is.list(threshold)) {
    threshold <- lapply(threshold, function(i) {
      if (all(i == "default")) {
        i <- bayestestR::rope_range(x, verbose = verbose)
      }
      i
    })
  } else if (all(threshold == "default")) {
    threshold <- bayestestR::rope_range(x, verbose = verbose)
  }

  # add ps
  result_ps <- bayestestR::p_significance(
    posterior,
    threshold = threshold,
    verbose = verbose
  )
  out$ps <- as.numeric(result_ps)

  # for list-thresholds, we have the list as attribute and need to save it as
  # data.frame
  if (is.list(threshold)) {
    # save for later
    threshold_data <- stats::setNames(
      as.data.frame(do.call(rbind, attributes(result_ps)$threshold)),
      c("ROPE_low", "ROPE_high")
    )
    out <- cbind(out, threshold_data)
    keep <- c("Parameter", "CI", "CI_low", "CI_high", "ROPE_low", "ROPE_high", "ps", "Effects", "Component")
  } else {
    keep <- c("Parameter", "CI", "CI_low", "CI_high", "ps", "Effects", "Component")
  }

  # for plot, we need to have it numeric
  if (!is.numeric(threshold) && !is.list(threshold)) {
    threshold <- 0.1
  }

  # Reorder columns of 'out' to keep only the relevant ones
  out <- out[intersect(keep, colnames(out))]

  attr(out, "data") <- posterior
  attr(out, "threshold") <- threshold
  class(out) <- c("p_significance_lm", "p_significance", "see_p_significance", "data.frame")
  out
}


# helper ----------------------------------------------------------------------

.posterior_ci <- function(x, ci, vcov = NULL, vcov_args = NULL, ...) {
  # first, we need CIs
  if (inherits(x, "parameters_model")) {
    # for model_parameters objects, directly extract CIs
    out <- as.data.frame(x)[intersect(
      c("Parameter", "CI_low", "CI_high", "Component", "Effects"),
      colnames(x)
    )]
    ci <- attributes(x)$ci
    # and extract degrees of freedom
    df_column <- grep("(df|df_error)", colnames(x))
    if (length(df_column) > 0) {
      dof <- unique(x[[df_column]])
      if (length(dof) > 1) {
        dof <- Inf
      }
    } else {
      dof <- Inf
    }
  } else {
    out <- ci(x, ci = ci, vcov = vcov, vcov_args = vcov_args, ...)
    dof <- .safe(insight::get_df(x, type = "wald"), Inf)
  }
  # we now iterate all confidence intervals and create an approximate normal
  # distribution that covers the CI-range.
  posterior <- as.data.frame(lapply(seq_len(nrow(out)), function(i) {
    ci_range <- as.numeric(out[i, c("CI_low", "CI_high")])
    .generate_posterior_from_ci(ci, ci_range, dof = dof)
  }))
  colnames(posterior) <- out$Parameter

  # deal with Effects and Component columns
  if ("Effects" %in% colnames(out) && insight::n_unique(out$Effects) == 1) {
    out$Effects <- NULL
  }
  if ("Component" %in% colnames(out) && insight::n_unique(out$Component) == 1) {
    out$Component <- NULL
  }

  # check we don't have duplicated columns in "posterior" we need this for
  # plotting
  if (anyDuplicated(colnames(posterior)) > 0 && !is.null(out$Component)) {
    comps <- .rename_values(out$Component, "zero_inflated", "zi")
    comps <- .rename_values(comps, "conditional", "cond")
    colnames(posterior) <- paste0(out$Parameter, "_", comps)
    out$Parameter <- paste0(out$Parameter, "_", comps)
  }
  list(out = out, posterior = posterior)
}


# methods ---------------------------------------------------------------------

#' @export
print.p_significance_lm <- function(x, digits = 2, ...) {
  threshold <- attributes(x)$threshold
  # Check if threshold is a list, which indicates multiple thresholds
  if (is.list(threshold)) {
    caption <- "Practical Significance"
  } else {
    # make sure it's numeric
    if (!is.numeric(threshold)) {
      threshold <- 0.1
    }
    # make sure we have both bounds for the range
    if (length(threshold) == 1) {
      threshold <- c(threshold * -1, threshold)
    }
    caption <- sprintf(
      "Practical Significance (threshold: %s)",
      toString(insight::format_value(threshold, digits = 2))
    )
  }
  x$ps <- insight::format_pd(x$ps, name = NULL)
  x <- insight::format_table(x, digits = digits)
  cat(insight::export_table(x, title = caption, ...))
}


# other classes --------------------------------------------------------------

#' @export
p_significance.glm <- p_significance.lm

#' @export
p_significance.coxph <- p_significance.lm

#' @export
p_significance.svyglm <- p_significance.lm

#' @export
p_significance.glmmTMB <- p_significance.lm

#' @export
p_significance.merMod <- p_significance.lm

#' @export
p_significance.wbm <- p_significance.lm

#' @export
p_significance.lme <- p_significance.lm

#' @export
p_significance.gee <- p_significance.lm

#' @export
p_significance.gls <- p_significance.lm

#' @export
p_significance.feis <- p_significance.lm

#' @export
p_significance.felm <- p_significance.lm

#' @export
p_significance.mixed <- p_significance.lm

#' @export
p_significance.hurdle <- p_significance.lm

#' @export
p_significance.zeroinfl <- p_significance.lm

#' @export
p_significance.rma <- p_significance.lm

#' @export
p_significance.parameters_model <- p_significance.lm