diff --git a/.gitignore b/.gitignore index 8620c310..52d77690 100644 --- a/.gitignore +++ b/.gitignore @@ -30,3 +30,4 @@ coverage.* .vscode/ .rds node_modules +vintage_NAMESPACE diff --git a/DESCRIPTION b/DESCRIPTION index b69090ef..0c1d34e7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,7 +37,9 @@ Imports: ggplot2, checkmate, devtools, - lifecycle + lifecycle, + vdiffr, + tools, VignetteBuilder: knitr Encoding: UTF-8 diff --git a/NAMESPACE b/NAMESPACE index 5ad2b34d..1b06e70d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,6 @@ export(dbetaMix) export(dbetabinom) export(dbetabinomMix) export(dbetadiff) -export(myPlotDiff) export(oc2) export(oc3) export(ocPostprob) @@ -18,6 +17,7 @@ export(ocRctPredprobDist) export(pbetaMix) export(pbetadiff) export(plotBeta) +export(plotBetaDiff) export(plotBounds) export(plotDecision) export(plotOc) diff --git a/R/plotBeta.R b/R/plotBeta.R index 98a6788c..d5f6eda5 100644 --- a/R/plotBeta.R +++ b/R/plotBeta.R @@ -6,7 +6,6 @@ #' first parameter of the Beta distribution #' @typed beta : number #' second parameter of the Beta distribution -#' #' @return A beta distribution density plot #' #' @importFrom graphics axis @@ -15,6 +14,8 @@ #' @export #' @keywords graphics plotBeta <- function(alpha, beta) { + assert_number(alpha, finite = TRUE) + assert_number(beta, finite = TRUE) x_support <- seq(from = 0, to = 1, length = 1000) data <- data.frame( grid = x_support, @@ -30,141 +31,97 @@ plotBeta <- function(alpha, beta) { ggplot2::scale_x_continuous(labels = scales::percent_format()) } -#' Plot Diff Between two Beta distributions +#' Plot difference Between two Beta distributions #' #' This function will plot the PDF of a difference between two Beta distributions #' -#' @param parY non-negative parameters of the treatment Beta distribution. -#' @param parX non-negative parameters of the historical control Beta distribution -#' @param cut_B a meaningful improvement threshold -#' @param cut_W a poor improvement throshold -#' @param shade paint the two areas under the curve, default value=1 as "yes". other numbers stands for "no"; -#' @param note show values of the colored area, default value=1 as "yes". other numbers stands for "no" -#' @param \dots additional arguments to \code{plot} -#' @return nothing, only produces the plot as side effect +#' @typed parX : numeric +#' non-negative parameters of the control Beta distribution +#' @typed parY : numeric +#' non-negative parameters of the treatment Beta distribution. +#' @typed go_cut : number +#' a meaningful improvement threshold, the lower boundary of a meaningfully improvement in response rate +#' @typed stop_cut : number +#' a poor improvement threshold, the upper boundary of a meaningfully poor improvement in response rate +#' @typed shade : flag +#' paint the two areas under the curve, default value = TRUE +#' @typed note : flag +#' show values of the colored area, default value = TRUE +#' @return a ggplot object #' -#' @example examples/myPlotDiff.R +#' @example examples/plotBetaDiff.R #' #' @importFrom graphics par axis polygon mtext #' @importFrom stats integrate #' #' @export #' @keywords graphics -myPlotDiff <- function(parY, # parameters of phase Ib trial; - parX, # parameters of HC; - cut_B = 0.20, # a meaningful improvement threshold; - cut_W = 0.1, # a poor improvement threshold; - shade = 1, # paint the two areas under the curve, default: yes. other numbers stands for "no"; - note = 1, # show values of the colored area, default: yes. other numbers stands for "no"; - ...) { - if (note == 1) { - graphics::par(mar = c(5, 15, 1, 15) + .1) - } else { - graphics::par(mar = c(5, 5, 1, 5) + .1) - } - grid <- seq(from = -0.5, to = 0.75, length = 1000) - xticks <- seq(from = -1, to = 1, by = 0.25) - +plotBetaDiff <- function(parX, # parameters of control or SOC + parY, # parameters of experimental arm + go_cut = 0.20, # a meaningful improvement threshold + stop_cut = 0.1, # a poor improvement threshold + shade = TRUE, # paint the two areas under the curve + note = TRUE) { # show values of the colored area + assert_numeric(parX, lower = 0, finite = TRUE, any.missing = FALSE) + assert_numeric(parY, lower = 0, finite = TRUE, any.missing = FALSE) + assert_number(go_cut, finite = TRUE) + assert_number(stop_cut, finite = TRUE) + assert_flag(shade) + assert_flag(note) - - graphics::plot( - x = grid, - y = dbetadiff(grid, parY = parY, parX = parX), - ylab = "", - xaxt = "n", - yaxt = "n", - type = "l", - xaxs = "i", - yaxs = "i", - ... + diff <- seq(from = -1, to = 1, length = 1000) + data <- data.frame( + grid = diff, + density = dbetadiff(z = diff, parY = parY, parX = parX) ) + data$stop <- ifelse(diff > -1 & diff < stop_cut, TRUE, FALSE) + data$go <- ifelse(diff > go_cut & diff < 1, TRUE, FALSE) - graphics::axis( - side = 1, at = xticks, - labels = - paste(ifelse(xticks >= 0, "+", ""), - xticks * 100, "%", - sep = "" - ) + go_auc <- integrate( + f = dbetadiff, + parX = parX, + parY = parY, + lower = go_cut, # Calculate probability of go, if difference was at least `go_cut`. + upper = 1 + ) + stop_auc <- integrate( + f = dbetadiff, + parX = parX, + parY = parY, + lower = -1, + upper = stop_cut # Calculate probability of stop, if difference was at most `stop_cut`. ) - ## now color the go / stop prob areas - - if (shade == 1) { - ## first stop: - stopGrid <- grid[grid <= cut_W] - nStop <- length(stopGrid) - - graphics::polygon( - x = - c( - stopGrid, - rev(stopGrid) - ), - y = - c( - rep(0, nStop), - dbetadiff(rev(stopGrid), parY = parY, parX = parX) - ), - col = "red" - ) - - A_value <- stats::integrate( - f = dbetadiff, - parY = parY, - parX = parX, - lower = -1, - upper = cut_W - ) - if (note == 1) { - graphics::mtext( - paste("Prob(diff< ", round(cut_W * 100), "%)=", - sprintf("%1.2f%%", 100 * as.numeric(A_value$value)), - sep = "" - ), - side = 2, line = 1, las = 1, cex = 1 - ) - } - - ## then go: - goGrid <- grid[grid >= cut_B] - nGo <- length(goGrid) - - graphics::polygon( - x = - c( - goGrid, - rev(goGrid) - ), - y = - c( - rep(0, nGo), - dbetadiff(rev(goGrid), parY = parY, parX = parX) - ), - col = "green" - ) + go_label <- paste("P(Go) is", round(go_auc$value * 100, digits = 2), "%") + stop_label <- paste("P(Stop) is", round(stop_auc$value * 100, digits = 2), "%") + plot_title <- paste("According to Beta difference density", go_label, "and", stop_label) - B_value <- stats::integrate( - f = dbetadiff, - parY = parY, - parX = parX, - lower = cut_B, - upper = 1 - ) - if (note == 1) { - graphics::mtext( - paste( - sprintf("%1.2f%%", 100 * as.numeric(B_value$value)), - "=Prob(diff> ", - round(cut_B * 100), "%)", - sep = "" - ), - side = 4, - line = 1, - las = 1, - cex = 1 - ) - } + pbetadiff_plot <- if (shade) { + ggplot2::ggplot(data = data, mapping = ggplot2::aes(x = grid, y = density)) + + ggplot2::geom_line(colour = "#888888") + + ggplot2::geom_area( + data = data[data$grid < stop_cut, ], fill = "#FF0046", + mapping = ggplot2::aes(x = ifelse(grid < 0.2 & grid < 0.5, grid, 0)) + ) + + ggplot2::geom_area( + data = data[data$grid > go_cut, ], fill = "#009E73", + mapping = ggplot2::aes(x = ifelse(grid > 0.3, grid, 0)) + ) + + ggplot2::xlab("Difference between treatment") + + ggplot2::ylab(quote(f(x))) + + ggplot2::ggtitle(plot_title) + } else { + pbetadiff_plot <- ggplot2::ggplot(data = data) + + ggplot2::geom_line(aes(x = grid, y = density, colour = "#888888")) + + xlab("Difference between treatment") + + ggplot2::ylab(quote(f(x))) + + ggplot2::ggtitle(plot_title) + } + if (note) { + pbetadiff_plot <- pbetadiff_plot + + ggplot2::annotate("text", x = -0.5, y = 3.75, size = 5, label = stop_label, colour = "#FF0046") + + ggplot2::annotate("text", x = -0.5, y = 3.25, size = 5, label = go_label, colour = "#009E73") } + pbetadiff_plot } diff --git a/examples/myPlotDiff.R b/examples/myPlotDiff.R deleted file mode 100644 index c9a4795e..00000000 --- a/examples/myPlotDiff.R +++ /dev/null @@ -1,8 +0,0 @@ -myPlotDiff( - parY = c(5, 10), - parX = c(2, 5), - cut_B = 0.2, # a meaningful improvement threshold - cut_W = 0.05, # a poor improvement threshold - shade = 1, # paint the two areas under the curve, default: yes. other numbers stands for "no"; - note = 0 -) # show values of the colored area, default: yes. other numbers stands for "no"; diff --git a/examples/plotBetaDiff.R b/examples/plotBetaDiff.R new file mode 100644 index 00000000..8bd18e0b --- /dev/null +++ b/examples/plotBetaDiff.R @@ -0,0 +1,22 @@ +# The beta distribution and acceptable bounds for +# a meaningful improvement of 0.30 and worsening of 0.1 +parX <- c(1, 52) # prior parameters of control or SOC +parY <- c(5.5, 20.5) # prior parameters of experimental arm +plotBetaDiff( + parX = parX, + parY = parY, + go_cut = 0.3, + stop_cut = 0.1, # below a difference of 10%, is an unsuccessful trial + shade = TRUE, + note = TRUE +) + +# a larger Go_cut with uniform prior +plotBetaDiff( + parX = c(1, 1), # prior parameters for experimental arm + parY = c(1, 1), # prior parameters for control or SOC arm + go_cut = 0.3, + stop_cut = 0.1, # below a difference of 10%, is an unsuccessful trial + shade = TRUE, + note = TRUE +) diff --git a/inst/WORDLIST b/inst/WORDLIST index 2faf53fe..be3cf716 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -102,6 +102,7 @@ gelman Gelman generalizable geq +ggplot grayzone grey Gsponer @@ -201,6 +202,8 @@ renewcommand reproducibility responder responders +roxygen +Roxygen Sabanes sabanes Sabanés @@ -243,6 +246,7 @@ USUBJID VAD vanillaBayes vanillaPP +vbump Vehtari WeightedBayes weightedBetaPrior diff --git a/man/myPlotDiff.Rd b/man/myPlotDiff.Rd deleted file mode 100644 index 8d949d11..00000000 --- a/man/myPlotDiff.Rd +++ /dev/null @@ -1,40 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotBeta.R -\name{myPlotDiff} -\alias{myPlotDiff} -\title{Plot Diff Between two Beta distributions} -\usage{ -myPlotDiff(parY, parX, cut_B = 0.2, cut_W = 0.1, shade = 1, note = 1, ...) -} -\arguments{ -\item{parY}{non-negative parameters of the treatment Beta distribution.} - -\item{parX}{non-negative parameters of the historical control Beta distribution} - -\item{cut_B}{a meaningful improvement threshold} - -\item{cut_W}{a poor improvement throshold} - -\item{shade}{paint the two areas under the curve, default value=1 as "yes". other numbers stands for "no";} - -\item{note}{show values of the colored area, default value=1 as "yes". other numbers stands for "no"} - -\item{\dots}{additional arguments to \code{plot}} -} -\value{ -nothing, only produces the plot as side effect -} -\description{ -This function will plot the PDF of a difference between two Beta distributions -} -\examples{ -myPlotDiff( - parY = c(5, 10), - parX = c(2, 5), - cut_B = 0.2, # a meaningful improvement threshold - cut_W = 0.05, # a poor improvement threshold - shade = 1, # paint the two areas under the curve, default: yes. other numbers stands for "no"; - note = 0 -) # show values of the colored area, default: yes. other numbers stands for "no"; -} -\keyword{graphics} diff --git a/man/plotBetaDiff.Rd b/man/plotBetaDiff.Rd new file mode 100644 index 00000000..9e2749e9 --- /dev/null +++ b/man/plotBetaDiff.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotBeta.R +\name{plotBetaDiff} +\alias{plotBetaDiff} +\title{Plot difference Between two Beta distributions} +\usage{ +plotBetaDiff( + parX, + parY, + go_cut = 0.2, + stop_cut = 0.1, + shade = TRUE, + note = TRUE +) +} +\arguments{ +\item{parX}{(\code{numeric}):\cr non-negative parameters of the control Beta distribution} + +\item{parY}{(\code{numeric}):\cr non-negative parameters of the treatment Beta distribution.} + +\item{go_cut}{(\code{number}):\cr a meaningful improvement threshold, the lower boundary of a meaningfully improvement in response rate} + +\item{stop_cut}{(\code{number}):\cr a poor improvement threshold, the upper boundary of a meaningfully poor improvement in response rate} + +\item{shade}{(\code{flag}):\cr paint the two areas under the curve, default value = TRUE} + +\item{note}{(\code{flag}):\cr show values of the colored area, default value = TRUE} +} +\value{ +a ggplot object +} +\description{ +This function will plot the PDF of a difference between two Beta distributions +} +\examples{ +# The beta distribution and acceptable bounds for +# a meaningful improvement of 0.30 and worsening of 0.1 +parX <- c(1, 52) # prior parameters of control or SOC +parY <- c(5.5, 20.5) # prior parameters of experimental arm +plotBetaDiff( + parX = parX, + parY = parY, + go_cut = 0.3, + stop_cut = 0.1, # below a difference of 10\%, is an unsuccessful trial + shade = TRUE, + note = TRUE +) + +# a larger Go_cut with uniform prior +plotBetaDiff( + parX = c(1, 1), # prior parameters for experimental arm + parY = c(1, 1), # prior parameters for control or SOC arm + go_cut = 0.3, + stop_cut = 0.1, # below a difference of 10\%, is an unsuccessful trial + shade = TRUE, + note = TRUE +) +} +\keyword{graphics} diff --git a/phase1b.Rproj b/phase1b.Rproj index ded5673d..63f75c19 100644 --- a/phase1b.Rproj +++ b/phase1b.Rproj @@ -1,4 +1,5 @@ Version: 1.0 +ProjectId: facbf7d1-d6f7-4ebe-af3f-4824afa245bb RestoreWorkspace: No SaveWorkspace: No diff --git a/plot_betadiff_1.svg b/plot_betadiff_1.svg new file mode 100644 index 00000000..e69de29b diff --git a/plot_betadiff_2.svg b/plot_betadiff_2.svg new file mode 100644 index 00000000..e69de29b diff --git a/tests/testthat/_snaps/plotBetaDiff/plot-of-distibution-of-difference-of-two-arms-with-beta-mixture.svg b/tests/testthat/_snaps/plotBetaDiff/plot-of-distibution-of-difference-of-two-arms-with-beta-mixture.svg new file mode 100644 index 00000000..a9c300df --- /dev/null +++ b/tests/testthat/_snaps/plotBetaDiff/plot-of-distibution-of-difference-of-two-arms-with-beta-mixture.svg @@ -0,0 +1,65 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + +P(Stop) is 59.5 % +P(Go) is 24.5 % + + + +0 +1 +2 +3 + + + + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 +Difference between treatment +f +( +x +) +According to Beta difference density P(Go) is 24.5 % and P(Stop) is 59.5 % + + diff --git a/tests/testthat/_snaps/plotBetaDiff/plot-of-distibution-of-difference-of-two-arms.svg b/tests/testthat/_snaps/plotBetaDiff/plot-of-distibution-of-difference-of-two-arms.svg new file mode 100644 index 00000000..86d646f9 --- /dev/null +++ b/tests/testthat/_snaps/plotBetaDiff/plot-of-distibution-of-difference-of-two-arms.svg @@ -0,0 +1,69 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + +P(Stop) is 11.72 % +P(Go) is 10.12 % + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 +Difference between treatment +f +( +x +) +According to Beta difference density P(Go) is 10.12 % and P(Stop) is 11.72 % + + diff --git a/tests/testthat/test-plotBetaDiff.R b/tests/testthat/test-plotBetaDiff.R new file mode 100644 index 00000000..3363613e --- /dev/null +++ b/tests/testthat/test-plotBetaDiff.R @@ -0,0 +1,23 @@ +# plotBetaDiff +test_that("plotBetaDiff works as expected", { + parX <- c(1, 52) # prior parameters of control or SOC + parY <- c(5.5, 20.5) # prior parameters of experimental arm + result1 <- plotBetaDiff( + parX = parX, + parY = parY, + go_cut = 0.3, + stop_cut = 0.1, # below a difference of 10%, is an unsuccessful trial + shade = TRUE, + note = TRUE + ) + result2 <- plotBetaDiff( + parX = c(1, 1), + parY = c(1, 1), + go_cut = 0.3, + stop_cut = 0.1, # below a difference of 10%, is an unsuccessful trial + shade = TRUE, + note = TRUE + ) + vdiffr::expect_doppelganger("Plot of distibution of difference of two arms", result1) + vdiffr::expect_doppelganger("Plot of distibution of difference of two arms with beta mixture", result2) +}) diff --git a/tests/vdiffr.Rout.fail b/tests/vdiffr.Rout.fail new file mode 100644 index 00000000..2c41ec85 --- /dev/null +++ b/tests/vdiffr.Rout.fail @@ -0,0 +1,6608 @@ +Environment: +- vdiffr-svg-engine: 2.0 +- vdiffr: 1.0.8 + + +Failed doppelganger: plot-of-distibution-of-difference-of-two-arms (/Users/audreyyeo/Documents/phase1b/phase1b/tests/testthat/_snaps/plotBetaDiff/plot-of-distibution-of-difference-of-two-arms.svg) + +< before +> after +@@ 28,11 / 28,11 @@ + + +< +> +< +> +< +> +< +> +< +> +< P(Stop) is 11.72 % +> P(Stop) is 100 % +< P(Go) is 10.12 % +> P(Go) is 0 % + + +@@ 65,5 / 65,5 @@ + x + ) +< According to Beta difference +: density P(Go) is 10.12 % and P(Stop) is 11.72 % +> According to Beta difference +: density P(Go) is 0 % and P(Stop) is 100 % + + + + +Failed doppelganger: plot-of-distibution-of-difference-of-two-arms (/Users/audreyyeo/Documents/phase1b/phase1b/tests/testthat/_snaps/plotBetaDiff/plot-of-distibution-of-difference-of-two-arms.svg) + +< before +> after +@@ 28,11 / 28,11 @@ + + +< +> +< +> +< +> +< +> +< +> +< P(Stop) is 11.72 % +> P(Stop) is 100 % +< P(Go) is 10.12 % +> P(Go) is 0 % + + +@@ 65,5 / 65,5 @@ + x + ) +< According to Beta difference +: density P(Go) is 10.12 % and P(Stop) is 11.72 % +> According to Beta difference +: density P(Go) is 0 % and P(Stop) is 100 % + + + diff --git a/vignettes/introduction.Rmd b/vignettes/introduction.Rmd index 3ef52c0b..4f87fb92 100644 --- a/vignettes/introduction.Rmd +++ b/vignettes/introduction.Rmd @@ -860,33 +860,28 @@ arrows(-.25, 2, 0, .2, lwd = 2) text(-.25, 2.2, expression("Prob" * (Delta < +5 * "%"))) ``` -Alternatively, we could use the R-package function `myPlotDiff()` to achieve the +Alternatively, we could use the R-package function `plotBetaDiff()` to achieve the the same result in far fewer lines of code, see -Figure~\@ref(fig:ex1:betadiff1:myPlotDiff)). +Figure~\@ref(fig:ex1:betadiff1:plotBetadiff)). ```{r, echo = FALSE} -ex1_betadiff_1_myplotdiff_cap <- paste( - "The distribution of the difference in PET-CR rates amongst the novel", +ex1_plotBetaDiff_cap <- paste( + "The distribution of the difference in PET-CR rates between the novel", "combination group and the historical control. Here, we see that the probability", "of a go decision (green) is much more likely than the probability of a no go", "decision (red)." ) ``` -```{r ex1:betadiff1:myPlotDiff, echo=TRUE, fig.cap = ex1_betadiff_1_myplotdiff_cap} -myPlotDiff(c(5.75 + 55, 4.25 + 80 - 55), c(75, 75), 0.15, 0.05, 1, 0, - xlab = "(Combo Response) - (Control Response)" +```{r ex1:betadiff1:plotBetaDiff, echo=TRUE, fig.cap = ex1_plotBetaDiff_cap} +plotBetaDiff( + parX = parX, + parY = parY, + go_cut = 0.3, + stop_cut = 0.15, # below a difference of 15%, is an unsuccessful trial + shade = TRUE, + note = TRUE ) -legend("topright", c("Prob. of No Go", "Prob. of Go"), - pch = 15, - col = c("red", "green"), bty = "n" -) - -arrows(.5, 2, .22, 1, lwd = 2) -text(.5, 2.2, expression("Prob" * (Delta > +15 * "%"))) - -arrows(-.25, 2, 0, .2, lwd = 2) -text(-.25, 2.2, expression("Prob" * (Delta < +5 * "%"))) ``` In Figure \@ref(fig:ex1:betadiff1) we see that the probability of a go decision