diff --git a/NAMESPACE b/NAMESPACE index 0da30c4c9..f52947612 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -26,6 +26,7 @@ S3method(as.numeric,map_estimate) S3method(as.numeric,p_direction) S3method(as.numeric,p_map) S3method(as.numeric,p_significance) +S3method(as.vector,p_direction) S3method(bayesfactor_inclusion,BFBayesFactor) S3method(bayesfactor_inclusion,bayesfactor_models) S3method(bayesfactor_models,BFBayesFactor) diff --git a/R/p_direction.R b/R/p_direction.R index dbb3f2d5f..30d6c0bc0 100644 --- a/R/p_direction.R +++ b/R/p_direction.R @@ -235,6 +235,7 @@ p_direction.data.frame <- function(x, } attr(out, "object_name") <- obj_name + attr(out, "as_p") <- as_p class(out) <- unique(c("p_direction", "see_p_direction", class(out))) out @@ -264,12 +265,18 @@ p_direction.rvar <- p_direction.draws #' @rdname p_direction #' @export -p_direction.MCMCglmm <- function(x, method = "direct", null = 0, as_p = FALSE, ...) { +p_direction.MCMCglmm <- function(x, + method = "direct", + null = 0, + as_p = FALSE, + remove_na = TRUE, + ...) { nF <- x$Fixed$nfl out <- p_direction(as.data.frame(x$Sol[, 1:nF, drop = FALSE]), method = method, null = null, as_p = as_p, + remove_na = remove_na, ... ) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) @@ -278,20 +285,32 @@ p_direction.MCMCglmm <- function(x, method = "direct", null = 0, as_p = FALSE, . #' @export -p_direction.mcmc <- function(x, method = "direct", null = 0, as_p = FALSE, ...) { - p_direction(as.data.frame(x), method = method, null = null, as_p = as_p, ...) +p_direction.mcmc <- function(x, + method = "direct", + null = 0, + as_p = FALSE, + remove_na = TRUE, + ...) { + p_direction( + as.data.frame(x), + method = method, + null = null, + as_p = as_p, + remove_na = remove_na, + ... + ) } #' @export -p_direction.BGGM <- function(x, method = "direct", null = 0, as_p = FALSE, ...) { - p_direction(as.data.frame(x), method = method, null = null, as_p = as_p, ...) +p_direction.BGGM <- function(x, method = "direct", null = 0, as_p = FALSE, remove_na = TRUE, ...) { + p_direction(as.data.frame(x), method = method, null = null, as_p = as_p, remove_na = remove_na, ...) } #' @export -p_direction.bcplm <- function(x, method = "direct", null = 0, as_p = FALSE, ...) { - p_direction(insight::get_parameters(x), method = method, null = null, as_p = as_p, ...) +p_direction.bcplm <- function(x, method = "direct", null = 0, as_p = FALSE, remove_na = TRUE, ...) { + p_direction(insight::get_parameters(x), method = method, null = null, as_p = as_p, remove_na = remove_na, ...) } #' @export @@ -309,6 +328,7 @@ p_direction.bamlss <- function(x, method = "direct", null = 0, as_p = FALSE, + remove_na = TRUE, component = c("all", "conditional", "location"), ...) { component <- match.arg(component) @@ -317,6 +337,7 @@ p_direction.bamlss <- function(x, method = method, null = null, as_p = as_p, + remove_na = remove_na, ... ) out <- .add_clean_parameters_attribute(out, x) @@ -326,10 +347,10 @@ p_direction.bamlss <- function(x, #' @rdname p_direction #' @export -p_direction.emmGrid <- function(x, method = "direct", null = 0, as_p = FALSE, ...) { +p_direction.emmGrid <- function(x, method = "direct", null = 0, as_p = FALSE, remove_na = TRUE, ...) { xdf <- insight::get_parameters(x) - out <- p_direction(xdf, method = method, null = null, as_p = as_p, ...) + out <- p_direction(xdf, method = method, null = null, as_p = as_p, remove_na = remove_na, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } @@ -347,6 +368,7 @@ p_direction.emm_list <- p_direction.emmGrid method = "direct", null = 0, as_p = FALSE, + remove_na = TRUE, ...) { p_direction( insight::get_parameters( @@ -358,6 +380,7 @@ p_direction.emm_list <- p_direction.emmGrid method = method, null = null, as_p = as_p, + remove_na = remove_na, ... ) } @@ -370,6 +393,7 @@ p_direction.sim.merMod <- function(x, method = "direct", null = 0, as_p = FALSE, + remove_na = TRUE, ...) { effects <- match.arg(effects) @@ -381,6 +405,7 @@ p_direction.sim.merMod <- function(x, method = method, null = null, as_p = as_p, + remove_na = remove_na, ... ) attr(out, "data") <- insight::get_parameters(x, effects = effects, parameters = parameters) @@ -394,6 +419,7 @@ p_direction.sim <- function(x, method = "direct", null = 0, as_p = FALSE, + remove_na = TRUE, ...) { out <- .p_direction_models( x = x, @@ -403,6 +429,7 @@ p_direction.sim <- function(x, method = method, null = null, as_p = as_p, + remove_na = remove_na, ... ) attr(out, "data") <- insight::get_parameters(x, parameters = parameters) @@ -420,6 +447,7 @@ p_direction.stanreg <- function(x, method = "direct", null = 0, as_p = FALSE, + remove_na = TRUE, ...) { effects <- match.arg(effects) component <- match.arg(component) @@ -436,6 +464,7 @@ p_direction.stanreg <- function(x, method = method, null = null, as_p = as_p, + remove_na = remove_na, ... ), cleaned_parameters, @@ -464,6 +493,7 @@ p_direction.brmsfit <- function(x, method = "direct", null = 0, as_p = FALSE, + remove_na = TRUE, ...) { effects <- match.arg(effects) component <- match.arg(component) @@ -480,6 +510,7 @@ p_direction.brmsfit <- function(x, method = method, null = null, as_p = as_p, + remove_na = remove_na, ... ), cleaned_parameters @@ -494,8 +525,20 @@ p_direction.brmsfit <- function(x, #' @rdname p_direction #' @export -p_direction.BFBayesFactor <- function(x, method = "direct", null = 0, as_p = FALSE, ...) { - out <- p_direction(insight::get_parameters(x), method = method, null = null, as_p = as_p, ...) +p_direction.BFBayesFactor <- function(x, + method = "direct", + null = 0, + as_p = FALSE, + remove_na = TRUE, + ...) { + out <- p_direction( + insight::get_parameters(x), + method = method, + null = null, + as_p = as_p, + remove_na = remove_na, + ... + ) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } @@ -506,6 +549,7 @@ p_direction.get_predicted <- function(x, method = "direct", null = 0, as_p = FALSE, + remove_na = TRUE, use_iterations = FALSE, verbose = TRUE, ...) { @@ -516,6 +560,7 @@ p_direction.get_predicted <- function(x, method = method, null = null, as_p = as_p, + remove_na = remove_na, verbose = verbose, ... ) @@ -528,6 +573,7 @@ p_direction.get_predicted <- function(x, method = method, null = null, as_p = as_p, + remove_na = remove_na, verbose = verbose, ... ) @@ -574,6 +620,10 @@ p_direction.parameters_model <- function(x, ...) { if (length(x) == 0) { insight::format_error("No valid values found. Maybe the data contains only missing values.") } + # sanity check + if (anyNA(x)) { + return(NA_real_) + } # any inf values? then warn... if (any(is.infinite(x))) { @@ -617,7 +667,12 @@ p_direction.parameters_model <- function(x, ...) { #' @export as.numeric.p_direction <- function(x, ...) { if (inherits(x, "data.frame")) { - as.numeric(as.vector(x$pd)) + # check if we have frequentist p-values + if (attributes(x)$as_p && "p" %in% colnames(x)) { + as.numeric(as.vector(x$p)) + } else { + as.numeric(as.vector(x$pd)) + } } else { as.vector(x) } @@ -627,3 +682,7 @@ as.numeric.p_direction <- function(x, ...) { #' @method as.double p_direction #' @export as.double.p_direction <- as.numeric.p_direction + +#' @method as.vector p_direction +#' @export +as.vector.p_direction <- as.numeric.p_direction diff --git a/man/p_direction.Rd b/man/p_direction.Rd index bbbe0c717..250e513e6 100644 --- a/man/p_direction.Rd +++ b/man/p_direction.Rd @@ -35,9 +35,23 @@ pd(x, ...) ... ) -\method{p_direction}{MCMCglmm}(x, method = "direct", null = 0, as_p = FALSE, ...) +\method{p_direction}{MCMCglmm}( + x, + method = "direct", + null = 0, + as_p = FALSE, + remove_na = TRUE, + ... +) -\method{p_direction}{emmGrid}(x, method = "direct", null = 0, as_p = FALSE, ...) +\method{p_direction}{emmGrid}( + x, + method = "direct", + null = 0, + as_p = FALSE, + remove_na = TRUE, + ... +) \method{p_direction}{stanreg}( x, @@ -48,6 +62,7 @@ pd(x, ...) method = "direct", null = 0, as_p = FALSE, + remove_na = TRUE, ... ) @@ -59,16 +74,25 @@ pd(x, ...) method = "direct", null = 0, as_p = FALSE, + remove_na = TRUE, ... ) -\method{p_direction}{BFBayesFactor}(x, method = "direct", null = 0, as_p = FALSE, ...) +\method{p_direction}{BFBayesFactor}( + x, + method = "direct", + null = 0, + as_p = FALSE, + remove_na = TRUE, + ... +) \method{p_direction}{get_predicted}( x, method = "direct", null = 0, as_p = FALSE, + remove_na = TRUE, use_iterations = FALSE, verbose = TRUE, ... diff --git a/tests/testthat/test-p_direction.R b/tests/testthat/test-p_direction.R index 226c5bb9f..9c073bec4 100644 --- a/tests/testthat/test-p_direction.R +++ b/tests/testthat/test-p_direction.R @@ -3,6 +3,15 @@ test_that("p_direction", { x <- distribution_normal(10000, 1, 1) pd <- p_direction(x) expect_equal(as.numeric(pd), 0.842, tolerance = 0.1) + # converstion into frequentist p-value works + p <- p_direction(x, as_p = TRUE) + expect_equal(as.numeric(p), pd_to_p(pd$pd), tolerance = 0.1) + # return NA + expect_true(is.na(as.numeric(p_direction(c(x, NA), remove_na = FALSE)))) + # works + expect_equal(as.numeric(p_direction(c(x, NA))), 0.8413, tolerance = 0.1) + # error if only NA + expect_error(p_direction(c(NA_real_, NA_real_)), regex = "No valid values found") expect_equal(as.numeric(p_direction(x, method = "kernel")), 0.842, tolerance = 0.1) expect_s3_class(pd, "p_direction") expect_s3_class(pd, "data.frame")