From 2e87b6eb0010edca25ccc4bd53823eb142b35196 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= <38475991+FBartos@users.noreply.github.com> Date: Mon, 30 Oct 2023 09:18:37 +0100 Subject: [PATCH] ggplot2 version of the z-curve plot (#14) --- .github/workflows/R-CMD-check.yaml | 14 +- .github/workflows/R-CMD-tests.yaml | 11 +- .github/workflows/pkgdown.yaml | 6 +- DESCRIPTION | 8 +- NAMESPACE | 1 + NEWS.md | 3 + R/main.R | 359 ++++++++++++++---- R/zcurve-package.R | 1 + R/zcurve_EM.R | 2 +- R/zcurve_density.R | 4 +- man/control_EM.Rd | 2 +- man/control_density.Rd | 2 +- man/control_density_v1.Rd | 2 +- man/plot.zcurve.Rd | 7 + man/zcurve.Rd | 2 +- .../_snaps/zcurve/z-curve-cens-em-ggplot.svg | 89 +++++ .../z-curve-clustered-mixed-ggplot-1.svg | 100 +++++ .../z-curve-clustered-mixed-ggplot-2.svg | 100 +++++ .../_snaps/zcurve/z-curve-em-ggplot.svg | 108 ++++++ .../_snaps/zcurve/z-curve-kd2-ggplot.svg | 99 +++++ .../_snaps/zcurve/z-curve-mixed-em-ggplot.svg | 89 +++++ tests/testthat/test-zcurve.R | 9 +- 22 files changed, 915 insertions(+), 103 deletions(-) create mode 100644 tests/testthat/_snaps/zcurve/z-curve-cens-em-ggplot.svg create mode 100644 tests/testthat/_snaps/zcurve/z-curve-clustered-mixed-ggplot-1.svg create mode 100644 tests/testthat/_snaps/zcurve/z-curve-clustered-mixed-ggplot-2.svg create mode 100644 tests/testthat/_snaps/zcurve/z-curve-em-ggplot.svg create mode 100644 tests/testthat/_snaps/zcurve/z-curve-kd2-ggplot.svg create mode 100644 tests/testthat/_snaps/zcurve/z-curve-mixed-em-ggplot.svg diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 0d25c63..237cc7b 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -6,13 +6,11 @@ on: - main - master - pre-release - - censored pull_request: branches: - main - master - pre-release - - censored name: R-CMD-check @@ -28,7 +26,7 @@ jobs: config: - {os: windows-latest, r: 'release'} - {os: macOS-latest, r: 'release'} - - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} + - {os: ubuntu-latest, r: 'release'} env: R_REMOTES_NO_ERRORS_FROM_WARNINGS: true @@ -36,13 +34,13 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - - uses: r-lib/actions/setup-r@v1 + - uses: r-lib/actions/setup-r@v2 with: r-version: ${{ matrix.config.r }} - - uses: r-lib/actions/setup-pandoc@v1 + - uses: r-lib/actions/setup-pandoc@v2 - name: Query dependencies run: | @@ -64,8 +62,7 @@ jobs: while read -r cmd do eval sudo $cmd - apt-get install libcurl4-openssl-dev - done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))') + sudo apt-get install libcurl4-openssl-dev - name: Install dependencies run: | @@ -90,7 +87,6 @@ jobs: if: runner.os == 'Windows' env: _R_CHECK_CRAN_INCOMING_REMOTE_: false - JAGS_ROOT: "/c/progra~1/JAGS/JAGS-4.2.0" run: | options(crayon.enabled = TRUE) rcmdcheck::rcmdcheck( diff --git a/.github/workflows/R-CMD-tests.yaml b/.github/workflows/R-CMD-tests.yaml index d05bf8f..d2682c1 100644 --- a/.github/workflows/R-CMD-tests.yaml +++ b/.github/workflows/R-CMD-tests.yaml @@ -6,13 +6,11 @@ on: - main - master - pre-release - - censored pull_request: branches: - main - master - pre-release - - censored name: R-CMD-tests @@ -28,7 +26,7 @@ jobs: config: - {os: windows-latest, r: 'release'} - {os: macOS-latest, r: 'release'} - - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} + - {os: ubuntu-latest, r: 'release'} env: R_REMOTES_NO_ERRORS_FROM_WARNINGS: true @@ -36,13 +34,13 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - - uses: r-lib/actions/setup-r@v1 + - uses: r-lib/actions/setup-r@v2 with: r-version: ${{ matrix.config.r }} - - uses: r-lib/actions/setup-pandoc@v1 + - uses: r-lib/actions/setup-pandoc@v2 - name: Query dependencies run: | @@ -64,7 +62,6 @@ jobs: while read -r cmd do eval sudo $cmd - done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))') - name: Install and test z-curve (non-Windows) diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index e809466..225c2c8 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -14,11 +14,11 @@ jobs: env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - - uses: r-lib/actions/setup-r@v1 + - uses: r-lib/actions/setup-r@v2 - - uses: r-lib/actions/setup-pandoc@v1 + - uses: r-lib/actions/setup-pandoc@v2 - name: Query dependencies run: | diff --git a/DESCRIPTION b/DESCRIPTION index 52b936b..d323d92 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: zcurve Title: An Implementation of Z-Curves -Version: 2.3.0 +Version: 2.4.0 Authors@R: c( person("František", "Bartoš", email = "f.bartos96@gmail.com", role = c("aut", "cre")), person("Ulrich", "Schimmack", email = "ulrich.schimmack@utoronto.ca", role = c("aut"))) @@ -17,14 +17,16 @@ License: GPL-3 Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.1 +RoxygenNote: 7.2.3 Imports: Rcpp (>= 1.0.2), nleqslv, stats, evmix, graphics, - Rdpack + ggplot2, + Rdpack, + rlang LinkingTo: Rcpp Suggests: parallel, diff --git a/NAMESPACE b/NAMESPACE index a08a7bd..8390457 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -33,5 +33,6 @@ export(zcurve_clustered) export(zcurve_data) importFrom(Rcpp,sourceCpp) importFrom(Rdpack,reprompt) +importFrom(rlang,.data) importFrom(utils,head) useDynLib(zcurve, .registration = TRUE) diff --git a/NEWS.md b/NEWS.md index 1bc230a..becec42 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,6 @@ +## version 2.4.0 +- Implementation of ggploting function. + ## version 2.3.0 - Implementation of parallel bootstrap. diff --git a/R/main.R b/R/main.R index a23046e..2d499ef 100644 --- a/R/main.R +++ b/R/main.R @@ -66,7 +66,7 @@ #' "max_iter" = 9999, #' "alpha" = .10 #' ) -#' \donttest{m1.EM <- zcurve(OSC.z, method = "EM", bootstrap = FALSE, control = ctr1)} +#' \dontrun{m1.EM <- zcurve(OSC.z, method = "EM", bootstrap = FALSE, control = ctr1)} #' # see '?control_EM' and '?control_density' for more information about different #' # z-curves specifications #' @seealso [summary.zcurve()], [plot.zcurve()], [control_EM], [control_density] @@ -540,6 +540,9 @@ print.summary.zcurve <- function(x, ...){ #' to \code{FALSE}. #' @param extrapolate Scale the chart to the extrapolated area. Defaults #' to \code{FALSE}. +#' @param plot_type Type of plot to by produced. Defaults to \code{"base"} +#' for th base plotting function. An alternative is \code{"ggplot"} for a +#' ggplot2. #' @param y.anno A vector of length 8 specifying the y-positions #' of the individual annotation lines relative to the figure's height. #' Defaults to \code{c(.95, .88, .78, .71, .61, .53, .43, .35)} @@ -553,7 +556,7 @@ print.summary.zcurve <- function(x, ...){ #' @export plot.zcurve #' @rawNamespace S3method(plot, zcurve) #' -#' @examples +#' @examples \dontrun{ #' # simulate some z-statistics and fit a z-curve #' z <- abs(rnorm(300,3)) #' m.EM <- zcurve(z, method = "EM", bootstrap = 100) @@ -566,11 +569,21 @@ print.summary.zcurve <- function(x, ...){ #' #' # change the location of the annotation to the left #' plot(m.EM, annotation = TRUE, CI = TRUE, x_text = 0) +#' } #' @seealso [zcurve()] -plot.zcurve <- function(x, annotation = FALSE, CI = FALSE, extrapolate = FALSE, +plot.zcurve <- function(x, annotation = FALSE, CI = FALSE, extrapolate = FALSE, plot_type = "base", y.anno = c(.95, .88, .78, .71, .61, .53, .43, .35), x.anno = .6, cex.anno = 1, ...){ - if(is.null(x$boot))CI <- FALSE + if(is.null(x$boot)) + CI <- FALSE + + if(substr(tolower(plot_type), 1, 1) == "b"){ + plot_type <- "base" + }else if(substr(tolower(plot_type), 1, 1) == "g"){ + plot_type <- "ggplot" + }else{ + stop("Unrecognized `plot_type` argument. The possibly options are `base` and `ggplot`.") + } additional <- list(...) if(is.null(additional$main)){ @@ -701,86 +714,286 @@ plot.zcurve <- function(x, annotation = FALSE, CI = FALSE, extrapolate x_min <- 0 } - # plot z-scores used for fitting - graphics::plot(h1, - freq = FALSE, density = 0, angle = 0, border = "blue", - xlim = c(x_min, x_max), - ylim = c(y_min, y_max), - ylab = ylab, - xlab = xlab, - main = main, - cex.lab = cex.lab, - cex.axis = cex.axis, - lwd = 1, las = 1) - # and un-used z-scores - if(!is.null(h2)){ - graphics::par(new=TRUE) - graphics::plot(h2, - freq = FALSE, density = 0, angle = 0, border ="grey30", + + if(plot_type == "base"){ + + # plot z-scores used for fitting + graphics::plot(h1, + freq = FALSE, density = 0, angle = 0, border = "blue", xlim = c(x_min, x_max), ylim = c(y_min, y_max), - axes = FALSE, ann = FALSE, lwd = 1, las = 1) - } - # add the density estimate if the model was estimated by density - if(x$method == "density"){ - graphics::lines(x$fit$density$x, x$fit$density$y, lty = 1, col = "grey60", lwd = 4) - } - # significance line - if(x.anno*x_max < x$control$a){ - graphics::lines(rep(x$control$a,2), c(0, (min(y.anno) - .025)*y_max), col = "blue", lty = 2, lwd = 1) - graphics::lines(rep(stats::qnorm(x$control$sig_level/2, lower.tail = FALSE),2), c(0, (min(y.anno) - .025)*y_max), col = "red", lty = 1, lwd = 2) - }else{ - graphics::abline(v = x$control$a, col = "blue", lty = 2, lwd = 1) - graphics::abline(v = stats::qnorm(x$control$sig_level/2, lower.tail = FALSE), col = "red", lty = 1, lwd = 2) - } - # predicted densities - graphics::lines(x_seq, y_den, lty = 1, col = "blue", lwd = 5) - if(CI & !is.null(x$boot)){ - graphics::lines(x_seq, y_den_l.CI, lty = 3, col = "blue", lwd = 3) - graphics::lines(x_seq, y_den_u.CI, lty = 3, col = "blue", lwd = 3) - } - # add annotation - if(annotation){ - x_summary <- summary(x) - - graphics::text(x.anno, y_max*y.anno[1] , paste0("Range: ",.r2d(min(x$data))," to ",.r2d(max(x$data))), - adj = c(0, 0), cex = cex.anno) - - graphics::text(x.anno, y_max*y.anno[2] , paste0(x_summary$model$N_all, " tests, ", x_summary$model$N_sig, " significant"), - adj = c(0, 0), cex = cex.anno) - - obs_proportion <- stats::prop.test(x_summary$model$N_sig, x_summary$model$N_all) - graphics::text(x.anno, y_max*y.anno[3] , paste0("Observed discovery rate:"), - adj = c(0, 0), cex = cex.anno) - graphics::text(x.anno, y_max*y.anno[4] , paste0(.r2d(obs_proportion$estimate), " 95% CI [", .r2d(obs_proportion$conf.int[1]), " ,", - .r2d(obs_proportion$conf.int[2]), "]"), - adj = c(0, 0), cex = cex.anno) - - if(!is.null(x$boot)){ - graphics::text(x.anno, y_max*y.anno[5] , paste0("Expected discovery rate:"), - adj = c(0, 0), cex = cex.anno) - graphics::text(x.anno, y_max*y.anno[6] , paste0(.r2d(x_summary$coefficients["EDR","Estimate"]), " 95% CI [", .r2d(x_summary$coefficients["EDR","l.CI"]), " ,", - .r2d(x_summary$coefficients["EDR","u.CI"]), "]"), - adj = c(0, 0), cex = cex.anno) - - graphics::text(x.anno, y_max*y.anno[7] , paste0("Expected replicability rate:"), - adj = c(0, 0), cex = cex.anno) - graphics::text(x.anno, y_max*y.anno[8] , paste0(.r2d(x_summary$coefficients["ERR","Estimate"]), " 95% CI [", .r2d(x_summary$coefficients["ERR","l.CI"]), " ,", - .r2d(x_summary$coefficients["ERR","u.CI"]), "]"), - adj = c(0, 0), cex = cex.anno) + ylab = ylab, + xlab = xlab, + main = main, + cex.lab = cex.lab, + cex.axis = cex.axis, + lwd = 1, las = 1) + # and un-used z-scores + if(!is.null(h2)){ + graphics::par(new=TRUE) + graphics::plot(h2, + freq = FALSE, density = 0, angle = 0, border ="grey30", + xlim = c(x_min, x_max), + ylim = c(y_min, y_max), + axes = FALSE, ann = FALSE, lwd = 1, las = 1) + } + # add the density estimate if the model was estimated by density + if(x$method == "density"){ + graphics::lines(x$fit$density$x, x$fit$density$y, lty = 1, col = "grey60", lwd = 4) + } + # significance line + if(x.anno*x_max < x$control$a){ + graphics::lines(rep(x$control$a,2), c(0, (min(y.anno) - .025)*y_max), col = "blue", lty = 2, lwd = 1) + graphics::lines(rep(stats::qnorm(x$control$sig_level/2, lower.tail = FALSE),2), c(0, (min(y.anno) - .025)*y_max), col = "red", lty = 1, lwd = 2) }else{ - graphics::text(x.anno, y_max*y.anno[5] , paste0("Expected discovery rate:"), + graphics::abline(v = x$control$a, col = "blue", lty = 2, lwd = 1) + graphics::abline(v = stats::qnorm(x$control$sig_level/2, lower.tail = FALSE), col = "red", lty = 1, lwd = 2) + } + # predicted densities + graphics::lines(x_seq, y_den, lty = 1, col = "blue", lwd = 5) + if(CI & !is.null(x$boot)){ + graphics::lines(x_seq, y_den_l.CI, lty = 3, col = "blue", lwd = 3) + graphics::lines(x_seq, y_den_u.CI, lty = 3, col = "blue", lwd = 3) + } + # add annotation + if(annotation){ + x_summary <- summary(x) + + graphics::text(x.anno, y_max*y.anno[1] , paste0("Range: ",.r2d(min(x$data))," to ",.r2d(max(x$data))), adj = c(0, 0), cex = cex.anno) - graphics::text(x.anno, y_max*y.anno[6] , paste0(.r2d(x_summary$coefficients["EDR","Estimate"])), + + graphics::text(x.anno, y_max*y.anno[2] , paste0(x_summary$model$N_all, " tests, ", x_summary$model$N_sig, " significant"), adj = c(0, 0), cex = cex.anno) - graphics::text(x.anno, y_max*y.anno[7] , paste0("Expected replicability rate:"), + obs_proportion <- stats::prop.test(x_summary$model$N_sig, x_summary$model$N_all) + graphics::text(x.anno, y_max*y.anno[3] , paste0("Observed discovery rate:"), adj = c(0, 0), cex = cex.anno) - graphics::text(x.anno, y_max*y.anno[8] , paste0(.r2d(x_summary$coefficients["ERR","Estimate"])), + graphics::text(x.anno, y_max*y.anno[4] , paste0(.r2d(obs_proportion$estimate), " 95% CI [", .r2d(obs_proportion$conf.int[1]), " ,", + .r2d(obs_proportion$conf.int[2]), "]"), adj = c(0, 0), cex = cex.anno) + + if(!is.null(x$boot)){ + graphics::text(x.anno, y_max*y.anno[5] , paste0("Expected discovery rate:"), + adj = c(0, 0), cex = cex.anno) + graphics::text(x.anno, y_max*y.anno[6] , paste0(.r2d(x_summary$coefficients["EDR","Estimate"]), " 95% CI [", .r2d(x_summary$coefficients["EDR","l.CI"]), " ,", + .r2d(x_summary$coefficients["EDR","u.CI"]), "]"), + adj = c(0, 0), cex = cex.anno) + + graphics::text(x.anno, y_max*y.anno[7] , paste0("Expected replicability rate:"), + adj = c(0, 0), cex = cex.anno) + graphics::text(x.anno, y_max*y.anno[8] , paste0(.r2d(x_summary$coefficients["ERR","Estimate"]), " 95% CI [", .r2d(x_summary$coefficients["ERR","l.CI"]), " ,", + .r2d(x_summary$coefficients["ERR","u.CI"]), "]"), + adj = c(0, 0), cex = cex.anno) + }else{ + graphics::text(x.anno, y_max*y.anno[5] , paste0("Expected discovery rate:"), + adj = c(0, 0), cex = cex.anno) + graphics::text(x.anno, y_max*y.anno[6] , paste0(.r2d(x_summary$coefficients["EDR","Estimate"])), + adj = c(0, 0), cex = cex.anno) + + graphics::text(x.anno, y_max*y.anno[7] , paste0("Expected replicability rate:"), + adj = c(0, 0), cex = cex.anno) + graphics::text(x.anno, y_max*y.anno[8] , paste0(.r2d(x_summary$coefficients["ERR","Estimate"])), + adj = c(0, 0), cex = cex.anno) + } + } + + return(invisible()) + + }else if(plot_type == "ggplot"){ + + out <- ggplot2::ggplot() + + ggplot2::scale_x_continuous( + name = xlab, + breaks = pretty(c(x_min, x_max)), + limits = c(x_min, x_max)) + + ggplot2::scale_y_continuous( + name = ylab, + breaks = pretty(c(y_min, y_max)), + limits = c(y_min, y_max)) + + ggplot2::ggtitle(main) + + ggplot2::theme_classic() + + # add significant z-scores + out <- out + ggplot2::geom_rect( + data = data.frame( + xmin = h1$breaks[-length(h1$breaks)], + xmax = h1$breaks[-1], + ymin = 0, + ymax = h1$density), + mapping = ggplot2::aes( + xmin = .data[["xmin"]], + xmax = .data[["xmax"]], + ymin = .data[["ymin"]], + ymax = .data[["ymax"]]), + fill = "white", col = "blue") + + # add non-significant z-scores (if any) + if(!is.null(h2)){ + out <- out + ggplot2::geom_rect( + data = data.frame( + xmin = h2$breaks[-length(h2$breaks)], + xmax = h2$breaks[-1], + ymin = 0, + ymax = h2$density), + mapping = ggplot2::aes( + xmin = .data[["xmin"]], + xmax = .data[["xmax"]], + ymin = .data[["ymin"]], + ymax = .data[["ymax"]]), + fill = "white", col = "grey") + } + + # add the density estimate if the model was estimated by density + if(x$method == "density"){ + out <- out + ggplot2::geom_line( + data = data.frame( + x = x$fit$density$x, + y = x$fit$density$y + ), + mapping = ggplot2::aes( + x = .data[["x"]], + y = .data[["y"]] + ), + linewidth = 1, col = "grey60", linetype = 4) } + + # significance line + if(x.anno*x_max < x$control$a){ + + #do not overdraw the annotation in case it is in the way + out <- out + ggplot2::geom_line( + data = data.frame( + x = rep(x$control$a,2), + y = c(0, (min(y.anno) - .025)*y_max) + ), + mapping = ggplot2::aes( + x = .data[["x"]], + y = .data[["y"]] + ), + linewidth = 1, col = "blue", linetype = 1) + out <- out + ggplot2::geom_line( + data = data.frame( + x = rep(stats::qnorm(x$control$sig_level/2, lower.tail = FALSE),2), + y = c(0, (min(y.anno) - .025)*y_max) + ), + mapping = ggplot2::aes( + x = .data[["x"]], + y = .data[["y"]] + ), + linewidth = 1.5, col = "red", linetype = 2) + + }else{ + + out <- out + ggplot2::geom_vline( + xintercept = x$control$a, + linewidth = 1, col = "blue", linetype = 1) + out <- out + ggplot2::geom_vline( + xintercept = stats::qnorm(x$control$sig_level/2, lower.tail = FALSE), + linewidth = 1.5, col = "red", linetype = 2) + + } + + # predicted densities + out <- out + ggplot2::geom_line( + data = data.frame( + x = x_seq, + y = y_den + ), + mapping = ggplot2::aes( + x = .data[["x"]], + y = .data[["y"]] + ), + linewidth = 2, col = "blue", linetype = 1) + + if(CI & !is.null(x$boot)){ + out <- out + ggplot2::geom_line( + data = data.frame( + x = x_seq, + y = y_den_l.CI + ), + mapping = ggplot2::aes( + x = .data[["x"]], + y = .data[["y"]] + ), + linewidth = 1.75, col = "blue", linetype = 3) + out <- out + ggplot2::geom_line( + data = data.frame( + x = x_seq, + y = y_den_u.CI + ), + mapping = ggplot2::aes( + x = .data[["x"]], + y = .data[["y"]] + ), + linewidth = 1.75, col = "blue", linetype = 3) + } + + # add annotation + if(annotation){ + + x_summary <- summary(x) + obs_proportion <- stats::prop.test(x_summary$model$N_sig, x_summary$model$N_all) + ggplot2_base_size <- 5 + + out <- out + ggplot2::geom_text( + data = data.frame( + x = x.anno, + y = y_max*y.anno[1:4], + label = c( + paste0("Range: ",.r2d(min(x$data))," to ",.r2d(max(x$data))), + paste0(x_summary$model$N_all, " tests, ", x_summary$model$N_sig, " significant"), + paste0("Observed discovery rate:"), + paste0(.r2d(obs_proportion$estimate), " 95% CI [", .r2d(obs_proportion$conf.int[1]), " ,", + .r2d(obs_proportion$conf.int[2]), "]") + ) + ), + mapping = ggplot2::aes( + x = .data[["x"]], + y = .data[["y"]], + label = .data[["label"]]), + hjust = 0, vjust = 0, size = ggplot2_base_size*cex.anno) + + if(!is.null(x$boot)){ + out <- out + ggplot2::geom_text( + data = data.frame( + x = x.anno, + y = y_max*y.anno[5:8], + label = c( + paste0("Expected discovery rate:"), + paste0(.r2d(x_summary$coefficients["EDR","Estimate"]), " 95% CI [", .r2d(x_summary$coefficients["EDR","l.CI"]), " ,", + .r2d(x_summary$coefficients["EDR","u.CI"]), "]"), + paste0("Expected replicability rate:"), + paste0(.r2d(x_summary$coefficients["ERR","Estimate"]), " 95% CI [", .r2d(x_summary$coefficients["ERR","l.CI"]), " ,", + .r2d(x_summary$coefficients["ERR","u.CI"]), "]") + ) + ), + mapping = ggplot2::aes( + x = .data[["x"]], + y = .data[["y"]], + label = .data[["label"]]), + hjust = 0, vjust = 0, size = ggplot2_base_size*cex.anno) + }else{ + out <- out + ggplot2::geom_text( + data = data.frame( + x = x.anno, + y = y_max*y.anno[5:8], + label = c( + paste0("Expected discovery rate:"), + paste0(.r2d(x_summary$coefficients["EDR","Estimate"])), + paste0("Expected replicability rate:"), + paste0(.r2d(x_summary$coefficients["ERR","Estimate"])) + ) + ), + mapping = ggplot2::aes( + x = .data[["x"]], + y = .data[["y"]], + label = .data[["label"]]), + hjust = 0, vjust = 0, size = ggplot2_base_size*cex.anno) + } + } + return(out) } } diff --git a/R/zcurve-package.R b/R/zcurve-package.R index 8dbddf8..24fbe20 100644 --- a/R/zcurve-package.R +++ b/R/zcurve-package.R @@ -8,5 +8,6 @@ #' @useDynLib zcurve, .registration = TRUE #' @importFrom Rcpp sourceCpp #' @importFrom Rdpack reprompt +#' @importFrom rlang .data ## usethis namespace: end NULL diff --git a/R/zcurve_EM.R b/R/zcurve_EM.R index 46cdb7c..22a6e78 100644 --- a/R/zcurve_EM.R +++ b/R/zcurve_EM.R @@ -234,7 +234,7 @@ #' fit_reps = 50, #' mu = c(0, 1.5, 3, 4.5, 6) #' ) -#' \donttest{zcurve(OSC.z, method = "EM", control = ctrl)} +#' \dontrun{zcurve(OSC.z, method = "EM", control = ctrl)} #' #' @seealso [zcurve()], [control_density] NULL diff --git a/R/zcurve_density.R b/R/zcurve_density.R index c13d46e..2b84958 100644 --- a/R/zcurve_density.R +++ b/R/zcurve_density.R @@ -193,7 +193,7 @@ #' version = 1, #' max_iter = 300 #' ) -#' \donttest{zcurve(OSC.z, method = "density", control = ctrl)} +#' \dontrun{zcurve(OSC.z, method = "density", control = ctrl)} #' #' @seealso [zcurve()], [control_density], [control_EM] NULL @@ -349,7 +349,7 @@ NULL #' max_iter = 300, #' criterion = 1e-4 #' ) -#' \donttest{zcurve(OSC.z, method = "density", control = ctrl)} +#' \dontrun{zcurve(OSC.z, method = "density", control = ctrl)} #' #' @seealso [zcurve()], [control_density_v1], [control_EM] NULL diff --git a/man/control_EM.Rd b/man/control_EM.Rd index b2c4a85..5353d78 100644 --- a/man/control_EM.Rd +++ b/man/control_EM.Rd @@ -64,7 +64,7 @@ ctrl <- list( fit_reps = 50, mu = c(0, 1.5, 3, 4.5, 6) ) -\donttest{zcurve(OSC.z, method = "EM", control = ctrl)} +\dontrun{zcurve(OSC.z, method = "EM", control = ctrl)} } \references{ diff --git a/man/control_density.Rd b/man/control_density.Rd index 2104f3f..3422f9d 100644 --- a/man/control_density.Rd +++ b/man/control_density.Rd @@ -77,7 +77,7 @@ ctrl <- list( max_iter = 300, criterion = 1e-4 ) -\donttest{zcurve(OSC.z, method = "density", control = ctrl)} +\dontrun{zcurve(OSC.z, method = "density", control = ctrl)} } \references{ diff --git a/man/control_density_v1.Rd b/man/control_density_v1.Rd index 7227abc..b4e89d6 100644 --- a/man/control_density_v1.Rd +++ b/man/control_density_v1.Rd @@ -45,7 +45,7 @@ ctrl <- list( version = 1, max_iter = 300 ) -\donttest{zcurve(OSC.z, method = "density", control = ctrl)} +\dontrun{zcurve(OSC.z, method = "density", control = ctrl)} } \references{ diff --git a/man/plot.zcurve.Rd b/man/plot.zcurve.Rd index 582b366..80c87a6 100644 --- a/man/plot.zcurve.Rd +++ b/man/plot.zcurve.Rd @@ -9,6 +9,7 @@ annotation = FALSE, CI = FALSE, extrapolate = FALSE, + plot_type = "base", y.anno = c(0.95, 0.88, 0.78, 0.71, 0.61, 0.53, 0.43, 0.35), x.anno = 0.6, cex.anno = 1, @@ -27,6 +28,10 @@ to \code{FALSE}.} \item{extrapolate}{Scale the chart to the extrapolated area. Defaults to \code{FALSE}.} +\item{plot_type}{Type of plot to by produced. Defaults to \code{"base"} +for th base plotting function. An alternative is \code{"ggplot"} for a +ggplot2.} + \item{y.anno}{A vector of length 8 specifying the y-positions of the individual annotation lines relative to the figure's height. Defaults to \code{c(.95, .88, .78, .71, .61, .53, .43, .35)}} @@ -43,6 +48,7 @@ of annotations relative to the figure's width.} Plot fitted z-curve object } \examples{ +\dontrun{ # simulate some z-statistics and fit a z-curve z <- abs(rnorm(300,3)) m.EM <- zcurve(z, method = "EM", bootstrap = 100) @@ -56,6 +62,7 @@ plot(m.EM, annotation = TRUE, CI = TRUE) # change the location of the annotation to the left plot(m.EM, annotation = TRUE, CI = TRUE, x_text = 0) } +} \seealso{ \code{\link[=zcurve]{zcurve()}} } diff --git a/man/zcurve.Rd b/man/zcurve.Rd index 12b5254..ec0141c 100644 --- a/man/zcurve.Rd +++ b/man/zcurve.Rd @@ -94,7 +94,7 @@ ctr1 <- list( "max_iter" = 9999, "alpha" = .10 ) -\donttest{m1.EM <- zcurve(OSC.z, method = "EM", bootstrap = FALSE, control = ctr1)} +\dontrun{m1.EM <- zcurve(OSC.z, method = "EM", bootstrap = FALSE, control = ctr1)} # see '?control_EM' and '?control_density' for more information about different # z-curves specifications } diff --git a/tests/testthat/_snaps/zcurve/z-curve-cens-em-ggplot.svg b/tests/testthat/_snaps/zcurve/z-curve-cens-em-ggplot.svg new file mode 100644 index 0000000..2a48b56 --- /dev/null +++ b/tests/testthat/_snaps/zcurve/z-curve-cens-em-ggplot.svg @@ -0,0 +1,89 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +z-scores +Density +z-curve (EM via EM) + + diff --git a/tests/testthat/_snaps/zcurve/z-curve-clustered-mixed-ggplot-1.svg b/tests/testthat/_snaps/zcurve/z-curve-clustered-mixed-ggplot-1.svg new file mode 100644 index 0000000..7a03ee9 --- /dev/null +++ b/tests/testthat/_snaps/zcurve/z-curve-clustered-mixed-ggplot-1.svg @@ -0,0 +1,100 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +z-scores +Density +z-curve (EM via EM (bootstrapped)) + + diff --git a/tests/testthat/_snaps/zcurve/z-curve-clustered-mixed-ggplot-2.svg b/tests/testthat/_snaps/zcurve/z-curve-clustered-mixed-ggplot-2.svg new file mode 100644 index 0000000..f4d8ad5 --- /dev/null +++ b/tests/testthat/_snaps/zcurve/z-curve-clustered-mixed-ggplot-2.svg @@ -0,0 +1,100 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +z-scores +Density +z-curve (EM via EM (weighted)) + + diff --git a/tests/testthat/_snaps/zcurve/z-curve-em-ggplot.svg b/tests/testthat/_snaps/zcurve/z-curve-em-ggplot.svg new file mode 100644 index 0000000..abc688c --- /dev/null +++ b/tests/testthat/_snaps/zcurve/z-curve-em-ggplot.svg @@ -0,0 +1,108 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Range: 1.79 to 10.00 +90 tests, 85 significant +Observed discovery rate: +0.94 95% CI [0.87 ,0.98] +Expected discovery rate: +0.39 95% CI [0.07 ,0.70] +Expected replicability rate: +0.61 95% CI [0.44 ,0.74] + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +z-scores +Density +OSC (with EM) + + diff --git a/tests/testthat/_snaps/zcurve/z-curve-kd2-ggplot.svg b/tests/testthat/_snaps/zcurve/z-curve-kd2-ggplot.svg new file mode 100644 index 0000000..83ea8dc --- /dev/null +++ b/tests/testthat/_snaps/zcurve/z-curve-kd2-ggplot.svg @@ -0,0 +1,99 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +z-scores +Density +z-curve (KD2 via density) + + diff --git a/tests/testthat/_snaps/zcurve/z-curve-mixed-em-ggplot.svg b/tests/testthat/_snaps/zcurve/z-curve-mixed-em-ggplot.svg new file mode 100644 index 0000000..1a8f0b2 --- /dev/null +++ b/tests/testthat/_snaps/zcurve/z-curve-mixed-em-ggplot.svg @@ -0,0 +1,89 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +z-scores +Density +z-curve (EM via EM) + + diff --git a/tests/testthat/test-zcurve.R b/tests/testthat/test-zcurve.R index d65c644..f92118d 100644 --- a/tests/testthat/test-zcurve.R +++ b/tests/testthat/test-zcurve.R @@ -60,6 +60,7 @@ test_that("z-curve EM can be fitted and reproduces OSC results", { # plot expect_doppelganger("z-curve EM", function()plot(fit.EM, main = "OSC (with EM)", annotation = TRUE, CI = TRUE)) + expect_doppelganger("z-curve EM (ggplot)", suppressWarnings(plot(fit.EM, main = "OSC (with EM)", annotation = TRUE, CI = TRUE, plot_type = "ggplot"))) }) test_that("z-curve KD2 can be fitted and reproduces OSC results", { @@ -100,6 +101,7 @@ test_that("z-curve KD2 can be fitted and reproduces OSC results", { # plot expect_doppelganger("z-curve KD2", function()plot(fit.KD2)) + expect_doppelganger("z-curve KD2 (ggplot)", plot(fit.KD2, plot_type = "ggplot")) }) test_that("z-curve EM censoring works", { @@ -131,6 +133,7 @@ test_that("z-curve EM censoring works", { # plot expect_doppelganger("z-curve mixed EM", function()plot(fit.mixed, CI = TRUE)) + expect_doppelganger("z-curve mixed EM (ggplot)", plot(fit.mixed, CI = TRUE, plot_type = "ggplot")) # censoring only @@ -155,6 +158,7 @@ test_that("z-curve EM censoring works", { # plot expect_doppelganger("z-curve cens EM", function()plot(fit.cens, CI = TRUE)) + expect_doppelganger("z-curve cens EM (ggplot)", plot(fit.cens, CI = TRUE, plot_type = "ggplot")) }) test_that("z-curve clustered works", { @@ -208,7 +212,7 @@ test_that("z-curve clustered works", { plot(fitw) }) - + # precise data <- paste0("z = ",z) data <- zcurve_data(data, id) @@ -301,4 +305,7 @@ test_that("z-curve clustered works", { plot(fitb) plot(fitw) }) + + expect_doppelganger("z-curve clustered mixed (ggplot-1)", plot(fitb, plot_type = "ggplot")) + expect_doppelganger("z-curve clustered mixed (ggplot-2)", plot(fitw, plot_type = "ggplot")) }) \ No newline at end of file