diff --git a/NAMESPACE b/NAMESPACE index 378bb6b3a..849f843c8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -141,6 +141,7 @@ export(.DefaultGeneralSimulationsSummary) export(.DefaultIncrements) export(.DefaultIncrementsDoseLevels) export(.DefaultIncrementsHSRBeta) +export(.DefaultIncrementsMaxToxProb) export(.DefaultIncrementsMin) export(.DefaultIncrementsOrdinal) export(.DefaultIncrementsRelative) @@ -239,6 +240,7 @@ export(.GeneralSimulations) export(.GeneralSimulationsSummary) export(.IncrementsDoseLevels) export(.IncrementsHSRBeta) +export(.IncrementsMaxToxProb) export(.IncrementsMin) export(.IncrementsOrdinal) export(.IncrementsRelative) @@ -348,6 +350,7 @@ export(FractionalCRM) export(GeneralSimulations) export(IncrementsDoseLevels) export(IncrementsHSRBeta) +export(IncrementsMaxToxProb) export(IncrementsMin) export(IncrementsOrdinal) export(IncrementsRelative) @@ -558,6 +561,7 @@ exportClasses(GeneralSimulationsSummary) exportClasses(Increments) exportClasses(IncrementsDoseLevels) exportClasses(IncrementsHSRBeta) +exportClasses(IncrementsMaxToxProb) exportClasses(IncrementsMin) exportClasses(IncrementsOrdinal) exportClasses(IncrementsRelative) diff --git a/NEWS.md b/NEWS.md index bee6a9ca2..779e0c928 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # Version 2.0.0.9000 * **Note: This release (1.0 -> 2.0) signifies a major breaking revamp of the package.** Users are advised to carefully review the release notes and documentation for detailed information on the changes and any necessary updates to their existing code. +* Implemented the `IncrementsMaxToxProb` class * Implemented `knit_print` methods for almost all `crmPack` classes to improve rendering in Markdown and Quarto documents. See the vignette for more details. * Provided basic support for ordinal CRM models. See the vignette for more details. * Implemented `broom`-like `tidy` methods for all concrete `crmPack` classes. See the vignette for more details. diff --git a/R/Rules-class.R b/R/Rules-class.R index dbdc63a5c..865f3e4e5 100644 --- a/R/Rules-class.R +++ b/R/Rules-class.R @@ -1539,6 +1539,65 @@ IncrementsOrdinal <- function(grade, rule) { ) } +# IncrementsMaxToxProb ---- + +## class ---- + +#' `IncrementsMaxToxProb` +#' +#' @description `r lifecycle::badge("experimental")` +#' +#' [`IncrementsMaxToxProb`] is the class for increments control based on +#' probability of toxicity +#' +#' @slot prob (`numeric`)\cr See Usage Notes below. +#' +#' @section Usage Notes: +#' For binary models, `prob` should be a scalar probability. +#' +#' For ordinal models, `prob` should be a named vector containing the maximum +#' permissible probability of toxicity by grade. The names should match the +#' names of the `yCategories` slot of the associated `DataOrdinal` object. +#' +#' @aliases IncrementsMaxToxProb +#' @export +#' +.IncrementsMaxToxProb <- setClass( + Class = "IncrementsMaxToxProb", + slots = c( + prob = "numeric" + ), + prototype = prototype( + prob = c("DLAE" = 0.2, "DLT" = 0.05) + ), + contains = "Increments", + validity = v_increments_maxtoxprob +) + +## constructor ---- + +#' @rdname IncrementsMaxToxProb-class +#' +#' @param prob (`numeric`)\cr see slot definition. +#' +#' @export +#' @example examples/Rules-class-IncrementsMaxToxProb.R +#' +IncrementsMaxToxProb <- function(prob) { + .IncrementsMaxToxProb( + prob = prob + ) +} + +## default constructor ---- + +#' @rdname IncrementsMaxToxProb-class +#' @note Typically, end users will not use the `.DefaultIncrementsMaxToxProb()` function. +#' @export +.DefaultIncrementsMaxToxProb <- function() { + IncrementsMaxToxProb(prob = c("DLAE" = 0.2, "DLT" = 0.05)) +} + # Stopping ---- ## class ---- diff --git a/R/Rules-methods.R b/R/Rules-methods.R index 77a19fb1a..8d54d8be3 100644 --- a/R/Rules-methods.R +++ b/R/Rules-methods.R @@ -1725,6 +1725,92 @@ setMethod( } ) +## IncrementsMaxToxProb ---- + +#' @describeIn maxDose determine the maximum possible next dose based on the +#' probability of toxicity +#' @param model (`GeneralModel`)\cr The model on which probabilities will be based +#' @param samples (`Samples`)\cr The MCMC samples to which `model` will be applied +#' +#' @aliases maxDose-IncrementsMaxToxProb +#' +#' @export +#' @example examples/Rules-method-maxDose-IncrementsMaxToxProb.R +#' +setMethod( + f = "maxDose", + signature = signature( + increments = "IncrementsMaxToxProb", + data = "DataOrdinal" + ), + definition = function(increments, data, model, samples, ...) { + assert_class(samples, "Samples") + assert_true(length(increments@prob) == length(data@yCategories) - 1) + nm <- utils::tail(names(data@yCategories), -1) + assert_set_equal(names(increments@prob), nm) + + probs <- dplyr::bind_rows( + lapply( + seq_along(increments@prob), + function(g) { + fitted_probs <- fit(samples, model, data, grade = g, ...) + safe_fitted_probs <- dplyr::filter(fitted_probs, middle < increments@prob[nm[g]]) + highest_safe_fitted_prob <- utils::tail(safe_fitted_probs, 1) + } + ) + ) + min(probs$dose) + } +) +#' @describeIn maxDose determine the maximum possible next dose based on the +#' probability of toxicity +#' @param model (`GeneralModel`)\cr The model on which probabilities will be based +#' @param samples (`Samples`)\cr The MCMC samples to which `model` will be applied +#' +#' @aliases maxDose-IncrementsMaxToxProb +#' +#' @export +#' @example examples/Rules-method-maxDose-IncrementsMaxToxProb.R +#' +setMethod( + f = "maxDose", + signature = signature( + increments = "IncrementsMaxToxProb", + data = "Data" + ), + definition = function(increments, data, model, samples, ...) { + assert_class(samples, "Samples") + assert_true(length(increments@prob) == 1) + + fitted_prob <- fit(samples, model, data, ...) + safe_fitted_prob <- dplyr::filter(fitted_prob, middle < increments@prob) + highest_safe_fitted_prob <- utils::tail(safe_fitted_prob, 1) + highest_safe_fitted_prob$dose + } +) + +## tidy-IncrementsMaxToxProb ---- + +#' @rdname tidy +#' @aliases tidy-IncrementsMaxToxProb +#' @example examples/Rules-method-tidyIncrementsMaxToxProb.R +#' @export +setMethod( + f = "tidy", + signature = signature(x = "IncrementsMaxToxProb"), + definition = function(x, ...) { + grades <- names(x@prob) + if (is.null(grades)) { + grades <- "1" + } + tibble( + Grade = grades, + Prob = x@prob + ) %>% + h_tidy_class(x) + } +) + # nolint start ## ============================================================ diff --git a/R/Rules-validity.R b/R/Rules-validity.R index ec79225f2..f9823e420 100644 --- a/R/Rules-validity.R +++ b/R/Rules-validity.R @@ -330,6 +330,16 @@ v_increments_min <- function(object) { v$result() } +#' @describeIn v_increments validates the [`IncrementsMaxToxProb`] +v_increments_maxtoxprob <- function(object) { + v <- Validate() + v$check( + test_probabilities(object@prob), + "prob must be a vector of probabilities with minimum length 1 and no missing values" + ) + v$result() +} + # Stopping ---- #' Internal Helper Functions for Validation of [`Stopping`] Objects diff --git a/_pkgdown.yaml b/_pkgdown.yaml index a516f7e12..a65dc3a88 100644 --- a/_pkgdown.yaml +++ b/_pkgdown.yaml @@ -115,6 +115,7 @@ reference: - IncrementsDoseLevels - IncrementsHSRBeta - IncrementsMin + - IncrementsMaxToxProb - Stopping - StoppingMissingDose - StoppingCohortsNearDose @@ -244,6 +245,7 @@ reference: - v_increments_dose_levels - v_increments_hsr_beta - v_increments_min + - v_increments_maxtoxprob - v_starting_dose - v_stopping_cohorts_near_dose - v_stopping_min_cohorts @@ -395,6 +397,7 @@ reference: - maxDose-IncrementsDoseLevels - maxDose-IncrementsHSRBeta - maxDose-IncrementsMin + - maxDose-IncrementsMaxToxProb - title: Functions contents: - enable_logging @@ -421,6 +424,7 @@ reference: - GeneralSimulations-class - GeneralSimulations - GeneralSimulationsSummary-class + - IncrementsMaxToxProb-class - LogisticLogNormalOrdinal-class - MinimalInformative - NextBestOrdinal-class diff --git a/examples/Rules-class-IncrementsMaxToxProb.R b/examples/Rules-class-IncrementsMaxToxProb.R new file mode 100644 index 000000000..b96145eac --- /dev/null +++ b/examples/Rules-class-IncrementsMaxToxProb.R @@ -0,0 +1,5 @@ +# For use with binary models and data +IncrementsMaxToxProb(prob = 0.35) + +# For use with ordinal models and data +IncrementsMaxToxProb(prob = c("DLAE" = 0.2, "DLT" = 0.05)) diff --git a/examples/Rules-method-maxDose-IncrementsMaxToxProb.R b/examples/Rules-method-maxDose-IncrementsMaxToxProb.R new file mode 100644 index 000000000..22d9a18dd --- /dev/null +++ b/examples/Rules-method-maxDose-IncrementsMaxToxProb.R @@ -0,0 +1,17 @@ +model <- LogisticLogNormalOrdinal( + mean = c(0.25, 0.15, 0.5), + cov = matrix(c(1.5, 0, 0, 0, 2, 0, 0, 0, 1), nrow = 3), + ref_dose = 30 +) + +emptyData <- DataOrdinal( + doseGrid = c(1, 3, 9, 25, 50, 75, 100), + yCategories = c("No tox" = 0L, "DLAE" = 1L, "CRS" = 2L) +) + +# For warning regarding tox, see issue #748 https://github.com/openpharma/crmPack/issues/748 +suppressWarnings({ + samples <- mcmc(emptyData, model, .DefaultMcmcOptions()) +}) +toxIncrements <- IncrementsMaxToxProb(prob = c("DLAE" = 0.2, "CRS" = 0.05)) +maxDose(toxIncrements, emptyData, model, samples) diff --git a/examples/Rules-method-tidyIncrementsMaxToxProb.R b/examples/Rules-method-tidyIncrementsMaxToxProb.R new file mode 100644 index 000000000..2dc4fe007 --- /dev/null +++ b/examples/Rules-method-tidyIncrementsMaxToxProb.R @@ -0,0 +1 @@ +IncrementsMaxToxProb(prob = c("DLAE" = 0.2, "CRS" = 0.05)) %>% tidy() diff --git a/man/IncrementsMaxToxProb-class.Rd b/man/IncrementsMaxToxProb-class.Rd new file mode 100644 index 000000000..3feaaa24b --- /dev/null +++ b/man/IncrementsMaxToxProb-class.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Rules-class.R +\docType{class} +\name{IncrementsMaxToxProb-class} +\alias{IncrementsMaxToxProb-class} +\alias{.IncrementsMaxToxProb} +\alias{IncrementsMaxToxProb} +\alias{.DefaultIncrementsMaxToxProb} +\title{\code{IncrementsMaxToxProb}} +\usage{ +IncrementsMaxToxProb(prob) + +.DefaultIncrementsMaxToxProb() +} +\arguments{ +\item{prob}{(\code{numeric})\cr see slot definition.} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +\code{\link{IncrementsMaxToxProb}} is the class for increments control based on +probability of toxicity +} +\section{Slots}{ + +\describe{ +\item{\code{prob}}{(\code{numeric})\cr See Usage Notes below.} +}} + +\note{ +Typically, end users will not use the \code{.DefaultIncrementsMaxToxProb()} function. +} +\section{Usage Notes}{ + +For binary models, \code{prob} should be a scalar probability. + +For ordinal models, \code{prob} should be a named vector containing the maximum +permissible probability of toxicity by grade. The names should match the +names of the \code{yCategories} slot of the associated \code{DataOrdinal} object. +} + +\examples{ +# For use with binary models and data +IncrementsMaxToxProb(prob = 0.35) + +# For use with ordinal models and data +IncrementsMaxToxProb(prob = c("DLAE" = 0.2, "DLT" = 0.05)) +} diff --git a/man/maxDose.Rd b/man/maxDose.Rd index 067812aff..fb9013fa5 100644 --- a/man/maxDose.Rd +++ b/man/maxDose.Rd @@ -19,6 +19,9 @@ \alias{maxDose,IncrementsMin,DataOrdinal-method} \alias{maxDose,IncrementsOrdinal,DataOrdinal-method} \alias{maxDose-IncrementsOrdinal} +\alias{maxDose,IncrementsMaxToxProb,DataOrdinal-method} +\alias{maxDose-IncrementsMaxToxProb} +\alias{maxDose,IncrementsMaxToxProb,Data-method} \title{Determine the Maximum Possible Next Dose} \usage{ maxDose(increments, data, ...) @@ -40,6 +43,10 @@ maxDose(increments, data, ...) \S4method{maxDose}{IncrementsMin,DataOrdinal}(increments, data, ...) \S4method{maxDose}{IncrementsOrdinal,DataOrdinal}(increments, data, ...) + +\S4method{maxDose}{IncrementsMaxToxProb,DataOrdinal}(increments, data, model, samples, ...) + +\S4method{maxDose}{IncrementsMaxToxProb,Data}(increments, data, model, samples, ...) } \arguments{ \item{increments}{(\code{Increments})\cr the rule for the next best dose.} @@ -47,6 +54,10 @@ maxDose(increments, data, ...) \item{data}{(\code{Data})\cr input data.} \item{...}{additional arguments without method dispatch.} + +\item{model}{(\code{GeneralModel})\cr The model on which probabilities will be based} + +\item{samples}{(\code{Samples})\cr The MCMC samples to which \code{model} will be applied} } \value{ A \code{number}, the maximum possible next dose. @@ -89,6 +100,12 @@ multiple increment rules, taking the minimum across individual increments. \item \code{maxDose(increments = IncrementsOrdinal, data = DataOrdinal)}: determine the maximum possible next dose in an ordinal CRM trial +\item \code{maxDose(increments = IncrementsMaxToxProb, data = DataOrdinal)}: determine the maximum possible next dose based on the +probability of toxicity + +\item \code{maxDose(increments = IncrementsMaxToxProb, data = Data)}: determine the maximum possible next dose based on the +probability of toxicity + }} \examples{ # Example of usage for `IncrementsRelative` maxDose class. @@ -261,4 +278,38 @@ maxDose( increments = IncrementsOrdinal(2L, .DefaultIncrementsRelative()), data = .DefaultDataOrdinal() ) +model <- LogisticLogNormalOrdinal( + mean = c(0.25, 0.15, 0.5), + cov = matrix(c(1.5, 0, 0, 0, 2, 0, 0, 0, 1), nrow = 3), + ref_dose = 30 +) + +emptyData <- DataOrdinal( + doseGrid = c(1, 3, 9, 25, 50, 75, 100), + yCategories = c("No tox" = 0L, "DLAE" = 1L, "CRS" = 2L) +) + +# For warning regarding tox, see issue #748 https://github.com/openpharma/crmPack/issues/748 +suppressWarnings({ + samples <- mcmc(emptyData, model, .DefaultMcmcOptions()) +}) +toxIncrements <- IncrementsMaxToxProb(prob = c("DLAE" = 0.2, "CRS" = 0.05)) +maxDose(toxIncrements, emptyData, model, samples) +model <- LogisticLogNormalOrdinal( + mean = c(0.25, 0.15, 0.5), + cov = matrix(c(1.5, 0, 0, 0, 2, 0, 0, 0, 1), nrow = 3), + ref_dose = 30 +) + +emptyData <- DataOrdinal( + doseGrid = c(1, 3, 9, 25, 50, 75, 100), + yCategories = c("No tox" = 0L, "DLAE" = 1L, "CRS" = 2L) +) + +# For warning regarding tox, see issue #748 https://github.com/openpharma/crmPack/issues/748 +suppressWarnings({ + samples <- mcmc(emptyData, model, .DefaultMcmcOptions()) +}) +toxIncrements <- IncrementsMaxToxProb(prob = c("DLAE" = 0.2, "CRS" = 0.05)) +maxDose(toxIncrements, emptyData, model, samples) } diff --git a/man/tidy.Rd b/man/tidy.Rd index 564f37e0b..2d892b8c8 100644 --- a/man/tidy.Rd +++ b/man/tidy.Rd @@ -26,6 +26,8 @@ \alias{tidy-LogisticIndepBeta} \alias{tidy,Effloglog-method} \alias{tidy-Effloglog} +\alias{tidy,IncrementsMaxToxProb-method} +\alias{tidy-IncrementsMaxToxProb} \alias{tidy,IncrementsRelative-method} \alias{tidy-IncrementsRelative} \alias{tidy,CohortSizeDLT-method} @@ -78,6 +80,8 @@ tidy(x, ...) \S4method{tidy}{Effloglog}(x, ...) +\S4method{tidy}{IncrementsMaxToxProb}(x, ...) + \S4method{tidy}{IncrementsRelative}(x, ...) \S4method{tidy}{CohortSizeDLT}(x, ...) @@ -218,6 +222,7 @@ CohortSizeConst(3) \%>\% tidy() .DefaultSimulations() \%>\% tidy() .DefaultLogisticIndepBeta() \%>\% tidy() .DefaultEffloglog() \%>\% tidy() +IncrementsMaxToxProb(prob = c("DLAE" = 0.2, "CRS" = 0.05)) \%>\% tidy() CohortSizeRange(intervals = c(0, 20), cohort_size = c(1, 3)) \%>\% tidy() .DefaultCohortSizeDLT() \%>\% tidy() .DefaultCohortSizeMin() \%>\% tidy() diff --git a/man/v_increments.Rd b/man/v_increments.Rd index 779637a0b..435f67e9e 100644 --- a/man/v_increments.Rd +++ b/man/v_increments.Rd @@ -8,6 +8,7 @@ \alias{v_increments_dose_levels} \alias{v_increments_hsr_beta} \alias{v_increments_min} +\alias{v_increments_maxtoxprob} \alias{v_increments_ordinal} \alias{v_cohort_size_ordinal} \title{Internal Helper Functions for Validation of \code{\link{Increments}} Objects} @@ -24,6 +25,8 @@ v_increments_hsr_beta(object) v_increments_min(object) +v_increments_maxtoxprob(object) + v_increments_ordinal(object) v_cohort_size_ordinal(object) @@ -61,6 +64,8 @@ object contains valid probability target, threshold and shape parameters. \item \code{v_increments_min()}: validates that the \code{\link{IncrementsMin}} object contains a list with \code{Increments} objects. +\item \code{v_increments_maxtoxprob()}: validates the \code{\link{IncrementsMaxToxProb}} + \item \code{v_increments_ordinal()}: validates that the \code{\link{IncrementsOrdinal}} object contains valid \code{grade} and standard \code{Increments} rule. diff --git a/tests/testthat/_snaps/Rules-methods/nextbest-nextbestdualendpoint-atgt-nodlim.svg b/tests/testthat/_snaps/Rules-methods/nextbest-nextbestdualendpoint-atgt-nodlim.svg index 42933dc63..718228d81 100644 --- a/tests/testthat/_snaps/Rules-methods/nextbest-nextbestdualendpoint-atgt-nodlim.svg +++ b/tests/testthat/_snaps/Rules-methods/nextbest-nextbestdualendpoint-atgt-nodlim.svg @@ -21,135 +21,135 @@ - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Target probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Target probability [%] - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Overdose probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Overdose probability [%] diff --git a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestdualendpoint-abstarget.svg b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestdualendpoint-abstarget.svg index ba2477f3c..ab1f56b98 100644 --- a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestdualendpoint-abstarget.svg +++ b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestdualendpoint-abstarget.svg @@ -21,136 +21,136 @@ - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Target probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Target probability [%] - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Overdose probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Overdose probability [%] diff --git a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestdualendpoint-emax.svg b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestdualendpoint-emax.svg index e4f66e0d4..9ba876288 100644 --- a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestdualendpoint-emax.svg +++ b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestdualendpoint-emax.svg @@ -21,136 +21,136 @@ - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Target probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Target probability [%] - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Overdose probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Overdose probability [%] diff --git a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestdualendpoint.svg b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestdualendpoint.svg index 77a4c7d28..567ca6ea7 100644 --- a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestdualendpoint.svg +++ b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestdualendpoint.svg @@ -21,136 +21,136 @@ - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Target probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Target probability [%] - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Overdose probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Overdose probability [%] diff --git a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrm-dataparts-nodlim.svg b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrm-dataparts-nodlim.svg index fcf460971..e6d0ab8a5 100644 --- a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrm-dataparts-nodlim.svg +++ b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrm-dataparts-nodlim.svg @@ -21,135 +21,135 @@ - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Target probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Target probability [%] - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Overdose probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Overdose probability [%] diff --git a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrm-dataparts.svg b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrm-dataparts.svg index 204f62d6b..f430c5a36 100644 --- a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrm-dataparts.svg +++ b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrm-dataparts.svg @@ -21,136 +21,136 @@ - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Target probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Target probability [%] - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Overdose probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Overdose probability [%] diff --git a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrm-without-doselimit.svg b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrm-without-doselimit.svg index fcf460971..e6d0ab8a5 100644 --- a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrm-without-doselimit.svg +++ b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrm-without-doselimit.svg @@ -21,135 +21,135 @@ - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Target probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Target probability [%] - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Overdose probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Overdose probability [%] diff --git a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrm.svg b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrm.svg index 204f62d6b..f430c5a36 100644 --- a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrm.svg +++ b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrm.svg @@ -21,136 +21,136 @@ - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Target probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Target probability [%] - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Overdose probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Overdose probability [%] diff --git a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrmloss-with-losses-of-4.svg b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrmloss-with-losses-of-4.svg index 5608bde8e..f24489272 100644 --- a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrmloss-with-losses-of-4.svg +++ b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrmloss-with-losses-of-4.svg @@ -21,199 +21,199 @@ - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Target probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Target probability [%] - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Excessive probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Excessive probability [%] - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Unacceptable probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Unacceptable probability [%] @@ -226,60 +226,60 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - -100 -200 -300 -Dose -Loss function +0.0 +0.5 +1.0 +1.5 +2.0 + + + + + + + + +100 +200 +300 +Dose +Loss function diff --git a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrmloss-without-doselimit.svg b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrmloss-without-doselimit.svg index 83bc1f3ab..d7aa948cf 100644 --- a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrmloss-without-doselimit.svg +++ b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrmloss-without-doselimit.svg @@ -21,135 +21,135 @@ - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Target probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Target probability [%] - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Overdose probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Overdose probability [%] @@ -162,60 +162,60 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - -100 -200 -300 -Dose -Loss function +0.0 +0.5 +1.0 +1.5 +2.0 + + + + + + + + +100 +200 +300 +Dose +Loss function diff --git a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrmloss.svg b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrmloss.svg index 529aae3dc..05c3e5be7 100644 --- a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrmloss.svg +++ b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbestncrmloss.svg @@ -21,136 +21,136 @@ - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Target probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Target probability [%] - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -75 -100 - - - - - - - - -100 -200 -300 -Dose -Overdose probability [%] +0 +25 +50 +75 +100 + + + + + + + + +100 +200 +300 +Dose +Overdose probability [%] @@ -163,60 +163,60 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - -100 -200 -300 -Dose -Loss function +0.0 +0.5 +1.0 +1.5 +2.0 + + + + + + + + +100 +200 +300 +Dose +Loss function diff --git a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbesttdsamples-nodoselim.svg b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbesttdsamples-nodoselim.svg index f6956bdc0..3653d735b 100644 --- a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbesttdsamples-nodoselim.svg +++ b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbesttdsamples-nodoselim.svg @@ -54,19 +54,19 @@ 300 TD Posterior density - - - - - - - - - -Max -Next -TD 45 Estimate -TD 40 Estimate + + + + + + + + + +Max +Next +TD 45 Estimate +TD 40 Estimate Plot of nextBest-NextBestTDsamples_nodoselim diff --git a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbesttdsamples.svg b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbesttdsamples.svg index 6827b18f2..86321db20 100644 --- a/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbesttdsamples.svg +++ b/tests/testthat/_snaps/Rules-methods/plot-of-nextbest-nextbesttdsamples.svg @@ -54,19 +54,19 @@ 300 TD Posterior density - - - - - - - - - -Max -Next -TD 45 Estimate -TD 40 Estimate + + + + + + + + + +Max +Next +TD 45 Estimate +TD 40 Estimate Plot of nextBest-NextBestTDsamples diff --git a/tests/testthat/test-Rules-methods.R b/tests/testthat/test-Rules-methods.R index 1d2f1af07..e076a1dcb 100644 --- a/tests/testthat/test-Rules-methods.R +++ b/tests/testthat/test-Rules-methods.R @@ -4230,3 +4230,55 @@ test_that("tidy-IncrementsRelativeDLT works correctly", { class(expected) <- c("tbl_IncrementsRelativeDLT", class(expected)) expect_identical(actual, expected) }) + +test_that("maxDose-IncrementsMaxToxProb works correctly with ordinal data", { + doseGrid <- c(1, 3, 6, 12, 24, 36) + emptyData <- DataOrdinal( + doseGrid = doseGrid, + yCategories = c("No tox" = 0L, "DLAE" = 1L, "CRS" = 2L) + ) + model <- LogisticLogNormalOrdinal( + mean = c(0.25, 0.15, 0.5), + cov = matrix(c(1.5, 0, 0, 0, 2, 0, 0, 0, 1), nrow = 3), + ref_dose = 30 + ) + opts <- McmcOptions(burnin = 10000L, step = 2L, samples = 40000L) + + # For warning regarding tox, see issue #748 https://github.com/openpharma/crmPack/issues/748 + suppressWarnings({ + samples <- mcmc(emptyData, model, opts) + }) + + inc1 <- IncrementsMaxToxProb(prob = c("DLAE" = 0.2, "CRS" = 1.0)) + inc2 <- IncrementsMaxToxProb(prob = c("DLAE" = 1.0, "CRS" = 0.05)) + inc3 <- IncrementsMaxToxProb(prob = c("DLAE" = 0.2, "CRS" = 0.05)) + + expected2 <- fit(samples, model, emptyData, grade = 2L) %>% + dplyr::filter(middle < 0.05) %>% + utils::tail(1) %>% + dplyr::pull(dose) + expected1 <- fit(samples, model, emptyData, grade = 1L) %>% + dplyr::filter(middle < 0.2) %>% + utils::tail(1) %>% + dplyr::pull(dose) + + expect_equal(maxDose(inc1, emptyData, model, samples), expected1) + expect_equal(maxDose(inc2, emptyData, model, samples), expected2) + expect_equal(maxDose(inc3, emptyData, model, samples), min(expected1, expected2)) +}) + +test_that("maxDose-IncrementsMaxToxProb works correctly with binary data", { + emptyData <- .DefaultData() + model <- .DefaultLogisticLogNormal() + opts <- McmcOptions(burnin = 10000L, step = 2L, samples = 40000L) + samples <- mcmc(emptyData, model, opts) + + inc1 <- IncrementsMaxToxProb(prob = 0.33) + + expected1 <- fit(samples, model, emptyData) %>% + dplyr::filter(middle < 0.33) %>% + utils::tail(1) %>% + dplyr::pull(dose) + + expect_equal(maxDose(inc1, emptyData, model, samples), expected1) +}) diff --git a/tests/testthat/test-Rules-validity.R b/tests/testthat/test-Rules-validity.R index 865f9e629..318ebb47b 100644 --- a/tests/testthat/test-Rules-validity.R +++ b/tests/testthat/test-Rules-validity.R @@ -1622,3 +1622,55 @@ test_that("v_safety_window_const returns message for non-valid follow_min", { object@follow_min <- NA_integer_ expect_equal(v_safety_window_const(object), err_msg) }) + +test_that("v_increments_maxtoxprob validates correctly", { + expect_no_error({ + x <- IncrementsMaxToxProb(c("DLAE" = 0.3, "DLT" = 0.1)) + }) + + expect_error({ + x <- IncrementsMaxToxProb(NA) + }) + + expect_error({ + x <- IncrementsMaxToxProb(c(0.3, NA)) + }) + + expect_error({ + x <- IncrementsMaxToxProb(c(-1, 0.2)) + }) + + expect_error({ + x <- IncrementsMaxToxProb(c(0.2, 3)) + }) +}) + +test_that("v_nextbest_ordinal validates correctly", { + expect_no_error({ + x <- NextBestOrdinal(grade = 1L, rule = NextBestMTD(target = 0.3, derive = mean)) + }) + + expect_error( + { + x <- NextBestOrdinal(grade = pi, rule = NextBestMTD(target = 0.3, derive = mean)) + }, + "grade must be a positive integer" + ) + expect_error( + { + x <- NextBestOrdinal(grade = -2, rule = NextBestMTD(target = 0.3, derive = mean)) + }, + "grade must be a positive integer" + ) + + expect_error( + { + x <- NextBestOrdinal(grade = 1L, rule = CohortSizeConst(3)) + }, + paste0( + "invalid class \"NextBestOrdinal\" object: invalid object for slot \"rule\"", + " in class \"NextBestOrdinal\": got class \"CohortSizeConst\", should be or ", + "extend class \"NextBest\"" + ) + ) +})