From 3bfa245f32a2e966450e481737d447a7553cfe31 Mon Sep 17 00:00:00 2001 From: John Kirkpatrick <133956382+Puzzled-Face@users.noreply.github.com> Date: Wed, 1 Nov 2023 08:47:55 +0000 Subject: [PATCH] Reverting #697 (#722) --- NAMESPACE | 3 +++ R/crmPack-package.R | 1 + R/helpers.R | 22 +++++++++++++++++ _pkgdown.yaml | 1 + man/plot.gtable.Rd | 21 ++++++++++++++++ man/simulate-DesignGrouped-method.Rd | 4 ++-- tests/testthat/_snaps/helpers/plot-gtable.svg | 24 +++++++++++++++++++ .../testthat/_snaps/helpers/print-gtable.svg | 24 +++++++++++++++++++ tests/testthat/test-helpers.R | 16 +++++++++++++ 9 files changed, 114 insertions(+), 2 deletions(-) create mode 100644 man/plot.gtable.Rd create mode 100644 tests/testthat/_snaps/helpers/plot-gtable.svg create mode 100644 tests/testthat/_snaps/helpers/print-gtable.svg diff --git a/NAMESPACE b/NAMESPACE index e713332c3..953e0e2b8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,7 @@ # Generated by roxygen2: do not edit by hand +S3method(plot,gtable) +S3method(print,gtable) export("%>%") export(.CohortSizeConst) export(.CohortSizeDLT) @@ -565,6 +567,7 @@ importFrom(graphics,lines) importFrom(graphics,matlines) importFrom(graphics,matplot) importFrom(graphics,plot) +importFrom(grid,grid.draw) importFrom(gridExtra,arrangeGrob) importFrom(kableExtra,add_footnote) importFrom(kableExtra,add_header_above) diff --git a/R/crmPack-package.R b/R/crmPack-package.R index a07ec3797..966dee92e 100644 --- a/R/crmPack-package.R +++ b/R/crmPack-package.R @@ -30,6 +30,7 @@ #' @import ggplot2 #' @import methods #' @import tibble +#' @importFrom grid grid.draw #' @importFrom gridExtra arrangeGrob #' @importFrom graphics plot hist legend lines matlines matplot #' @importFrom stats binomial coef cov2cor gaussian glm lm median model.matrix diff --git a/R/helpers.R b/R/helpers.R index 088d26258..2c3e077be 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -219,6 +219,28 @@ crmPackHelp <- function() { utils::help(package = "crmPack", help_type = "html") } +#' Plot `gtable` Objects +#' +#' This is needed because `crmPack` uses [gridExtra::arrangeGrob()] to combine +#' `ggplot2` plots, and the resulting `gtable` object is not plotted otherwise +#' when implicitly printing it in the console, e.g. +#' +#' @method plot gtable +#' @param x (`gtable`)\cr object to plot. +#' @param ... additional parameters for [grid::grid.draw()]. +#' +#' @export +plot.gtable <- function(x, ...) { + grid::grid.draw(x, ...) +} + +#' @method print gtable +#' @rdname plot.gtable +#' @export +print.gtable <- function(x, ...) { + plot(x, ...) +} + ##' Taken from utils package (print.vignette) ##' ##' @importFrom tools file_ext diff --git a/_pkgdown.yaml b/_pkgdown.yaml index 2208af641..7420372c3 100644 --- a/_pkgdown.yaml +++ b/_pkgdown.yaml @@ -452,6 +452,7 @@ reference: - plot,SimulationsSummary,missing-method - plotDualResponses - plotGain + - plot.gtable - probit - set_seed - show,DualSimulationsSummary-method diff --git a/man/plot.gtable.Rd b/man/plot.gtable.Rd new file mode 100644 index 000000000..9e48583d9 --- /dev/null +++ b/man/plot.gtable.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/helpers.R +\name{plot.gtable} +\alias{plot.gtable} +\alias{print.gtable} +\title{Plot \code{gtable} Objects} +\usage{ +\method{plot}{gtable}(x, ...) + +\method{print}{gtable}(x, ...) +} +\arguments{ +\item{x}{(\code{gtable})\cr object to plot.} + +\item{...}{additional parameters for \code{\link[grid:grid.draw]{grid::grid.draw()}}.} +} +\description{ +This is needed because \code{crmPack} uses \code{\link[gridExtra:arrangeGrob]{gridExtra::arrangeGrob()}} to combine +\code{ggplot2} plots, and the resulting \code{gtable} object is not plotted otherwise +when implicitly printing it in the console, e.g. +} diff --git a/man/simulate-DesignGrouped-method.Rd b/man/simulate-DesignGrouped-method.Rd index 54c2c4880..dede6738b 100644 --- a/man/simulate-DesignGrouped-method.Rd +++ b/man/simulate-DesignGrouped-method.Rd @@ -61,7 +61,7 @@ A simulate method for \code{\link{DesignGrouped}} designs. \examples{ # Assemble ingredients for our group design. my_stopping <- StoppingTargetProb(target = c(0.2, 0.35), prob = 0.5) | - StoppingMinPatients(20) | + StoppingMinPatients(10) | StoppingMissingDose() my_increments <- IncrementsDoseLevels(levels = 3L) my_next_best <- NextBestNCRM( @@ -113,7 +113,7 @@ legend("topright", c("mono", "combo"), lty = c(1, 2), col = c(1, 2)) set.seed(123) my_sims <- simulate( my_design, - nsim = 4, # This should be at least 100 in actual applications. + nsim = 1, # This should be at least 100 in actual applications. seed = 123, truth = my_truth, combo_truth = my_combo_truth diff --git a/tests/testthat/_snaps/helpers/plot-gtable.svg b/tests/testthat/_snaps/helpers/plot-gtable.svg new file mode 100644 index 000000000..e56d52646 --- /dev/null +++ b/tests/testthat/_snaps/helpers/plot-gtable.svg @@ -0,0 +1,24 @@ + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/helpers/print-gtable.svg b/tests/testthat/_snaps/helpers/print-gtable.svg new file mode 100644 index 000000000..e56d52646 --- /dev/null +++ b/tests/testthat/_snaps/helpers/print-gtable.svg @@ -0,0 +1,24 @@ + + + + + + + + + + + + + + + + diff --git a/tests/testthat/test-helpers.R b/tests/testthat/test-helpers.R index 90e0be660..4347421ea 100644 --- a/tests/testthat/test-helpers.R +++ b/tests/testthat/test-helpers.R @@ -724,3 +724,19 @@ test_that("h_group_data works as expected", { ) expect_setequal(combo_data_from_group, combo_data_from_start) }) + +# print.gtable ---- + +test_that("print for gtable works", { + result <- gridExtra::arrangeGrob(grid::rectGrob(), grid::rectGrob()) + assert_class(result, "gtable") + vdiffr::expect_doppelganger("print-gtable", result) +}) + +# plot.gtable ---- + +test_that("plot for gtable works", { + result <- gridExtra::arrangeGrob(grid::rectGrob(), grid::rectGrob()) + assert_class(result, "gtable") + vdiffr::expect_doppelganger("plot-gtable", plot(result)) +})