From 6554f8c3740a61d0876680c419cc2beba13f1bc6 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sun, 19 May 2024 10:22:54 +0200 Subject: [PATCH 1/4] Use insight and dw remotes --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 444a32b23..14ce71a14 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -125,3 +125,4 @@ Config/Needs/website: rstudio/bslib, r-lib/pkgdown, easystats/easystatstemplate +Remotes: easystats/insight, easystats/datawizard From 525e3d604624b43b2f04de3569f767221ed3402f Mon Sep 17 00:00:00 2001 From: Daniel Date: Sun, 19 May 2024 11:21:00 +0200 Subject: [PATCH 2/4] lintr, fix --- R/diagnostic_posterior.R | 14 +++++++------- R/estimate_density.R | 20 ++++++++++---------- 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/R/diagnostic_posterior.R b/R/diagnostic_posterior.R index 32865c7ec..f61850be0 100644 --- a/R/diagnostic_posterior.R +++ b/R/diagnostic_posterior.R @@ -78,7 +78,7 @@ diagnostic_posterior.stanreg <- function(posterior, diagnostic = "all", effects # If no diagnostic if (is.null(diagnostic)) { - return(data.frame("Parameter" = params)) + return(data.frame(Parameter = params)) } diagnostic <- match.arg(diagnostic, c("ESS", "Rhat", "MCSE", "all"), several.ok = TRUE) @@ -136,7 +136,7 @@ diagnostic_posterior.stanmvreg <- function(posterior, # If no diagnostic if (is.null(diagnostic)) { - return(data.frame("Parameter" = params)) + return(data.frame(Parameter = params)) } diagnostic <- match.arg(diagnostic, c("ESS", "Rhat", "MCSE", "all"), several.ok = TRUE) @@ -197,15 +197,15 @@ diagnostic_posterior.brmsfit <- function(posterior, # If no diagnostic if (is.null(diagnostic)) { - return(data.frame("Parameter" = params)) + return(data.frame(Parameter = params)) } # Get diagnostic diagnostic <- match.arg(diagnostic, c("ESS", "Rhat", "MCSE", "all"), several.ok = TRUE) if ("all" %in% diagnostic) { diagnostic <- c("ESS", "Rhat", "MCSE", "khat") # Add MCSE - } else { - if ("Rhat" %in% diagnostic) diagnostic <- c(diagnostic, "khat") + } else if ("Rhat" %in% diagnostic) { + diagnostic <- c(diagnostic, "khat") } insight::check_if_installed("rstan") @@ -241,7 +241,7 @@ diagnostic_posterior.stanfit <- function(posterior, diagnostic = "all", effects # If no diagnostic if (is.null(diagnostic)) { - return(data.frame("Parameter" = params)) + return(data.frame(Parameter = params)) } # Get diagnostic @@ -288,7 +288,7 @@ diagnostic_posterior.blavaan <- function(posterior, diagnostic = "all", ...) { # Find parameters params <- suppressWarnings(insight::find_parameters(posterior, flatten = TRUE)) - out <- data.frame("Parameter" = params) + out <- data.frame(Parameter = params) # If no diagnostic if (is.null(diagnostic)) { diff --git a/R/estimate_density.R b/R/estimate_density.R index cd0f261f2..bcdd50aa3 100644 --- a/R/estimate_density.R +++ b/R/estimate_density.R @@ -258,7 +258,7 @@ estimate_density.data.frame <- function(x, } else { # Deal with at- grouping -------- - groups <- insight::get_datagrid(x[, at, drop = FALSE], at = at) # Get combinations + groups <- insight::get_datagrid(x[, at, drop = FALSE], by = at) # Get combinations out <- data.frame() for (row in seq_len(nrow(groups))) { subdata <- datawizard::data_match(x, groups[row, , drop = FALSE]) @@ -607,8 +607,8 @@ as.data.frame.density <- function(x, ...) { #' density_at(posterior, c(0, 1)) #' @export density_at <- function(posterior, x, precision = 2^10, method = "kernel", ...) { - density <- estimate_density(posterior, precision = precision, method = method, ...) - stats::approx(density$x, density$y, xout = x)$y + posterior_density <- estimate_density(posterior, precision = precision, method = method, ...) + stats::approx(posterior_density$x, posterior_density$y, xout = x)$y } @@ -620,7 +620,7 @@ density_at <- function(posterior, x, precision = 2^10, method = "kernel", ...) { dots[c("effects", "component", "parameters")] <- NULL # Get the kernel density estimation (KDE) - args <- c(dots, list( + my_args <- c(dots, list( x = x, n = precision, bw = bw, @@ -628,8 +628,8 @@ density_at <- function(posterior, x, precision = 2^10, method = "kernel", ...) { to = x_range[2] )) fun <- get("density", asNamespace("stats")) - kde <- suppressWarnings(do.call("fun", args)) - df <- as.data.frame(kde) + kde <- suppressWarnings(do.call("fun", my_args)) + my_df <- as.data.frame(kde) # Get CI (https://bookdown.org/egarpor/NP-UC3M/app-kde-ci.html) if (!is.null(ci)) { @@ -637,13 +637,13 @@ density_at <- function(posterior, x, precision = 2^10, method = "kernel", ...) { # R(K) for a normal Rk <- 1 / (2 * sqrt(pi)) # Estimate the SD - sd_kde <- sqrt(df$y * Rk / (length(x) * h)) + sd_kde <- sqrt(my_df$y * Rk / (length(x) * h)) # CI with estimated variance z_alpha <- stats::qnorm(ci) - df$CI_low <- df$y - z_alpha * sd_kde - df$CI_high <- df$y + z_alpha * sd_kde + my_df$CI_low <- my_df$y - z_alpha * sd_kde + my_df$CI_high <- my_df$y + z_alpha * sd_kde } - df + my_df } From a6584995908a521091d317071b796df37045f68e Mon Sep 17 00:00:00 2001 From: Daniel Date: Sun, 19 May 2024 11:22:32 +0200 Subject: [PATCH 3/4] fix --- vignettes/bayes_factors.Rmd | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/vignettes/bayes_factors.Rmd b/vignettes/bayes_factors.Rmd index b774b6951..fd66023e6 100644 --- a/vignettes/bayes_factors.Rmd +++ b/vignettes/bayes_factors.Rmd @@ -217,7 +217,7 @@ ggplot(mapping = aes(x_vals, d_vals, fill = in_null, group = range_groups)) + labs(x = "Drug effect", y = "Density") + coord_cartesian(ylim = c(0, 0.45)) + theme_modern() + - theme(legend.position = c(0.2, 0.8)) + theme(legend.position.inside = c(0.2, 0.8)) pnull <- diff(pnorm(null, sd = 3)) prior_odds <- (1 - pnull) / pnull @@ -249,7 +249,7 @@ ggplot(mapping = aes(x_vals, d_vals_post, fill = in_null, group = range_groups)) labs(x = "Drug effect", y = "Density") + coord_cartesian(ylim = c(0, 0.45)) + theme_modern() + - theme(legend.position = c(0.2, 0.8)) + theme(legend.position.inside = c(0.2, 0.8)) My_first_BF <- bayesfactor_parameters(model, null = c(-1, 1), prior = model_prior) @@ -721,7 +721,7 @@ virginica actually have shorter sepals! ggplot(iris, aes(Petal.Length, Sepal.Length, color = Species)) + geom_point() + scale_color_flat() + - theme(legend.position = c(0.2, 0.8)) + theme(legend.position.inside = c(0.2, 0.8)) ``` Note that these Bayes factors compare the restricted model to the unrestricted From 3a5e29d4243a56ca308ffc0d80c05bb9571a5634 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sun, 19 May 2024 13:48:06 +0200 Subject: [PATCH 4/4] fix --- tests/testthat/test-check_prior.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-check_prior.R b/tests/testthat/test-check_prior.R index c52c1da23..50028c4e2 100644 --- a/tests/testthat/test-check_prior.R +++ b/tests/testthat/test-check_prior.R @@ -81,7 +81,7 @@ test_that("check_prior - brms (linux)", { ) # TODO: check hard-coded values - expect_warning(expect_equal( + expect_warning(expect_identical( check_prior(model2)$Prior_Quality, c( "uninformative", "informative", "informative", "uninformative", @@ -92,7 +92,7 @@ test_that("check_prior - brms (linux)", { expect_warning(expect_identical( check_prior(model2, method = "lakeland")$Prior_Quality, c( - "informative", "informative", "informative", "informative", + "informative", "misinformative", "informative", "informative", "informative", "not determinable", "not determinable", "not determinable" ) ))