diff --git a/R/Data-class.R b/R/Data-class.R index 5d2ccce29..a48c114fb 100644 --- a/R/Data-class.R +++ b/R/Data-class.R @@ -117,9 +117,9 @@ Data <- function(x = numeric(), placebo = FALSE, ...) { assert_numeric(x) - assert_numeric(y) - assert_numeric(ID) - assert_numeric(cohort) + assert_integerish(y, lower = 0, upper = 1, any.missing = FALSE) + assert_integerish(ID, unique = TRUE, any.missing = FALSE) + assert_integerish(cohort) assert_numeric(doseGrid, any.missing = FALSE, unique = TRUE) assert_flag(placebo) @@ -128,6 +128,8 @@ Data <- function(x = numeric(), if (length(ID) == 0 && length(x) > 0) { message("Used default patient IDs!") ID <- seq_along(x) + } else { + assert_integerish(ID, unique = TRUE) } if (!placebo && length(cohort) == 0 && length(x) > 0) { @@ -137,13 +139,15 @@ Data <- function(x = numeric(), # have the same dose. Note that this could be wrong, # if two subsequent cohorts are at the same dose. cohort <- as.integer(c(1, 1 + cumsum(diff(x) != 0))) + } else { + assert_integerish(cohort) } .Data( x = as.numeric(x), - y = safeInteger(y), - ID = safeInteger(ID), - cohort = safeInteger(cohort), + y = as.integer(y), + ID = as.integer(ID), + cohort = as.integer(cohort), doseGrid = doseGrid, nObs = length(x), nGrid = length(doseGrid), @@ -307,10 +311,12 @@ DataMixture <- function(xshare = numeric(), yshare = integer(), ...) { d <- Data(...) + assert_integerish(yshare) + assert_numeric(xshare) .DataMixture( d, xshare = as.numeric(xshare), - yshare = safeInteger(yshare), + yshare = as.integer(yshare), nObsshare = length(xshare) ) } @@ -445,8 +451,13 @@ DataOrdinal <- function(x = numeric(), yCategories = c("No DLT" = 0L, "DLT" = 1L), ...) { assert_numeric(doseGrid, any.missing = FALSE, unique = TRUE) - assert_numeric(yCategories, any.missing = FALSE, unique = TRUE) - assert_character(names(yCategories), any.missing = FALSE, unique = TRUE) + assert_integerish( + yCategories, + any.missing = FALSE, + unique = TRUE, + names = "unique", + min.len = 2 + ) assert_flag(placebo) doseGrid <- as.numeric(sort(doseGrid)) @@ -454,6 +465,8 @@ DataOrdinal <- function(x = numeric(), if (length(ID) == 0 && length(x) > 0) { message("Used default patient IDs!") ID <- seq_along(x) + } else { + assert_integerish(ID, unique = TRUE) } if (!placebo && length(cohort) == 0 && length(x) > 0) { @@ -463,13 +476,15 @@ DataOrdinal <- function(x = numeric(), # have the same dose. Note that this could be wrong, # if two subsequent cohorts are at the same dose. cohort <- as.integer(c(1, 1 + cumsum(diff(x) != 0))) + } else { + assert_integerish(cohort) } .DataOrdinal( x = as.numeric(x), - y = safeInteger(y), - ID = safeInteger(ID), - cohort = safeInteger(cohort), + y = as.integer(y), + ID = as.integer(ID), + cohort = as.integer(cohort), doseGrid = doseGrid, nObs = length(x), nGrid = length(doseGrid), diff --git a/R/Data-methods.R b/R/Data-methods.R index 2f37a8834..4ea5f884b 100644 --- a/R/Data-methods.R +++ b/R/Data-methods.R @@ -298,8 +298,8 @@ setMethod( check = TRUE, ...) { assert_numeric(x, min.len = 0, max.len = 1) - assert_numeric(y, lower = 0, upper = 1) - assert_numeric(ID, len = length(y)) + assert_integerish(y, lower = 0, upper = 1, any.missing = FALSE) + assert_integerish(ID, len = length(y), any.missing = FALSE) assert_disjunct(object@ID, ID) assert_flag(new_cohort) assert_flag(check) @@ -315,10 +315,10 @@ setMethod( object@x <- c(object@x, rep(as.numeric(x), n)) # Add DLT data. - object@y <- c(object@y, safeInteger(y)) + object@y <- c(object@y, as.integer(y)) # Add ID. - object@ID <- c(object@ID, safeInteger(ID)) + object@ID <- c(object@ID, as.integer(ID)) # Add cohort number. new_cohort_id <- if (object@nObs == 0) { @@ -389,8 +389,8 @@ setMethod( check = TRUE, ...) { assert_numeric(x, min.len = 0, max.len = 1) - assert_numeric(y, lower = 0, upper = length(object@yCategories) - 1) - assert_numeric(ID, len = length(y)) + assert_integerish(y, lower = 0, upper = length(object@yCategories) - 1, any.missing = FALSE) + assert_integerish(ID, unique = TRUE, any.missing = FALSE, len = length(y)) assert_disjunct(object@ID, ID) assert_flag(new_cohort) assert_flag(check) @@ -406,10 +406,10 @@ setMethod( object@x <- c(object@x, rep(as.numeric(x), n)) # Add DLT data. - object@y <- c(object@y, safeInteger(y)) + object@y <- c(object@y, as.integer(y)) # Add ID. - object@ID <- c(object@ID, safeInteger(ID)) + object@ID <- c(object@ID, as.integer(ID)) # Add cohort number. new_cohort_id <- if (object@nObs == 0) { @@ -576,6 +576,7 @@ setMethod( assert_true(length(y) == 0 || length(y) >= object@nObs) assert_numeric(u, lower = 0, len = length(y)) assert_numeric(t0, lower = 0, len = length(y)) + assert_integerish(y * (trialtime >= t0 + u)) if (length(y) > 0) { assert_number(trialtime, lower = max(c(object@t0, t0))) } @@ -593,7 +594,7 @@ setMethod( # DLT will be observed once the followup time >= the time to DLT # and y = 1 at the same time. - object@y <- safeInteger(y * (trialtime >= t0 + u)) + object@y <- as.integer(y * (trialtime >= t0 + u)) # Update DLT free survival time. object@u <- apply(rbind(u, trialtime - t0), 2, min) diff --git a/R/Design-methods.R b/R/Design-methods.R index 644a50c66..e82331454 100644 --- a/R/Design-methods.R +++ b/R/Design-methods.R @@ -59,8 +59,6 @@ setMethod("simulate", parallel = FALSE, nCores = min(parallel::detectCores(), 5L), ...) { - nsim <- safeInteger(nsim) - ## checks and extracts assert_function(truth) assert_flag(firstSeparate) @@ -76,7 +74,7 @@ setMethod("simulate", ## from this, ## generate the individual seeds for the simulation runs - simSeeds <- sample.int(n = 2147483647, size = nsim) + simSeeds <- sample.int(n = 2147483647, size = as.integer(nsim)) ## the function to produce the run a single simulation ## with index "iterSim" @@ -370,8 +368,6 @@ setMethod("simulate", nCores = min(parallel::detectCores(), 5L), ...) { - nsim <- safeInteger(nsim) - ## checks and extracts assert_function(truth) assert_count(nsim, positive = TRUE) @@ -386,7 +382,7 @@ setMethod("simulate", ## from this, ## generate the individual seeds for the simulation runs - simSeeds <- sample(x = seq_len(1e5), size = nsim) + simSeeds <- sample(x = seq_len(1e5), size = as.integer(nsim)) ## the function to produce the run a single simulation ## with index "iterSim" @@ -552,8 +548,6 @@ setMethod("simulate", nCores = min(parallel::detectCores(), 5L), ...) { - nsim <- safeInteger(nsim) - ## checks and extracts assert_function(trueTox) assert_function(trueBiomarker) @@ -585,7 +579,7 @@ setMethod("simulate", ## from this, ## generate the individual seeds for the simulation runs - simSeeds <- sample(x = seq_len(1e5), size = nsim) + simSeeds <- sample(x = seq_len(1e5), size = as.integer(nsim)) ## the function to produce the run a single simulation ## with index "iterSim" @@ -1748,8 +1742,6 @@ setMethod("simulate", parallel = FALSE, nCores = min(parallel::detectCores(), 5L), ...) { - nsim <- safeInteger(nsim) - ## checks and extracts assert_function(truth) assert_flag(firstSeparate) @@ -1766,7 +1758,7 @@ setMethod("simulate", ## from this, ## generate the individual seeds for the simulation runs - simSeeds <- sample(x = seq_len(1e5), size = nsim) + simSeeds <- sample(x = seq_len(1e5), size = as.integer(nsim)) ## the function to produce the run a single simulation ## with index "iterSim" @@ -2112,8 +2104,6 @@ setMethod("simulate", parallel = FALSE, nCores = min(parallel::detectCores(), 5L), ...) { - nsim <- safeInteger(nsim) - ## checks and extracts assert_function(truth) assert_flag(firstSeparate) @@ -2129,7 +2119,7 @@ setMethod("simulate", ## from this, ## generate the individual seeds for the simulation runs - simSeeds <- sample(x = seq_len(1e5), size = nsim) + simSeeds <- sample(x = seq_len(1e5), size = as.integer(nsim)) ## the function to produce the run a single simulation ## with index "iterSim" @@ -2462,8 +2452,6 @@ setMethod("simulate", parallel = FALSE, nCores = min(parallel::detectCores(), 5L), ...) { - nsim <- safeInteger(nsim) - ## checks and extracts assert_function(trueDLE) assert_function(trueEff) @@ -2487,7 +2475,7 @@ setMethod("simulate", ## from this, ## generate the individual seeds for the simulation runs - simSeeds <- sample(x = seq_len(1e5), size = nsim) + simSeeds <- sample(x = seq_len(1e5), size = as.integer(nsim)) ## the function to produce the run a single simulation ## with index "iterSim" @@ -3001,8 +2989,6 @@ setMethod("simulate", parallel = FALSE, nCores = min(parallel::detectCores(), 5L), ...) { - nsim <- safeInteger(nsim) - ## common checks and extracts assert_function(trueDLE) assert_flag(firstSeparate) @@ -3034,7 +3020,7 @@ setMethod("simulate", ## from this, ## generate the individual seeds for the simulation runs - simSeeds <- sample(x = seq_len(1e5), size = nsim) + simSeeds <- sample(x = seq_len(1e5), size = as.integer(nsim)) ## the function to produce the run a single simulation ## with index "iterSim" @@ -4003,8 +3989,6 @@ setMethod("simulate", DA = TRUE, parallel = FALSE, nCores = min(parallel::detectCores(), 5L), ...) { - nsim <- safeInteger(nsim) ## remove in the future - ## checks and extracts assert_function(truthTox) assert_function(truthSurv) @@ -4021,7 +4005,7 @@ setMethod("simulate", ## from this, ## generate the individual seeds for the simulation runs - simSeeds <- sample(x = seq_len(1e5), size = nsim) + simSeeds <- sample(x = seq_len(1e5), size = as.integer(nsim)) ## Define functions which are useful in DLT Surv generation inverse <- function(f, lower = -100, upper = 100) { @@ -4604,7 +4588,7 @@ setMethod( parallel = FALSE, nCores = min(parallelly::availableCores(), 5), ...) { - nsim <- safeInteger(nsim) + nsim <- as.integer(nsim) assert_function(truth) assert_function(combo_truth) assert_data_frame(args) diff --git a/R/McmcOptions-class.R b/R/McmcOptions-class.R index d9865874e..f54b69327 100644 --- a/R/McmcOptions-class.R +++ b/R/McmcOptions-class.R @@ -78,11 +78,11 @@ McmcOptions <- function(burnin = 1e4L, samples = 1e4L, rng_kind = NA_character_, rng_seed = NA_integer_) { - assert_number(burnin) - assert_number(step) - assert_number(samples) + assert_count(burnin, positive = TRUE) + assert_count(step, positive = TRUE) + assert_count(samples, positive = TRUE) assert_string(rng_kind, na.ok = TRUE) - assert_number(rng_seed, na.ok = TRUE) + assert_count(rng_seed, na.ok = TRUE) if (!is.na(rng_kind)) { rng_kind <- paste0("base::", rng_kind) @@ -90,16 +90,16 @@ McmcOptions <- function(burnin = 1e4L, rng_kind <- NA_character_ } if (!is.na(rng_seed)) { - rng_seed <- safeInteger(rng_seed) + rng_seed <- as.integer(rng_seed) } else { rng_seed <- NA_integer_ } .McmcOptions( - iterations = safeInteger(burnin + (step * samples)), - burnin = safeInteger(burnin), - step = safeInteger(step), + iterations = as.integer(burnin + (step * samples)), + burnin = as.integer(burnin), + step = as.integer(step), rng_kind = rng_kind, - rng_seed = rng_seed + rng_seed = as.integer(rng_seed) ) } diff --git a/R/McmcOptions-methods.R b/R/McmcOptions-methods.R index e20e0ceb2..5ad4cd11a 100644 --- a/R/McmcOptions-methods.R +++ b/R/McmcOptions-methods.R @@ -42,7 +42,7 @@ setMethod( if (iterations_relative <= 0) { return(0L) } - safeInteger(floor(iterations_relative / object@step)) + as.integer(floor(iterations_relative / object@step)) } ) diff --git a/R/Model-class.R b/R/Model-class.R index f4d21bdd6..a489cc12a 100644 --- a/R/Model-class.R +++ b/R/Model-class.R @@ -2202,7 +2202,7 @@ LogisticIndepBeta <- function(binDLE, data) { assert_numeric(binDLE) assert_numeric(DLEdose) - assert_numeric(DLEweights) + assert_integerish(DLEweights, lower = 0, any.missing = FALSE) assert_class(data, "Data") # Combine pseudo and observed data. It can also happen that data@nObs == 0. @@ -2220,7 +2220,7 @@ LogisticIndepBeta <- function(binDLE, .LogisticIndepBeta( binDLE = binDLE, DLEdose = DLEdose, - DLEweights = safeInteger(DLEweights), + DLEweights = as.integer(DLEweights), phi1 = phi1, phi2 = phi2, Pcov = Pcov, @@ -2685,6 +2685,8 @@ DALogisticLogNormal <- function(npiece = 3, c_par = 2, cond_pem = TRUE, ...) { + assert_flag(cond_pem) + start <- LogisticLogNormal(...) datamodel <- function() { @@ -2755,7 +2757,7 @@ DALogisticLogNormal <- function(npiece = 3, l = l, c_par = c_par, h = seq(from = 0L, to = Tmax, length = npiece + 1), - cond = safeInteger(cond_pem) + cond = as.integer(cond_pem) ) if (!from_prior) { ms <- c(list(ref_dose = start@ref_dose, zeros = rep(0, nObs), eps = 1e-10, cadj = 1e10), ms) @@ -2763,9 +2765,11 @@ DALogisticLogNormal <- function(npiece = 3, ms } + assert_integerish(npiece, lower = 1) + .DALogisticLogNormal( start, - npiece = safeInteger(npiece), + npiece = as.integer(npiece), l = l, c_par = c_par, cond_pem = cond_pem, diff --git a/R/Rules-class.R b/R/Rules-class.R index f34957894..3ec8bd032 100644 --- a/R/Rules-class.R +++ b/R/Rules-class.R @@ -1053,10 +1053,11 @@ IncrementsRelative <- function(intervals, increments) { #' @example examples/Rules-class-IncrementsRelativeDLT.R #' IncrementsRelativeDLT <- function(intervals, increments) { - assert_integerish(intervals) + assert_integerish(intervals, lower = 0, any.missing = FALSE) + assert_numeric(increments, any.missing = FALSE, lower = 0) .IncrementsRelativeDLT( - intervals = safeInteger(intervals), + intervals = as.integer(intervals), increments = increments ) } @@ -1102,10 +1103,13 @@ IncrementsRelativeDLT <- function(intervals, increments) { #' @export #' @example examples/Rules-class-IncrementsRelativeDLTCurrent.R #' -IncrementsRelativeDLTCurrent <- function(intervals = c(0, 1), - increments = c(2, 1)) { +IncrementsRelativeDLTCurrent <- function(intervals = c(0L, 1L), + increments = c(2L, 1L)) { + assert_integerish(intervals, lower = 0, any.missing = FALSE) + assert_numeric(increments, any.missing = FALSE, lower = 0) + .IncrementsRelativeDLTCurrent( - intervals = safeInteger(intervals), + intervals = as.integer(intervals), increments = increments ) } @@ -1184,9 +1188,12 @@ IncrementsRelativeDLTCurrent <- function(intervals = c(0, 1), #' @example examples/Rules-class-IncrementsRelative-DataParts.R #' IncrementsRelativeParts <- function(dlt_start, clean_start, ...) { + assert_integerish(dlt_start) + assert_integerish(clean_start) + .IncrementsRelativeParts( - dlt_start = safeInteger(dlt_start), - clean_start = safeInteger(clean_start), + dlt_start = as.integer(dlt_start), + clean_start = as.integer(clean_start), ... ) } @@ -1250,8 +1257,12 @@ IncrementsRelativeParts <- function(dlt_start, clean_start, ...) { #' @example examples/Rules-class-IncrementsDoseLevels.R #' IncrementsDoseLevels <- function(levels = 1L, basis_level = "last") { + assert_count(levels, positive = TRUE) + assert_string(basis_level) + assert_subset(basis_level, c("last", "max")) + .IncrementsDoseLevels( - levels = safeInteger(levels), + levels = as.integer(levels), basis_level = basis_level ) } @@ -1529,14 +1540,16 @@ StoppingMissingDose <- function( StoppingCohortsNearDose <- function(nCohorts = 2L, percentage = 50, report_label = NA_character_) { - nCohorts <- safeInteger(nCohorts) + assert_count(nCohorts, positive = TRUE) + assert_numeric(percentage, lower = 0) + report_label <- h_default_if_empty( as.character(report_label), paste("\u2265", nCohorts, "cohorts dosed in", percentage, "% dose range around NBD") ) .StoppingCohortsNearDose( - nCohorts = safeInteger(nCohorts), + nCohorts = as.integer(nCohorts), percentage = percentage, report_label = report_label ) @@ -1601,14 +1614,16 @@ StoppingCohortsNearDose <- function(nCohorts = 2L, StoppingPatientsNearDose <- function(nPatients = 10L, percentage = 50, report_label = NA_character_) { - nPatients <- safeInteger(nPatients) + assert_count(nPatients, positive = TRUE) + assert_number(percentage, lower = 0, upper = 100) + report_label <- h_default_if_empty( as.character(report_label), paste("\u2265", nPatients, "patients dosed in", percentage, "% dose range around NBD") ) .StoppingPatientsNearDose( - nPatients = nPatients, + nPatients = as.integer(nPatients), percentage = percentage, report_label = report_label ) @@ -1663,14 +1678,15 @@ StoppingPatientsNearDose <- function(nPatients = 10L, #' StoppingMinCohorts <- function(nCohorts = 2L, report_label = NA_character_) { - nCohorts <- safeInteger(nCohorts) + assert_count(nCohorts, positive = TRUE) + report_label <- h_default_if_empty( as.character(report_label), paste("\u2265", nCohorts, "cohorts dosed") ) .StoppingMinCohorts( - nCohorts = safeInteger(nCohorts), + nCohorts = as.integer(nCohorts), report_label = report_label ) } @@ -1722,14 +1738,15 @@ StoppingMinCohorts <- function(nCohorts = 2L, #' StoppingMinPatients <- function(nPatients = 20L, report_label = NA_character_) { - nPatients <- safeInteger(nPatients) + assert_count(nPatients, positive = TRUE) + report_label <- h_default_if_empty( as.character(report_label), paste("\u2265", nPatients, "patients dosed") ) .StoppingMinPatients( - nPatients = safeInteger(nPatients), + nPatients = as.integer(nPatients), report_label = report_label ) } @@ -2681,9 +2698,11 @@ setClass( #' @example examples/Rules-class-CohortSizeRange.R #' CohortSizeRange <- function(intervals, cohort_size) { + assert_integerish(cohort_size, lower = 1, any.missing = FALSE) + .CohortSizeRange( intervals = intervals, - cohort_size = safeInteger(cohort_size) + cohort_size = as.integer(cohort_size) ) } @@ -2739,9 +2758,12 @@ CohortSizeRange <- function(intervals, cohort_size) { #' @example examples/Rules-class-CohortSizeDLT.R #' CohortSizeDLT <- function(intervals, cohort_size) { + assert_integerish(intervals, lower = 0, any.missing = FALSE) + assert_integerish(cohort_size, lower = 1, any.missing = FALSE) + .CohortSizeDLT( - intervals = safeInteger(intervals), - cohort_size = safeInteger(cohort_size) + intervals = as.integer(intervals), + cohort_size = as.integer(cohort_size) ) } @@ -2788,7 +2810,8 @@ CohortSizeDLT <- function(intervals, cohort_size) { #' @example examples/Rules-class-CohortSizeConst.R #' CohortSizeConst <- function(size) { - .CohortSizeConst(size = safeInteger(size)) + assert_integerish(size, min = 1) + .CohortSizeConst(size = as.integer(size)) } ## default constructor ---- @@ -2836,7 +2859,8 @@ CohortSizeConst <- function(size) { #' @example examples/Rules-class-CohortSizeParts.R #' CohortSizeParts <- function(cohort_sizes) { - .CohortSizeParts(cohort_sizes = safeInteger(cohort_sizes)) + assert_integerish(cohort_sizes, min = 1, any.missing = FALSE) + .CohortSizeParts(cohort_sizes = as.integer(cohort_sizes)) } ## default constructor ---- @@ -3064,14 +3088,21 @@ SafetyWindowSize <- function(gap, size, follow, follow_min) { + assert_integerish(follow, lower = 0) + assert_integerish(follow_min, lower = 0) + for (g in gap) { + assert_integerish(g, lower = 0) + } + assert_integerish(size, lower = 0) if (follow > follow_min) { warning("The value of follow_min is typically larger than the value of follow") } + gap <- lapply(gap, as.integer) .SafetyWindowSize( - gap = lapply(gap, safeInteger), - size = safeInteger(size), - follow = safeInteger(follow), - follow_min = safeInteger(follow_min) + gap = gap, + size = as.integer(size), + follow = as.integer(follow), + follow_min = as.integer(follow_min) ) } @@ -3126,12 +3157,16 @@ SafetyWindowSize <- function(gap, SafetyWindowConst <- function(gap, follow, follow_min) { + assert_integerish(follow, lower = 0) + assert_integerish(follow_min, lower = 0) + assert_integerish(gap, lower = 0) + if (follow > follow_min) { warning("the value of follow_min is typically larger than the value of follow") } .SafetyWindowConst( - gap = safeInteger(gap), - follow = safeInteger(follow), - follow_min = safeInteger(follow_min) + gap = as.integer(gap), + follow = as.integer(follow), + follow_min = as.integer(follow_min) ) } diff --git a/R/Simulations-class.R b/R/Simulations-class.R index 04650ea45..af933d8be 100644 --- a/R/Simulations-class.R +++ b/R/Simulations-class.R @@ -85,10 +85,11 @@ NULL GeneralSimulations <- function(data, doses, seed) { + assert_integerish(seed) .GeneralSimulations( data = data, doses = doses, - seed = safeInteger(seed) + seed = as.integer(seed) ) } diff --git a/R/helpers.R b/R/helpers.R index 42d7a4eda..68730c23d 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -118,37 +118,6 @@ noOverlap <- function(a, b) { ) } -##' checks for whole numbers (integers) -##' -##' @param x the numeric vector -##' @param tol the tolerance -##' @return TRUE or FALSE for each element of x -##' -##' @keywords internal -is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) { - abs(x - round(x)) < tol -} - - -##' Safe conversion to integer vector -##' -##' @param x the numeric vector -##' @return the integer vector -##' -##' @keywords internal -safeInteger <- function(x) { - testres <- is.wholenumber(x) - if (!all(testres)) { - notInt <- which(!testres) - stop(paste( - "elements", - paste(notInt, sep = ", "), - "of vector are not integers!" - )) - } - as.integer(x) -} - ##' Predicate checking for a probability ##' ##' @param x the object being checked diff --git a/R/helpers_design.R b/R/helpers_design.R index b30026b78..d51dbd528 100644 --- a/R/helpers_design.R +++ b/R/helpers_design.R @@ -75,7 +75,7 @@ get_result_list <- function( } else { # Process all simulations. cores <- min( - safeInteger(n_cores), + as.integer(n_cores), parallelly::availableCores() ) diff --git a/design/ordinal-crm.Rmd b/design/ordinal-crm.Rmd index a116095b6..5406c9d94 100644 --- a/design/ordinal-crm.Rmd +++ b/design/ordinal-crm.Rmd @@ -351,9 +351,9 @@ DataOrdinal <- function( .DataOrdinal( x = as.numeric(x), - y = crmPack:::safeInteger(y), - ID = crmPack:::safeInteger(ID), - cohort = crmPack:::safeInteger(cohort), + y = y, + ID = ID, + cohort = cohort, doseGrid = doseGrid, nObs = length(x), nGrid = length(doseGrid), @@ -448,10 +448,10 @@ setMethod( object@x <- c(object@x, rep(as.numeric(x), n)) # Add DLT data. - object@y <- c(object@y, crmPack:::safeInteger(y)) + object@y <- c(object@y, y) # Add ID. - object@ID <- c(object@ID, crmPack:::safeInteger(ID)) + object@ID <- c(object@ID, ID) # Add cohort number. new_cohort_id <- if (object@nObs == 0) { diff --git a/design/ordinal_crm.Rmd b/design/ordinal_crm.Rmd index 054e98904..3e50d3c32 100644 --- a/design/ordinal_crm.Rmd +++ b/design/ordinal_crm.Rmd @@ -352,9 +352,9 @@ DataOrdinal <- function( .DataOrdinal( x = as.numeric(x), - y = crmPack:::safeInteger(y), - ID = crmPack:::safeInteger(ID), - cohort = crmPack:::safeInteger(cohort), + y = y, + ID = ID, + cohort = cohort, doseGrid = doseGrid, nObs = length(x), nGrid = length(doseGrid), @@ -450,10 +450,10 @@ setMethod( object@x <- c(object@x, rep(as.numeric(x), n)) # Add DLT data. - object@y <- c(object@y, crmPack:::safeInteger(y)) + object@y <- c(object@y, y) # Add ID. - object@ID <- c(object@ID, crmPack:::safeInteger(ID)) + object@ID <- c(object@ID, ID) # Add cohort number. new_cohort_id <- if (object@nObs == 0) { diff --git a/design/single_combo_grouped.Rmd b/design/single_combo_grouped.Rmd index 481692da7..08841dbd4 100644 --- a/design/single_combo_grouped.Rmd +++ b/design/single_combo_grouped.Rmd @@ -480,8 +480,6 @@ setMethod("simulate", parallel = FALSE, nCores = min(parallelly::availableCores(), 5), ...) { - nsim <- crmPack:::safeInteger(nsim) - ## checks and extracts assert_function(truth) assert_function(combo_truth) diff --git a/man/IncrementsRelativeDLTCurrent-class.Rd b/man/IncrementsRelativeDLTCurrent-class.Rd index 93edafbd5..36d4dddae 100644 --- a/man/IncrementsRelativeDLTCurrent-class.Rd +++ b/man/IncrementsRelativeDLTCurrent-class.Rd @@ -8,7 +8,7 @@ \alias{.DefaultIncrementsRelativeDLTCurrent} \title{\code{IncrementsRelativeDLTCurrent}} \usage{ -IncrementsRelativeDLTCurrent(intervals = c(0, 1), increments = c(2, 1)) +IncrementsRelativeDLTCurrent(intervals = c(0L, 1L), increments = c(2L, 1L)) .DefaultIncrementsRelativeDLTCurrent() } diff --git a/man/is.wholenumber.Rd b/man/is.wholenumber.Rd deleted file mode 100644 index 1712f2f41..000000000 --- a/man/is.wholenumber.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers.R -\name{is.wholenumber} -\alias{is.wholenumber} -\title{checks for whole numbers (integers)} -\usage{ -is.wholenumber(x, tol = .Machine$double.eps^0.5) -} -\arguments{ -\item{x}{the numeric vector} - -\item{tol}{the tolerance} -} -\value{ -TRUE or FALSE for each element of x -} -\description{ -checks for whole numbers (integers) -} -\keyword{internal} diff --git a/man/safeInteger.Rd b/man/safeInteger.Rd deleted file mode 100644 index 01ebec368..000000000 --- a/man/safeInteger.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers.R -\name{safeInteger} -\alias{safeInteger} -\title{Safe conversion to integer vector} -\usage{ -safeInteger(x) -} -\arguments{ -\item{x}{the numeric vector} -} -\value{ -the integer vector -} -\description{ -Safe conversion to integer vector -} -\keyword{internal} diff --git a/tests/testthat/_snaps/Data-methods/plot-of-datadual-with-placebo-and-blinding.svg b/tests/testthat/_snaps/Data-methods/plot-of-datadual-with-placebo-and-blinding.svg index ae01fdfd0..485c4b78f 100644 --- a/tests/testthat/_snaps/Data-methods/plot-of-datadual-with-placebo-and-blinding.svg +++ b/tests/testthat/_snaps/Data-methods/plot-of-datadual-with-placebo-and-blinding.svg @@ -114,40 +114,40 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 25 @@ -158,23 +158,23 @@ - - - - -40 -60 -80 -100 -Dose Level + + + + +40 +60 +80 +100 +Dose Level Biomarker - -Toxicity - - - - -No -Yes + +Toxicity + + + + +No +Yes diff --git a/tests/testthat/_snaps/Data-methods/plot-of-datadual-with-placebo.svg b/tests/testthat/_snaps/Data-methods/plot-of-datadual-with-placebo.svg index a30e2619b..1131cd122 100644 --- a/tests/testthat/_snaps/Data-methods/plot-of-datadual-with-placebo.svg +++ b/tests/testthat/_snaps/Data-methods/plot-of-datadual-with-placebo.svg @@ -126,53 +126,53 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -1 -2 -3 -4 -5 -6 -7 -8 -9 -10 -11 -12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +11 +12 25 @@ -183,25 +183,25 @@ - - - - - -0 -25 -50 -75 -100 -Dose Level + + + + + +0 +25 +50 +75 +100 +Dose Level Biomarker - -Toxicity - - - - -No -Yes + +Toxicity + + + + +No +Yes diff --git a/tests/testthat/test-Samples-methods.R b/tests/testthat/test-Samples-methods.R index 427bb4faf..db67c8f77 100644 --- a/tests/testthat/test-Samples-methods.R +++ b/tests/testthat/test-Samples-methods.R @@ -1442,16 +1442,16 @@ test_that("plot-Samples-DALogisticNormal works correctly", { samples <- mcmc(data, model, options) actual <- plot(samples, model, data) - vdiffr::expect_doppelganger("plot-Samples-DALogisticLogNormal", actual) + vdiffr::expect_doppelganger("plot-samples-dalogisticlognormal", actual) actual1 <- plot(samples, model, data, hazard = TRUE) - vdiffr::expect_doppelganger("plot-Samples-DALogisticLogNormal_hazard-TRUE", actual1) + vdiffr::expect_doppelganger("plot-samples-dalogisticlognormal-hazard-true", actual1) actual2 <- plot(samples, model, data, showLegend = FALSE) - vdiffr::expect_doppelganger("plot-Samples-DALogisticLogNormal_showLegend-FALSE", actual2) + vdiffr::expect_doppelganger("plot-samples-dalogisticlognormal-showlegend-false", actual2) actual3 <- plot(samples, model, data, showLegend = FALSE, hazard = TRUE) - vdiffr::expect_doppelganger("plot-Samples-DALogisticLogNormal_TRUE_FALSE", actual3) + vdiffr::expect_doppelganger("plot-samples-dalogisticlognormal-true-false", actual3) }) test_that("Approximate fails gracefully with bad input", {