From d85d397debafc9e7a3a3c2c0afb13d5b3e1d76ea Mon Sep 17 00:00:00 2001 From: jgabry Date: Thu, 10 Nov 2022 16:33:01 -0700 Subject: [PATCH] prep for release * fix r cmd check issues from #282 * fix ggplot test issues (closes #289) * add @TeemuSailynoja as contributor --- DESCRIPTION | 7 ++- NEWS.md | 12 +++- R/bayesplot-colors.R | 2 +- R/helpers-gg.R | 2 +- R/helpers-ppc.R | 8 +-- R/mcmc-diagnostics-nuts.R | 6 +- R/mcmc-traces.R | 2 +- R/ppc-distributions.R | 10 +-- tests/testthat/test-bayesplot_grid.R | 3 +- tests/testthat/test-convenience-functions.R | 70 ++++++++++----------- tests/testthat/test-extractors.R | 3 +- 11 files changed, 64 insertions(+), 61 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5c095f9a..5a0fa984 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: bayesplot Type: Package Title: Plotting for Bayesian Models -Version: 1.9.0.9000 -Date: 2022-03-09 +Version: 1.10.0 +Date: 2022-11-10 Authors@R: c(person("Jonah", "Gabry", role = c("aut", "cre"), email = "jsg2201@columbia.edu"), person("Tristan", "Mahr", role = "aut"), person("Paul-Christian", "Bürkner", role = "ctb"), @@ -10,6 +10,7 @@ Authors@R: c(person("Jonah", "Gabry", role = c("aut", "cre"), email = "jsg2201@c person("Malcolm", "Barrett", role = "ctb"), person("Frank", "Weber", role = "ctb"), person("Eduardo", "Coronado Sroka", role = "ctb"), + person("Teemu", "Sailynoja", role = "ctb"), person("Aki", "Vehtari", role = "ctb")) Maintainer: Jonah Gabry Description: Plotting functions for posterior analysis, MCMC diagnostics, @@ -25,7 +26,7 @@ URL: https://mc-stan.org/bayesplot/ BugReports: https://github.com/stan-dev/bayesplot/issues/ SystemRequirements: pandoc (>= 1.12.3), pandoc-citeproc Depends: - R (>= 3.1.0) + R (>= 3.5.0) Imports: dplyr (>= 0.8.0), ggplot2 (>= 3.0.0), diff --git a/NEWS.md b/NEWS.md index e07d10bb..66477e17 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,14 @@ -# bayesplot 1.9.0.9000 - -Items for next release go here +# bayesplot 1.10.0 + +* New function `mcmc_rank_ecdf()` for rank ecdf plots with confidence bands for +assessing if two or more chains sample the same distribution (#282, +@TeemuSailynoja) +* New functions `ppc_pit_ecdf()`, `ppc_pit_ecdf_grouped()`, PIT ecdf plots with +confidence bands to assess if `y` and `yrep` contain samples from the same +distribution. (#282, @TeemuSailynoja) +* Fix failing tests due to latest ggplot2 release (#289) # bayesplot 1.9.0 diff --git a/R/bayesplot-colors.R b/R/bayesplot-colors.R index 23b98d62..6754e7f3 100644 --- a/R/bayesplot-colors.R +++ b/R/bayesplot-colors.R @@ -221,7 +221,7 @@ plot_scheme <- function(scheme = NULL) { value = rep(1, length(x)) ) - ggplot(color_data, aes_(x = ~ name, y = ~ value, fill = ~ group)) + + ggplot(color_data, aes(x = .data$name, y = .data$value, fill = .data$group)) + geom_bar( width = .5, stat = "identity", diff --git a/R/helpers-gg.R b/R/helpers-gg.R index 6bd0a585..1f629071 100644 --- a/R/helpers-gg.R +++ b/R/helpers-gg.R @@ -100,7 +100,7 @@ set_hist_aes <- function(freq = TRUE, ...) { if (freq) { aes_(x = ~ value, ...) } else { - aes_(x = ~ value, y = ~ stat(density), ...) + aes_(x = ~ value, y = ~ after_stat(density), ...) } } diff --git a/R/helpers-ppc.R b/R/helpers-ppc.R index 8d0f4fed..efebab21 100644 --- a/R/helpers-ppc.R +++ b/R/helpers-ppc.R @@ -448,21 +448,19 @@ interpolate_gamma <- function(N, K, prob, L) { #' @noRd get_interpolation_values <- function(N, K, L, prob) { for (dim in c("L", "prob")) { - if (all(get(dim) != bayesplot:::gamma_adj[, dim])) { + if (all(get(dim) != gamma_adj[, dim])) { stop(paste( "No precomputed values to interpolate from for '", dim, "' = ", get(dim), ".\n", "Values of '", dim, "' available for interpolation: ", - paste(unique(bayesplot:::gamma_adj[, dim]), collapse = ", "), + paste(unique(gamma_adj[, dim]), collapse = ", "), ".", sep = "" )) } } - vals <- bayesplot:::gamma_adj[ - bayesplot:::gamma_adj$L == L & bayesplot:::gamma_adj$prob == prob, - ] + vals <- gamma_adj[gamma_adj$L == L & gamma_adj$prob == prob, ] if (N > max(vals$N)) { stop(paste( "No precomputed values to interpolate from for sample length of ", diff --git a/R/mcmc-diagnostics-nuts.R b/R/mcmc-diagnostics-nuts.R index cbaccdfa..87792fb7 100644 --- a/R/mcmc-diagnostics-nuts.R +++ b/R/mcmc-diagnostics-nuts.R @@ -154,7 +154,7 @@ mcmc_nuts_acceptance <- Mean = mean(.data$Value), Median = median(.data$Value)) - hists <- ggplot(data, aes_(x = ~ Value, y = ~ ..density..)) + + hists <- ggplot(data, aes_(x = ~ Value, y = ~ after_stat(density))) + geom_histogram( fill = get_color("l"), color = get_color("lh"), @@ -354,7 +354,7 @@ mcmc_nuts_treedepth <- function(x, lp, chain = NULL, ...) { treedepth <- dplyr::filter(x, .data$Parameter == "treedepth__") accept_stat <- dplyr::filter(x, .data$Parameter == "accept_stat__") - hist_td <- ggplot(treedepth, aes_(x = ~ Value, y = ~ ..density..)) + + hist_td <- ggplot(treedepth, aes_(x = ~ Value, y = ~ after_stat(density))) + geom_histogram( fill = get_color("l"), color = get_color("lh"), @@ -450,7 +450,7 @@ mcmc_nuts_energy <- clrs <- set_names(get_color(c("lh", "mh")), c("E_fill", "Ediff_fill")) aes_labs <- c(expression(pi[E]), expression(pi[paste(Delta, E)])) - graph <- ggplot(data, aes_(y = ~ ..density..)) + + graph <- ggplot(data, aes_(y = ~ after_stat(density))) + geom_histogram( aes_( x = ~ Ediff_centered, diff --git a/R/mcmc-traces.R b/R/mcmc-traces.R index ce65db93..ec2df8bd 100644 --- a/R/mcmc-traces.R +++ b/R/mcmc-traces.R @@ -504,7 +504,7 @@ mcmc_rank_ecdf <- x = x ) data <- data %>% - group_by(parameter, chain) %>% + group_by(.data$parameter, .data$chain) %>% dplyr::group_map(~ data.frame( parameter = .y[1], chain = .y[2], diff --git a/R/ppc-distributions.R b/R/ppc-distributions.R index 237586b2..e3897a82 100644 --- a/R/ppc-distributions.R +++ b/R/ppc-distributions.R @@ -70,12 +70,12 @@ #' \donttest{ #' # ppc_ecdf_overlay with continuous data (set discrete=TRUE if discrete data) #' ppc_ecdf_overlay(y, yrep[sample(nrow(yrep), 25), ]) -#' } +#' #' # ECDF and ECDF difference plot of the PIT values of ´y´ compared to ´yrep #' # with 99% simultaneous confidence bands. #' ppc_pit_ecdf(y, yrep, prob = 0.99, plot_diff = FALSE, interpolate_adj = FALSE) #' ppc_pit_ecdf(y, yrep, prob = 0.99, interpolate_adj = FALSE) -#' +#' } #' #' # for ppc_hist,dens,freqpoly,boxplot definitely use a subset yrep rows so #' # only a few (instead of nrow(yrep)) histograms are plotted @@ -104,9 +104,11 @@ #' #' ppc_ecdf_overlay_grouped(y, yrep[1:25, ], group = group) #' +#' \donttest{ #' # ECDF difference plots of the PIT values by group #' # with 99% simultaneous confidence bands. #' ppc_pit_ecdf_grouped(y, yrep, group=group, prob=0.99, interpolate_adj=FALSE) +#' } #' #' # don't need to only use small number of rows for ppc_violin_grouped #' # (as it pools yrep draws within groups) @@ -596,7 +598,7 @@ ppc_pit_ecdf <- function(y, if (is.null(pit)) { pit <- ppc_data(y, yrep) %>% - group_by(y_id) %>% + group_by(.data$y_id) %>% dplyr::group_map(~ mean(.x$value[.x$is_y] >= .x$value[!.x$is_y])) %>% unlist() if (is.null(K)) { @@ -661,7 +663,7 @@ ppc_pit_ecdf_grouped <- if (is.null(pit)) { pit <- ppc_data(y, yrep, group) %>% - group_by(y_id) %>% + group_by(.data$y_id) %>% dplyr::group_map(~ mean(.x$value[.x$is_y] >= .x$value[!.x$is_y])) %>% unlist() if (is.null(K)) { diff --git a/tests/testthat/test-bayesplot_grid.R b/tests/testthat/test-bayesplot_grid.R index 2b0d5bee..8297d6b6 100644 --- a/tests/testthat/test-bayesplot_grid.R +++ b/tests/testthat/test-bayesplot_grid.R @@ -30,7 +30,8 @@ test_that("bayesplot_grid throws correct errors", { test_that("bayesplot_grid works", { expect_message( a <- bayesplot_grid(p1, p2, xlim = c(-200, 200), ylim = c(0, 200)), - "Adding another scale for 'y'" + "is already present", + fixed = TRUE ) expect_silent( b <- bayesplot_grid(plots = list(p1, p2), diff --git a/tests/testthat/test-convenience-functions.R b/tests/testthat/test-convenience-functions.R index bd64112c..7462bda5 100644 --- a/tests/testthat/test-convenience-functions.R +++ b/tests/testthat/test-convenience-functions.R @@ -5,41 +5,38 @@ context("Convenience functions (for ggplot objects)") # abline_01, vline_ and hline_ ------------------------------------------ test_that("abline_01 returns the correct object", { - expect_equal( - abline_01(color = "green", linetype = 2), - geom_abline(intercept = 0, slope = 1, color = "green", linetype = 2, na.rm = TRUE), - check.environment = FALSE - ) + a <- abline_01(color = "green", linetype = 2) + b <- geom_abline(intercept = 0, slope = 1, color = "green", linetype = 2, na.rm = TRUE) + a$constructor <- b$constructor <- NULL + expect_equal(a, b, check.environment = FALSE) }) test_that("vline_* and hline_* return correct objects", { - expect_equal( - vline_0(color = "red"), - geom_vline(xintercept = 0, color = "red", na.rm = TRUE), - check.environment = FALSE - ) - expect_equal( - hline_0(size = 2, linetype = 3), - geom_hline(yintercept = 0, size = 2, linetype = 3, na.rm = TRUE), - check.environment = FALSE - ) - expect_equal( - vline_at(c(3,4), na.rm = FALSE), - geom_vline(xintercept = c(3,4)), - check.environment = FALSE - ) - expect_equal( - hline_at(c(3,4), na.rm = FALSE), - geom_hline(yintercept = c(3,4)), - check.environment = FALSE - ) + a <- vline_0(color = "red") + b <- geom_vline(xintercept = 0, color = "red", na.rm = TRUE) + a$constructor <- b$constructor <- NULL + expect_equal(a, b, check.environment = FALSE) + + a <- hline_0(linewidth = 2, linetype = 3) + b <- geom_hline(yintercept = 0, linewidth = 2, linetype = 3, na.rm = TRUE) + a$constructor <- b$constructor <- NULL + expect_equal(a, b, check.environment = FALSE) + + a <- vline_at(c(3,4), na.rm = FALSE) + b <- geom_vline(xintercept = c(3,4)) + a$constructor <- b$constructor <- NULL + expect_equal(a, b, check.environment = FALSE) + + a <- hline_at(c(3,4), na.rm = FALSE) + b <- geom_hline(yintercept = c(3,4)) + a$constructor <- b$constructor <- NULL + expect_equal(a, b, check.environment = FALSE) }) test_that("vline_at with 'fun' works", { x <- example_mcmc_draws(chains = 1) - expect_equal( - vline_at(x, colMeans), - geom_vline(xintercept = colMeans(x), na.rm = TRUE), - check.environment = FALSE - ) + a <- vline_at(x, colMeans) + b <- geom_vline(xintercept = colMeans(x), na.rm = TRUE) + a$constructor <- b$constructor <- NULL + expect_equal(a, b, check.environment = FALSE) }) test_that("calc_v (internal function) works", { a <- 1:4 @@ -70,8 +67,8 @@ test_that("lbub works", { # plot and facet backgrounds ---------------------------------------------- test_that("grid_lines returns correct theme object", { thm <- theme_default() + grid_lines(size = 1.5, color = "purple") - expect_equal(thm$panel.grid.major, element_line(size = 1.5, color = "purple")) - expect_equal(thm$panel.grid.minor, element_line(size = 0.75, color = "purple")) + expect_equal(thm$panel.grid.major, element_line(linewidth = 1.5, color = "purple")) + expect_equal(thm$panel.grid.minor, element_line(linewidth = 0.75, color = "purple")) }) test_that("panel_bg returns correct theme object", { bg1 <- panel_bg() @@ -182,9 +179,8 @@ test_that("yaxis_ticks returns correct theme object", { # overlay functions ------------------------------------------------------- test_that("overlay_function returns the correct object", { expect_error(overlay_function(), 'argument "fun" is missing') - expect_equal( - overlay_function(fun = "dnorm"), - stat_function(fun = "dnorm", inherit.aes = FALSE), - check.environment = FALSE - ) + a <- overlay_function(fun = "dnorm") + b <- stat_function(fun = "dnorm", inherit.aes = FALSE) + a$constructor <- b$constructor <- NULL + expect_equal(a, b, check.environment = FALSE) }) diff --git a/tests/testthat/test-extractors.R b/tests/testthat/test-extractors.R index 732fe3b3..5cb990ce 100644 --- a/tests/testthat/test-extractors.R +++ b/tests/testthat/test-extractors.R @@ -121,8 +121,7 @@ test_that("cmdstanr methods work", { fit <- cmdstanr::cmdstanr_example("logistic", iter_sampling = 500, chains = 2) np <- nuts_params(fit) - np_names <- paste0(c("treedepth", "divergent", "accept_stat", "stepsize", - "n_leapfrog", "energy"), "__") + np_names <- paste0(c("treedepth", "divergent", "energy", "accept_stat", "stepsize", "n_leapfrog"), "__") expect_identical(levels(np$Parameter), np_names) expect_equal(range(np$Iteration), c(1, 500)) expect_equal(range(np$Chain), c(1, 2))