From 2c688e0d0d965ff1a4461e64ed3f23d914ca8e6b Mon Sep 17 00:00:00 2001 From: Kai Gu Date: Fri, 22 Dec 2023 16:13:16 +0800 Subject: [PATCH] add rrPostProb function for response rate simulation --- DESCRIPTION | 6 +-- NAMESPACE | 11 ++++- R/hello.R | 18 -------- R/package.R | 2 + R/postprob.R | 51 +++++++++++++++++++++++ R/utils.R | 14 +++++++ inst/WORDLIST | 4 ++ man/figures/lifecycle-archived.svg | 21 ++++++++++ man/figures/lifecycle-defunct.svg | 21 ++++++++++ man/figures/lifecycle-deprecated.svg | 21 ++++++++++ man/figures/lifecycle-experimental.svg | 21 ++++++++++ man/figures/lifecycle-maturing.svg | 21 ++++++++++ man/figures/lifecycle-questioning.svg | 21 ++++++++++ man/figures/lifecycle-soft-deprecated.svg | 21 ++++++++++ man/figures/lifecycle-stable.svg | 29 +++++++++++++ man/figures/lifecycle-superseded.svg | 21 ++++++++++ man/hello.Rd | 12 ------ man/pipe.Rd | 20 +++++++++ man/rrPostProb.Rd | 43 +++++++++++++++++++ man/stabiot-package.Rd | 22 ++++++++++ tests/spelling.R | 3 ++ tests/testthat.R | 12 ++++++ tests/testthat/test-postprob.R | 5 +++ 23 files changed, 385 insertions(+), 35 deletions(-) delete mode 100644 R/hello.R create mode 100644 R/postprob.R create mode 100644 R/utils.R create mode 100644 inst/WORDLIST create mode 100644 man/figures/lifecycle-archived.svg create mode 100644 man/figures/lifecycle-defunct.svg create mode 100644 man/figures/lifecycle-deprecated.svg create mode 100644 man/figures/lifecycle-experimental.svg create mode 100644 man/figures/lifecycle-maturing.svg create mode 100644 man/figures/lifecycle-questioning.svg create mode 100644 man/figures/lifecycle-soft-deprecated.svg create mode 100644 man/figures/lifecycle-stable.svg create mode 100644 man/figures/lifecycle-superseded.svg delete mode 100644 man/hello.Rd create mode 100644 man/pipe.Rd create mode 100644 man/rrPostProb.Rd create mode 100644 man/stabiot-package.Rd create mode 100644 tests/spelling.R create mode 100644 tests/testthat.R create mode 100644 tests/testthat/test-postprob.R diff --git a/DESCRIPTION b/DESCRIPTION index eb79ffc..746273f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,22 +15,20 @@ Depends: R (>= 3.6) Imports: checkmate, - dplyr, lifecycle, magrittr, methods, - rlang, stats Suggests: knitr, rmarkdown, spelling, testthat (>= 3.0.0), - usethis, - vdiffr + usethis VignetteBuilder: knitr Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 Language: en-US URL: https://github.com/kaigu1990/stabiot BugReports: https://github.com/kaigu1990/stabiot/issues +Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index d75f824..53e7570 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1 +1,10 @@ -exportPattern("^[[:alpha:]]+") +# Generated by roxygen2: do not edit by hand + +export("%>%") +export(rrPostProb) +import(checkmate) +import(methods) +importFrom(lifecycle,deprecated) +importFrom(magrittr,"%>%") +importFrom(stats,pbeta) +importFrom(stats,rbinom) diff --git a/R/hello.R b/R/hello.R deleted file mode 100644 index a793395..0000000 --- a/R/hello.R +++ /dev/null @@ -1,18 +0,0 @@ -# Hello, world! -# -# This is an example function named 'hello' -# which prints 'Hello, world!'. -# -# You can learn more about package authoring with RStudio at: -# -# http://r-pkgs.had.co.nz/ -# -# Some useful keyboard shortcuts for package authoring: -# -# Install Package: 'Ctrl + Shift + B' -# Check Package: 'Ctrl + Shift + E' -# Test Package: 'Ctrl + Shift + T' - -hello <- function() { - print("Hello, world!") -} diff --git a/R/package.R b/R/package.R index 604f54b..81ecb10 100644 --- a/R/package.R +++ b/R/package.R @@ -6,4 +6,6 @@ #' @import checkmate #' @import methods +#' @importFrom lifecycle deprecated +#' @importFrom stats pbeta rbinom NULL diff --git a/R/postprob.R b/R/postprob.R new file mode 100644 index 0000000..7ee8cf0 --- /dev/null +++ b/R/postprob.R @@ -0,0 +1,51 @@ +#' Simulation of Sample Size Determination by Bayesian +#' +#' @description `r lifecycle::badge("experimental")` +#' +#' Simulation to obtain trial operational characteristic +#' +#' @param nsample (`integer`)\cr integer value of specified sample size. +#' @param cutoff (`numeric`)\cr numeric cutoff of response rate. +#' @param p (`numeric`)\cr numeric vector of true response rate. +#' @param a,b (`numeric`)\cr parameters of Bayesian priors, defaults are a=1 and +#' b=1 which is a weekly informative prior. +#' @param succs (`numeric`)\cr a threshold value to define pass for each simulation. +#' @param nrep (`integer`)\cr times of simulation. +#' +#' @details +#' The Prior is P(p)~Beta(1,1), likelihood is P(k|p)~Binomial(n,p), and posterior +#' can be P(p|k)~Bate(k+1, n-k+1). +#' +#' @return a vector of probability for each true response rate. +#' @export +#' +#' @examples +#' # Given that the operational characteristics are based on at least 70% posterior +#' # confidence that the true rate exceeds a threshold of interest, what is the +#' # chance of confirming a true response of at least 75% given the assumptions +#' # of various sample sizes and true response rates(0.75, 0.8, 0.85, 0.9)? +#' # It should be noted that operational characteristics are based on a Bayesian +#' # model without considering baseline stratification factors. +#' rrPostProb(nsample = 66, cutoff = 0.75, p = c(0.75, 0.8, 0.85, 0.9), succs = 0.7) +rrPostProb <- function(nsample, + cutoff, + p, + a = 1, + b = 1, + succs = NULL, + nrep = 100000) { + perc_resp <- rep(0, length(p)) + for (i in 1:length(p)) { + effective <- c() + for (j in 1:nrep) { + # number of patients response + nresp <- rbinom(n = 1, size = nsample, prob = p[i]) + # posterior probability + pp <- pbeta(cutoff, nresp + a, nsample - nresp + b, lower.tail = FALSE) + status <- ifelse(pp > succs, 1, 0) + effective <- sum(status, effective) + } + perc_resp[i] <- round(effective / nrep, 3) * 100 + } + perc_resp +} diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 0000000..fd0b1d1 --- /dev/null +++ b/R/utils.R @@ -0,0 +1,14 @@ +#' Pipe operator +#' +#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. +#' +#' @name %>% +#' @rdname pipe +#' @keywords internal +#' @export +#' @importFrom magrittr %>% +#' @usage lhs \%>\% rhs +#' @param lhs A value or the magrittr placeholder. +#' @param rhs A function call using the magrittr semantics. +#' @return The result of calling `rhs(lhs)`. +NULL diff --git a/inst/WORDLIST b/inst/WORDLIST new file mode 100644 index 0000000..fbb138e --- /dev/null +++ b/inst/WORDLIST @@ -0,0 +1,4 @@ +ADaM +CDISC +magrittr +oversighting diff --git a/man/figures/lifecycle-archived.svg b/man/figures/lifecycle-archived.svg new file mode 100644 index 0000000..745ab0c --- /dev/null +++ b/man/figures/lifecycle-archived.svg @@ -0,0 +1,21 @@ + + lifecycle: archived + + + + + + + + + + + + + + + lifecycle + + archived + + diff --git a/man/figures/lifecycle-defunct.svg b/man/figures/lifecycle-defunct.svg new file mode 100644 index 0000000..d5c9559 --- /dev/null +++ b/man/figures/lifecycle-defunct.svg @@ -0,0 +1,21 @@ + + lifecycle: defunct + + + + + + + + + + + + + + + lifecycle + + defunct + + diff --git a/man/figures/lifecycle-deprecated.svg b/man/figures/lifecycle-deprecated.svg new file mode 100644 index 0000000..b61c57c --- /dev/null +++ b/man/figures/lifecycle-deprecated.svg @@ -0,0 +1,21 @@ + + lifecycle: deprecated + + + + + + + + + + + + + + + lifecycle + + deprecated + + diff --git a/man/figures/lifecycle-experimental.svg b/man/figures/lifecycle-experimental.svg new file mode 100644 index 0000000..5d88fc2 --- /dev/null +++ b/man/figures/lifecycle-experimental.svg @@ -0,0 +1,21 @@ + + lifecycle: experimental + + + + + + + + + + + + + + + lifecycle + + experimental + + diff --git a/man/figures/lifecycle-maturing.svg b/man/figures/lifecycle-maturing.svg new file mode 100644 index 0000000..897370e --- /dev/null +++ b/man/figures/lifecycle-maturing.svg @@ -0,0 +1,21 @@ + + lifecycle: maturing + + + + + + + + + + + + + + + lifecycle + + maturing + + diff --git a/man/figures/lifecycle-questioning.svg b/man/figures/lifecycle-questioning.svg new file mode 100644 index 0000000..7c1721d --- /dev/null +++ b/man/figures/lifecycle-questioning.svg @@ -0,0 +1,21 @@ + + lifecycle: questioning + + + + + + + + + + + + + + + lifecycle + + questioning + + diff --git a/man/figures/lifecycle-soft-deprecated.svg b/man/figures/lifecycle-soft-deprecated.svg new file mode 100644 index 0000000..9c166ff --- /dev/null +++ b/man/figures/lifecycle-soft-deprecated.svg @@ -0,0 +1,21 @@ + + lifecycle: soft-deprecated + + + + + + + + + + + + + + + lifecycle + + soft-deprecated + + diff --git a/man/figures/lifecycle-stable.svg b/man/figures/lifecycle-stable.svg new file mode 100644 index 0000000..9bf21e7 --- /dev/null +++ b/man/figures/lifecycle-stable.svg @@ -0,0 +1,29 @@ + + lifecycle: stable + + + + + + + + + + + + + + + + lifecycle + + + + stable + + + diff --git a/man/figures/lifecycle-superseded.svg b/man/figures/lifecycle-superseded.svg new file mode 100644 index 0000000..db8d757 --- /dev/null +++ b/man/figures/lifecycle-superseded.svg @@ -0,0 +1,21 @@ + + lifecycle: superseded + + + + + + + + + + + + + + + lifecycle + + superseded + + diff --git a/man/hello.Rd b/man/hello.Rd deleted file mode 100644 index 0fa7c4b..0000000 --- a/man/hello.Rd +++ /dev/null @@ -1,12 +0,0 @@ -\name{hello} -\alias{hello} -\title{Hello, World!} -\usage{ -hello() -} -\description{ -Prints 'Hello, world!'. -} -\examples{ -hello() -} diff --git a/man/pipe.Rd b/man/pipe.Rd new file mode 100644 index 0000000..5fa90fe --- /dev/null +++ b/man/pipe.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{\%>\%} +\alias{\%>\%} +\title{Pipe operator} +\usage{ +lhs \%>\% rhs +} +\arguments{ +\item{lhs}{A value or the magrittr placeholder.} + +\item{rhs}{A function call using the magrittr semantics.} +} +\value{ +The result of calling \code{rhs(lhs)}. +} +\description{ +See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. +} +\keyword{internal} diff --git a/man/rrPostProb.Rd b/man/rrPostProb.Rd new file mode 100644 index 0000000..2b65ee6 --- /dev/null +++ b/man/rrPostProb.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/postprob.R +\name{rrPostProb} +\alias{rrPostProb} +\title{Simulation of Sample Size Determination by Bayesian} +\usage{ +rrPostProb(nsample, cutoff, p, a = 1, b = 1, succs = NULL, nrep = 1e+05) +} +\arguments{ +\item{nsample}{(\code{integer})\cr integer value of specified sample size.} + +\item{cutoff}{(\code{numeric})\cr numeric cutoff of response rate.} + +\item{p}{(\code{numeric})\cr numeric vector of true response rate.} + +\item{a, b}{(\code{numeric})\cr parameters of Bayesian priors, defaults are a=1 and +b=1 which is a weekly informative prior.} + +\item{succs}{(\code{numeric})\cr a threshold value to define pass for each simulation.} + +\item{nrep}{(\code{integer})\cr times of simulation.} +} +\value{ +a vector of probability for each true response rate. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +Simulation to obtain trial operational characteristic +} +\details{ +The Prior is P(p)~Beta(1,1), likelihood is P(k|p)~Binomial(n,p), and posterior +can be P(p|k)~Bate(k+1, n-k+1). +} +\examples{ +# Given that the operational characteristics are based on at least 70\% posterior +# confidence that the true rate exceeds a threshold of interest, what is the +# chance of confirming a true response of at least 75\% given the assumptions +# of various sample sizes and true response rates(0.75, 0.8, 0.85, 0.9)? +# It should be noted that operational characteristics are based on a Bayesian +# model without considering baseline stratification factors. +rrPostProb(nsample = 66, cutoff = 0.75, p = c(0.75, 0.8, 0.85, 0.9), succs = 0.7) +} diff --git a/man/stabiot-package.Rd b/man/stabiot-package.Rd new file mode 100644 index 0000000..f466eed --- /dev/null +++ b/man/stabiot-package.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/package.R +\docType{package} +\name{stabiot-package} +\alias{stabiot} +\alias{stabiot-package} +\title{\code{stabiot} Package} +\description{ +\code{stabiot} Common Statistical Analysis for Clinical Trials in Biotech. +} +\seealso{ +Useful links: +\itemize{ + \item \url{https://github.com/kaigu1990/stabiot} + \item Report bugs at \url{https://github.com/kaigu1990/stabiot/issues} +} + +} +\author{ +\strong{Maintainer}: Kai Gu \email{gukai1212@163.com} [copyright holder] + +} diff --git a/tests/spelling.R b/tests/spelling.R new file mode 100644 index 0000000..6713838 --- /dev/null +++ b/tests/spelling.R @@ -0,0 +1,3 @@ +if(requireNamespace('spelling', quietly = TRUE)) + spelling::spell_check_test(vignettes = TRUE, error = FALSE, + skip_on_cran = TRUE) diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..32bdd81 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,12 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview +# * https://testthat.r-lib.org/articles/special-files.html + +library(testthat) +library(stabiot) + +test_check("stabiot") diff --git a/tests/testthat/test-postprob.R b/tests/testthat/test-postprob.R new file mode 100644 index 0000000..cb95a77 --- /dev/null +++ b/tests/testthat/test-postprob.R @@ -0,0 +1,5 @@ +test_that("rrPostProb works as expected", { + set.seed(12306) + res <- rrPostProb(nsample = 66, cutoff = 0.75, p = c(0.75, 0.8, 0.85, 0.9), succs = 0.7) + expect_equal(res, c(29.0, 66.4, 93.7, 99.8)) +})