Skip to content

Commit

Permalink
Merge branch 'main' into 694-remove-nooverlap
Browse files Browse the repository at this point in the history
  • Loading branch information
Puzzled-Face authored Oct 10, 2023
2 parents b85adce + b6cdd56 commit ea5ef35
Show file tree
Hide file tree
Showing 18 changed files with 258 additions and 258 deletions.
39 changes: 27 additions & 12 deletions R/Data-class.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand All @@ -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) {
Expand All @@ -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),
Expand Down Expand Up @@ -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)
)
}
Expand Down Expand Up @@ -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) {
Expand All @@ -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),
Expand Down
19 changes: 10 additions & 9 deletions R/Data-methods.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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) {
Expand Down Expand Up @@ -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)
Expand All @@ -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) {
Expand Down Expand Up @@ -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)))
}
Expand All @@ -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)
Expand Down
34 changes: 9 additions & 25 deletions R/Design-methods.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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"
Expand Down Expand Up @@ -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)
Expand All @@ -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"
Expand Down Expand Up @@ -552,8 +548,6 @@ setMethod("simulate",
nCores =
min(parallel::detectCores(), 5L),
...) {
nsim <- safeInteger(nsim)

## checks and extracts
assert_function(trueTox)
assert_function(trueBiomarker)
Expand Down Expand Up @@ -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"
Expand Down Expand Up @@ -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)
Expand All @@ -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"
Expand Down Expand Up @@ -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)
Expand All @@ -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"
Expand Down Expand Up @@ -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)
Expand All @@ -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"
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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"
Expand Down Expand Up @@ -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)
Expand All @@ -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) {
Expand Down Expand Up @@ -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)
Expand Down
18 changes: 9 additions & 9 deletions R/McmcOptions-class.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
)
}
2 changes: 1 addition & 1 deletion R/McmcOptions-methods.R
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ setMethod(
if (iterations_relative <= 0) {
return(0L)
}
safeInteger(floor(iterations_relative / object@step))
as.integer(floor(iterations_relative / object@step))
}
)

Expand Down
Loading

0 comments on commit ea5ef35

Please sign in to comment.