Merge branch 'main' into 656_additional_stat

openpharma · Oct 10, 2023 · 7192f55 · 7192f55
2 parents 97e309a + 87b2f34
commit 7192f55
Show file tree

Hide file tree

Showing 23 changed files with 258 additions and 334 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -1,7 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method(plot,gtable)
-S3method(print,gtable)
 export("%>%")
 export("%~%")
 export(.CohortSizeConst)
@@ -524,7 +522,6 @@ importFrom(graphics,lines)
 importFrom(graphics,matlines)
 importFrom(graphics,matplot)
 importFrom(graphics,plot)
-importFrom(grid,grid.draw)
 importFrom(grid,grid.newpage)
 importFrom(grid,pushViewport)
 importFrom(grid,viewport)

diff --git 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,15 +451,22 @@ 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))
 
   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
@@ -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
@@ -62,8 +62,6 @@ setMethod("simulate",
              parallel = FALSE, nCores =
                min(parallel::detectCores(), 5), derive = list(),
              ...) {
-      nsim <- safeInteger(nsim)
-
       ## checks and extracts
       assert_function(truth)
       assert_flag(firstSeparate)
@@ -79,7 +77,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"
@@ -390,8 +388,6 @@ setMethod("simulate",
              nCores =
                min(parallel::detectCores(), 5L),
              ...) {
-      nsim <- safeInteger(nsim)
-
       ## checks and extracts
       assert_function(truth)
       assert_count(nsim, positive = TRUE)
@@ -406,7 +402,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"
@@ -575,8 +571,6 @@ setMethod("simulate",
              nCores =
                min(parallel::detectCores(), 5), derive = list(),
              ...) {
-      nsim <- safeInteger(nsim)
-
       ## checks and extracts
       assert_function(trueTox)
       assert_function(trueBiomarker)
@@ -608,7 +602,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"
@@ -1789,8 +1783,6 @@ setMethod("simulate",
              parallel = FALSE, nCores =
                min(parallel::detectCores(), 5L),
              ...) {
-      nsim <- safeInteger(nsim)
-
       ## checks and extracts
       assert_function(truth)
       assert_flag(firstSeparate)
@@ -1807,7 +1799,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"
@@ -2153,8 +2145,6 @@ setMethod("simulate",
              parallel = FALSE, nCores =
                min(parallel::detectCores(), 5L),
              ...) {
-      nsim <- safeInteger(nsim)
-
       ## checks and extracts
       assert_function(truth)
       assert_flag(firstSeparate)
@@ -2170,7 +2160,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"
@@ -2503,8 +2493,6 @@ setMethod("simulate",
              parallel = FALSE, nCores =
                min(parallel::detectCores(), 5L),
              ...) {
-      nsim <- safeInteger(nsim)
-
       ## checks and extracts
       assert_function(trueDLE)
       assert_function(trueEff)
@@ -2528,7 +2516,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"
@@ -3042,8 +3030,6 @@ setMethod("simulate",
              parallel = FALSE, nCores =
                min(parallel::detectCores(), 5L),
              ...) {
-      nsim <- safeInteger(nsim)
-
       ## common checks and extracts
       assert_function(trueDLE)
       assert_flag(firstSeparate)
@@ -3075,7 +3061,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"
@@ -4048,8 +4034,6 @@ setMethod("simulate",
              parallel = FALSE, nCores = min(parallel::detectCores(), 5),
              derive = list(),
              ...) {
-      nsim <- safeInteger(nsim) ## remove  in the future
-
       ## checks and extracts
       assert_function(truthTox)
       assert_function(truthSurv)
@@ -4066,7 +4050,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) {
@@ -4668,7 +4652,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
@@ -78,28 +78,28 @@ 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)
   } else {
     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
@@ -42,7 +42,7 @@ setMethod(
     if (iterations_relative <= 0) {
       return(0L)
     }
-    safeInteger(floor(iterations_relative / object@step))
+    as.integer(floor(iterations_relative / object@step))
   }
 )