From d0bc4466cb51f6d2a7b4cfb307c6d3d676e38440 Mon Sep 17 00:00:00 2001 From: dimitriskontosBAY <95923214+dimitriskontosBAY@users.noreply.github.com> Date: Tue, 3 Oct 2023 15:34:44 +0200 Subject: [PATCH 01/10] replace 'is.probability' with function 'test_probability' from additional checkmate assertions --- R/Rules-methods.R | 4 ++-- R/fromQuantiles.R | 14 +++++++------- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/R/Rules-methods.R b/R/Rules-methods.R index dd3af7367..253a5a9a0 100644 --- a/R/Rules-methods.R +++ b/R/Rules-methods.R @@ -3017,7 +3017,7 @@ setMethod("stopTrial", prob_target <- stopping@prob_target ## checks - stopifnot(is.probability(prob_target)) + stopifnot(test_probability(prob_target)) stopifnot(is(Effmodel, "ModelEff")) stopifnot(is(Effsamples, "Samples")) stopifnot(is.function(TDderive)) @@ -3135,7 +3135,7 @@ setMethod("stopTrial", prob_target <- stopping@prob_target ## checks - stopifnot(is.probability(prob_target)) + stopifnot(test_probability(prob_target)) stopifnot(is(Effmodel, "ModelEff")) diff --git a/R/fromQuantiles.R b/R/fromQuantiles.R index b70fa9386..ec5c0ce1c 100644 --- a/R/fromQuantiles.R +++ b/R/fromQuantiles.R @@ -85,7 +85,7 @@ Quantiles2LogisticNormal <- function(dosegrid, identical(length(upper), nDoses), all(lower < median), all(upper > median), - is.probability(level, bounds = FALSE), + test_probability(level, bounds = FALSE), is.bool(logNormal), is.bool(verbose), identical(length(parlower), 5L), @@ -235,8 +235,8 @@ Quantiles2LogisticNormal <- function(dosegrid, ##' @keywords programming getMinInfBeta <- function(p, q) { stopifnot( - is.probability(p, bounds = FALSE), - is.probability(q, bounds = FALSE) + test_probability(p, bounds = FALSE), + test_probability(q, bounds = FALSE) ) ret <- @@ -311,10 +311,10 @@ MinimalInformative <- function(dosegrid, nDoses <- length(dosegrid) stopifnot( !is.unsorted(dosegrid, strictly = TRUE), - is.probability(threshmin, bounds = FALSE), - is.probability(threshmax, bounds = FALSE), - is.probability(probmin, bounds = FALSE), - is.probability(probmax, bounds = FALSE) + test_probability(threshmin, bounds = FALSE), + test_probability(threshmax, bounds = FALSE), + test_probability(probmin, bounds = FALSE), + test_probability(probmax, bounds = FALSE) ) xmin <- dosegrid[1] xmax <- dosegrid[nDoses] From 065d9bb4bd2bf35a4f2abc5ec88922483f88a428 Mon Sep 17 00:00:00 2001 From: dimitriskontosBAY <95923214+dimitriskontosBAY@users.noreply.github.com> Date: Tue, 3 Oct 2023 15:39:59 +0200 Subject: [PATCH 02/10] removed is.probability funtion and replaced use in other calls by test_probability from additional checkmate assertions --- R/helpers.R | 19 +------------------ 1 file changed, 1 insertion(+), 18 deletions(-) diff --git a/R/helpers.R b/R/helpers.R index 2cef53e84..a6bc34783 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -173,23 +173,6 @@ safeInteger <- function(x) { as.integer(x) } -##' Predicate checking for a probability -##' -##' @param x the object being checked -##' @param bounds whether to include the bounds 0 and 1 (default) -##' @return Returns \code{TRUE} if \code{x} is a probability -##' -##' @keywords internal -is.probability <- function(x, - bounds = TRUE) { - return(is.scalar(x) && - if (bounds) { - 0 <= x && 1 >= x - } else { - 0 < x && 1 > x - }) -} - ##' Predicate checking for a numeric range ##' ##' @param x the object being checked @@ -211,7 +194,7 @@ is.range <- function(x) { is.probRange <- function(x, bounds = TRUE) { return(is.range(x) && - all(sapply(x, is.probability, bounds = bounds))) + all(sapply(x, test_probability, bounds = bounds))) } From 466a42614e9247910cde0f84879b90cd10b645d6 Mon Sep 17 00:00:00 2001 From: dimitriskontosBAY <95923214+dimitriskontosBAY@users.noreply.github.com> Date: Wed, 4 Oct 2023 18:17:00 +0200 Subject: [PATCH 03/10] remove is.probability --- man/is.probability.Rd | 20 -------------------- 1 file changed, 20 deletions(-) delete mode 100644 man/is.probability.Rd diff --git a/man/is.probability.Rd b/man/is.probability.Rd deleted file mode 100644 index c83356096..000000000 --- a/man/is.probability.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers.R -\name{is.probability} -\alias{is.probability} -\title{Predicate checking for a probability} -\usage{ -is.probability(x, bounds = TRUE) -} -\arguments{ -\item{x}{the object being checked} - -\item{bounds}{whether to include the bounds 0 and 1 (default)} -} -\value{ -Returns \code{TRUE} if \code{x} is a probability -} -\description{ -Predicate checking for a probability -} -\keyword{internal} From 338f2d8fedd7ff6d04f86c6bc7e89df6a740c825 Mon Sep 17 00:00:00 2001 From: dimitriskontosBAY Date: Thu, 5 Oct 2023 16:14:29 +0000 Subject: [PATCH 04/10] remove is.range, is.probRange from helpers.R --- R/helpers.R | 25 ------------------------- 1 file changed, 25 deletions(-) diff --git a/R/helpers.R b/R/helpers.R index e2e4cc0bb..d7b2017bb 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -149,31 +149,6 @@ safeInteger <- function(x) { as.integer(x) } -##' Predicate checking for a numeric range -##' -##' @param x the object being checked -##' @return Returns \code{TRUE} if \code{x} is a numeric range -##' -##' @keywords internal -is.range <- function(x) { - return(identical(length(x), 2L) && - x[1] < x[2]) -} - -##' Predicate checking for a probability range -##' -##' @param x the object being checked -##' @param bounds whether to include the bounds 0 and 1 (default) -##' @return Returns \code{TRUE} if \code{x} is a probability range -##' -##' @keywords internal -is.probRange <- function(x, - bounds = TRUE) { - return(is.range(x) && - all(sapply(x, test_probability, bounds = bounds))) -} - - ##' Shorthand for logit function ##' ##' @param x the function argument From 91b904cf6823ab0094c220e65ec667fbbba38c53 Mon Sep 17 00:00:00 2001 From: dimitriskontosBAY <95923214+dimitriskontosBAY@users.noreply.github.com> Date: Thu, 5 Oct 2023 18:29:40 +0200 Subject: [PATCH 05/10] deleting is.probRange documentation --- man/is.probRange.Rd | 20 -------------------- 1 file changed, 20 deletions(-) delete mode 100644 man/is.probRange.Rd diff --git a/man/is.probRange.Rd b/man/is.probRange.Rd deleted file mode 100644 index e27fd5f60..000000000 --- a/man/is.probRange.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers.R -\name{is.probRange} -\alias{is.probRange} -\title{Predicate checking for a probability range} -\usage{ -is.probRange(x, bounds = TRUE) -} -\arguments{ -\item{x}{the object being checked} - -\item{bounds}{whether to include the bounds 0 and 1 (default)} -} -\value{ -Returns \code{TRUE} if \code{x} is a probability range -} -\description{ -Predicate checking for a probability range -} -\keyword{internal} From 72ed746feb248b5520d4c55a879f4b946187656c Mon Sep 17 00:00:00 2001 From: dimitriskontosBAY <95923214+dimitriskontosBAY@users.noreply.github.com> Date: Thu, 5 Oct 2023 18:30:06 +0200 Subject: [PATCH 06/10] deleting is.range documentation --- man/is.range.Rd | 18 ------------------ 1 file changed, 18 deletions(-) delete mode 100644 man/is.range.Rd diff --git a/man/is.range.Rd b/man/is.range.Rd deleted file mode 100644 index fbcea09d6..000000000 --- a/man/is.range.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers.R -\name{is.range} -\alias{is.range} -\title{Predicate checking for a numeric range} -\usage{ -is.range(x) -} -\arguments{ -\item{x}{the object being checked} -} -\value{ -Returns \code{TRUE} if \code{x} is a numeric range -} -\description{ -Predicate checking for a numeric range -} -\keyword{internal} From 5cdad6e2b59e6749e2c65200f742d5924ccdb699 Mon Sep 17 00:00:00 2001 From: dimitriskontosBAY <95923214+dimitriskontosBAY@users.noreply.github.com> Date: Mon, 9 Oct 2023 11:07:54 +0200 Subject: [PATCH 07/10] replace 'test_probaility' with assert_probability(prob_target), to avoid the stopifnot --- R/Rules-methods.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Rules-methods.R b/R/Rules-methods.R index 253a5a9a0..a8bae8f18 100644 --- a/R/Rules-methods.R +++ b/R/Rules-methods.R @@ -3017,7 +3017,7 @@ setMethod("stopTrial", prob_target <- stopping@prob_target ## checks - stopifnot(test_probability(prob_target)) + stopifnot(assert_probability(prob_target)) stopifnot(is(Effmodel, "ModelEff")) stopifnot(is(Effsamples, "Samples")) stopifnot(is.function(TDderive)) @@ -3135,7 +3135,7 @@ setMethod("stopTrial", prob_target <- stopping@prob_target ## checks - stopifnot(test_probability(prob_target)) + stopifnot(assert_probability(prob_target)) stopifnot(is(Effmodel, "ModelEff")) From 3085678e3ab074f3b39d2c464d682aa678f4750e Mon Sep 17 00:00:00 2001 From: dimitriskontosBAY <95923214+dimitriskontosBAY@users.noreply.github.com> Date: Fri, 20 Oct 2023 13:06:36 +0200 Subject: [PATCH 08/10] removed stopifnot due to assert_probability use --- R/Rules-methods.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Rules-methods.R b/R/Rules-methods.R index a8bae8f18..885796374 100644 --- a/R/Rules-methods.R +++ b/R/Rules-methods.R @@ -3017,7 +3017,7 @@ setMethod("stopTrial", prob_target <- stopping@prob_target ## checks - stopifnot(assert_probability(prob_target)) + assert_probability(prob_target) stopifnot(is(Effmodel, "ModelEff")) stopifnot(is(Effsamples, "Samples")) stopifnot(is.function(TDderive)) @@ -3135,7 +3135,7 @@ setMethod("stopTrial", prob_target <- stopping@prob_target ## checks - stopifnot(assert_probability(prob_target)) + assert_probability(prob_target) stopifnot(is(Effmodel, "ModelEff")) From 956a6ee2383abb1a99ec178d90573171aabedf95 Mon Sep 17 00:00:00 2001 From: dimitriskontosBAY Date: Wed, 1 Nov 2023 07:16:02 +0100 Subject: [PATCH 09/10] replaced stopifno(test_probability) with assert_probability --- R/fromQuantiles.R | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/R/fromQuantiles.R b/R/fromQuantiles.R index 75ba8a37e..4513b736e 100644 --- a/R/fromQuantiles.R +++ b/R/fromQuantiles.R @@ -76,8 +76,10 @@ Quantiles2LogisticNormal <- function(dosegrid, )) { ## extracts and checks nDoses <- length(dosegrid) + assert_flag(logNormal) assert_flag(verbose) + assert_probability(level, bounds_closed = FALSE) stopifnot( !is.unsorted(dosegrid, strictly = TRUE), ## the medians must be monotonically increasing: @@ -87,7 +89,6 @@ Quantiles2LogisticNormal <- function(dosegrid, identical(length(upper), nDoses), all(lower < median), all(upper > median), - test_probability(level, bounds = FALSE), identical(length(parlower), 5L), identical(length(parupper), 5L), all(parlower < parstart), @@ -234,10 +235,8 @@ Quantiles2LogisticNormal <- function(dosegrid, ##' @export ##' @keywords programming getMinInfBeta <- function(p, q) { - stopifnot( - test_probability(p, bounds = FALSE), - test_probability(q, bounds = FALSE) - ) + assert_probability(p, bounds_closed = FALSE) + assert_probability(q, bounds_closed = FALSE) ret <- if (q > p) { @@ -309,12 +308,13 @@ MinimalInformative <- function(dosegrid, ...) { ## extracts and checks nDoses <- length(dosegrid) + + assert_probability(threshmin, bounds_closed = FALSE) + assert_probability(threshmax, bounds_closed = FALSE) + assert_probability(probmin, bounds_closed = FALSE) + assert_probability(probmax, bounds_closed = FALSE) stopifnot( - !is.unsorted(dosegrid, strictly = TRUE), - test_probability(threshmin, bounds = FALSE), - test_probability(threshmax, bounds = FALSE), - test_probability(probmin, bounds = FALSE), - test_probability(probmax, bounds = FALSE) + !is.unsorted(dosegrid, strictly = TRUE) ) xmin <- dosegrid[1] xmax <- dosegrid[nDoses] From dc42262e5a43c439274b2b747accd23d409d84e2 Mon Sep 17 00:00:00 2001 From: dimitriskontosBAY Date: Wed, 1 Nov 2023 09:22:26 +0100 Subject: [PATCH 10/10] rerun of updated examples --- man/simulate-DesignGrouped-method.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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