Skip to content

Commit

Permalink
Merge branch 'main' into 656_additional_stat
Browse files Browse the repository at this point in the history
  • Loading branch information
@Prerana17
Prerana17 authored Oct 9, 2023
2 parents ec070be + d6d5434 commit fac045c
Show file tree
Hide file tree
Showing 44 changed files with 3,676 additions and 3,706 deletions.
128 changes: 54 additions & 74 deletions R/Design-methods.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -60,20 +60,16 @@ setMethod("simulate",
truth, args = NULL, firstSeparate = FALSE,
mcmcOptions = McmcOptions(),
parallel = FALSE, nCores =
min(parallel::detectCores(), 5), derive = list(),
min(parallel::detectCores(), 5), derive = list(),
...) {
nsim <- safeInteger(nsim)

## checks and extracts
stopifnot(
is.function(truth),
is.bool(firstSeparate),
is.scalar(nsim),
nsim > 0,
is.bool(parallel),
is.scalar(nCores),
nCores > 0
)
assert_function(truth)
assert_flag(firstSeparate)
assert_count(nsim, positive = TRUE)
assert_flag(parallel)
assert_count(nCores, positive = TRUE)

args <- as.data.frame(args)
nArgs <- max(nrow(args), 1L)
Expand Down Expand Up @@ -392,17 +388,15 @@ setMethod("simulate",
truth, args = NULL,
parallel = FALSE,
nCores =
min(parallel::detectCores(), 5),
min(parallel::detectCores(), 5L),
...) {
nsim <- safeInteger(nsim)

## checks and extracts
stopifnot(
is.function(truth),
is.scalar(nsim),
nsim > 0,
is.bool(parallel)
)
assert_function(truth)
assert_count(nsim, positive = TRUE)
assert_flag(parallel)
assert_count(nCores, positive = TRUE)

args <- as.data.frame(args)
nArgs <- max(nrow(args), 1L)
Expand Down Expand Up @@ -584,16 +578,14 @@ setMethod("simulate",
nsim <- safeInteger(nsim)

## checks and extracts
stopifnot(
is.function(trueTox),
is.function(trueBiomarker),
is.scalar(sigma2W), sigma2W > 0,
is.scalar(rho), rho < 1, rho > -1,
is.bool(firstSeparate),
is.scalar(nsim),
nsim > 0,
is.bool(parallel)
)
assert_function(trueTox)
assert_function(trueBiomarker)
assert_number(sigma2W, lower = 0)
assert_number(rho, lower = -1, upper = 1)
assert_flag(firstSeparate)
assert_count(nsim, positive = TRUE)
assert_flag(parallel)
assert_count(nCores, positive = TRUE)

args <- as.data.frame(args)
nArgs <- max(nrow(args), 1L)
Expand Down Expand Up @@ -1019,7 +1011,7 @@ setGeneric("examine",
def =
function(object, ..., maxNoIncrement = 100L) {
## check maxNoIncrement argument
stopifnot(is.scalar(maxNoIncrement) && maxNoIncrement > 0)
assert_count(maxNoIncrement, positive = TRUE)

## there should be no default method,
## therefore just forward to next method!
Expand Down Expand Up @@ -1795,18 +1787,16 @@ setMethod("simulate",
truth, args = NULL, firstSeparate = FALSE,
mcmcOptions = McmcOptions(),
parallel = FALSE, nCores =
min(parallel::detectCores(), 5),
min(parallel::detectCores(), 5L),
...) {
nsim <- safeInteger(nsim)

## checks and extracts
stopifnot(
is.function(truth),
is.bool(firstSeparate),
is.scalar(nsim),
nsim > 0,
is.bool(parallel)
)
assert_function(truth)
assert_flag(firstSeparate)
assert_count(nsim, positive = TRUE)
assert_flag(parallel)
assert_count(nCores, positive = TRUE)

args <- as.data.frame(args)
nArgs <- max(nrow(args), 1L)
Expand Down Expand Up @@ -2161,18 +2151,16 @@ setMethod("simulate",
function(object, nsim = 1L, seed = NULL,
truth, args = NULL, firstSeparate = FALSE,
parallel = FALSE, nCores =
min(parallel::detectCores(), 5),
min(parallel::detectCores(), 5L),
...) {
nsim <- safeInteger(nsim)

## checks and extracts
stopifnot(
is.function(truth),
is.bool(firstSeparate),
is.scalar(nsim),
nsim > 0,
is.bool(parallel)
)
assert_function(truth)
assert_flag(firstSeparate)
assert_count(nsim, positive = TRUE)
assert_flag(parallel)
assert_count(nCores, positive = TRUE)

args <- as.data.frame(args)
nArgs <- max(nrow(args), 1L)
Expand Down Expand Up @@ -2513,20 +2501,18 @@ setMethod("simulate",
trueDLE, trueEff, trueNu,
args = NULL, firstSeparate = FALSE,
parallel = FALSE, nCores =
min(parallel::detectCores(), 5),
min(parallel::detectCores(), 5L),
...) {
nsim <- safeInteger(nsim)

## checks and extracts
stopifnot(
is.function(trueDLE),
is.function(trueEff),
trueNu > 0,
is.bool(firstSeparate),
is.scalar(nsim),
nsim > 0,
is.bool(parallel)
)
assert_function(trueDLE)
assert_function(trueEff)
assert_true(trueNu > 0)
assert_flag(firstSeparate)
assert_count(nsim, positive = TRUE)
assert_flag(parallel)
assert_count(nCores, positive = TRUE)

args <- as.data.frame(args)
nArgs <- max(nrow(args), 1L)
Expand Down Expand Up @@ -3054,18 +3040,16 @@ setMethod("simulate",
args = NULL, firstSeparate = FALSE,
mcmcOptions = McmcOptions(),
parallel = FALSE, nCores =
min(parallel::detectCores(), 5),
min(parallel::detectCores(), 5L),
...) {
nsim <- safeInteger(nsim)

## common checks and extracts
stopifnot(
is.function(trueDLE),
is.bool(firstSeparate),
is.scalar(nsim),
nsim > 0,
is.bool(parallel)
)
assert_function(trueDLE)
assert_flag(firstSeparate)
assert_count(nsim, positive = TRUE)
assert_flag(parallel)
assert_count(nCores, positive = TRUE)

## check if special case applies
isFlexi <- is(object@eff_model, "EffFlexi")
Expand Down Expand Up @@ -4067,16 +4051,12 @@ setMethod("simulate",
nsim <- safeInteger(nsim) ## remove in the future

## checks and extracts
stopifnot(
is.function(truthTox),
is.function(truthSurv),
is.bool(firstSeparate), ## remove in the future
is.scalar(nsim), ## remove in the future
nsim > 0,
is.bool(parallel),
is.scalar(nCores),
nCores > 0
)
assert_function(truthTox)
assert_function(truthSurv)
assert_flag(firstSeparate)
assert_count(nsim, positive = TRUE)
assert_flag(parallel)
assert_count(nCores, positive = TRUE)

args <- as.data.frame(args)
nArgs <- max(nrow(args), 1L)
Expand Down Expand Up @@ -4731,7 +4711,6 @@ setMethod(
current$combo$data <- current$combo$data |>
h_add_dlts(current$combo$dose, current$combo$truth, object@combo@cohort_size, firstSeparate)
}
if (current$first) current$first <- FALSE
current$grouped <- h_group_data(current$mono$data, current$combo$data)
current$samples <- mcmc(current$grouped, object@model, mcmcOptions)
if (!current$mono$stop) {
Expand All @@ -4743,7 +4722,7 @@ setMethod(
stopTrial(current$mono$dose, current$samples, object@model, current$mono$data, group = "mono")
current$mono$results <- h_unpack_stopit(current$mono$stop)
}
if (!current$combo$stop) {
if (!current$combo$stop && (!current$first || !object@first_cohort_mono_only)) {
current$combo$limit <- if (is.na(current$mono$dose)) {
0
} else {
Expand All @@ -4760,6 +4739,7 @@ setMethod(
if (object@same_dose && !current$mono$stop && !current$combo$stop) {
current$mono$dose <- current$combo$dose <- min(current$mono$dose, current$combo$dose)
}
if (current$first) current$first <- FALSE
}
current$mono$fit <- fit(current$samples, object@model, current$grouped, group = "mono")
current$combo$fit <- fit(current$samples, object@model, current$grouped, group = "combo")
Expand Down
18 changes: 12 additions & 6 deletions R/Model-class.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1388,8 +1388,11 @@ DualEndpoint <- function(mean,
assert_numeric(sigma2W, min.len = 1, max.len = 2)
assert_numeric(rho, min.len = 1, max.len = 2)

use_fixed <- c(sigma2W = is.scalar(sigma2W), rho = is.scalar(rho))
betaZ_params <- ModelParamsNormal(mean, cov) # nolintr
use_fixed <- c(
sigma2W = test_number(sigma2W),
rho = test_number(rho)
)
beta_z_params <- ModelParamsNormal(mean, cov)

datamodel <- function() {
for (i in 1:nObs) {
Expand All @@ -1416,8 +1419,8 @@ DualEndpoint <- function(mean,
condPrecW <- precW / (1 - pow(rho, 2))
}
modelspecs_prior <- list(
betaZ_mean = betaZ_params@mean,
betaZ_prec = betaZ_params@prec
betaZ_mean = beta_z_params@mean,
betaZ_prec = beta_z_params@prec
)

comp <- list(
Expand All @@ -1442,7 +1445,7 @@ DualEndpoint <- function(mean,
)

.DualEndpoint(
betaZ_params = betaZ_params,
betaZ_params = beta_z_params,
ref_dose = positive_number(ref_dose),
use_log_dose = use_log_dose,
sigma2W = sigma2W,
Expand Down Expand Up @@ -2582,7 +2585,10 @@ EffFlexi <- function(eff,
assert_flag(rw1)
assert_class(data, "DataDual")

use_fixed <- c(sigma2W = is.scalar(sigma2W), sigma2betaW = is.scalar(sigma2betaW))
use_fixed <- c(
sigma2W = test_number(sigma2W),
sigma2betaW = test_number(sigma2betaW)
)

x <- c(eff_dose, getEff(data, no_dlt = TRUE)$x_no_dlt)
x_level <- matchTolerance(x, data@doseGrid)
Expand Down
4 changes: 2 additions & 2 deletions R/fromQuantiles.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -76,6 +76,8 @@ Quantiles2LogisticNormal <- function(dosegrid,
)) {
## extracts and checks
nDoses <- length(dosegrid)
assert_flag(logNormal)
assert_flag(verbose)
stopifnot(
!is.unsorted(dosegrid, strictly = TRUE),
## the medians must be monotonically increasing:
Expand All @@ -86,8 +88,6 @@ Quantiles2LogisticNormal <- function(dosegrid,
all(lower < median),
all(upper > median),
is.probability(level, bounds = FALSE),
is.bool(logNormal),
is.bool(verbose),
identical(length(parlower), 5L),
identical(length(parupper), 5L),
all(parlower < parstart),
Expand Down
35 changes: 5 additions & 30 deletions R/helpers.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -118,30 +118,6 @@ noOverlap <- function(a, b) {
)
}

##' Checking for scalar
##'
##' @param x the input
##' @return Returns \code{TRUE} if \code{x} is a length one vector
##' (i.e., a scalar)
##'
##' @keywords internal
is.scalar <- function(x) {
return(identical(length(x), 1L))
}

##' Predicate checking for a boolean option
##'
##' @param x the object being checked
##' @return Returns \code{TRUE} if \code{x} is a length one logical vector (i.e., a
##' scalar)
##'
##' @keywords internal
is.bool <- function(x) {
return(is.scalar(x) &&
is.logical(x))
}


##' checks for whole numbers (integers)
##'
##' @param x the numeric vector
Expand Down Expand Up @@ -182,12 +158,11 @@ safeInteger <- function(x) {
##' @keywords internal
is.probability <- function(x,
bounds = TRUE) {
return(is.scalar(x) &&
if (bounds) {
0 <= x && 1 >= x
} else {
0 < x && 1 > x
})
if (bounds) {
return(test_numeric(x, lower = 0, upper = 1, any.missing = FALSE))
} else {
return(test_numeric(x, lower = 0, upper = 1, any.missing = FALSE) && x != 0 && x != 1)
}
}

##' Predicate checking for a numeric range
Expand Down
2 changes: 1 addition & 1 deletion R/helpers_model.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -196,7 +196,7 @@ h_model_dual_endpoint_beta <- function(param,
assert_string(param_name)
assert_class(de, "DualEndpoint")

use_fixed <- setNames(is.scalar(param), param_name)
use_fixed <- setNames(test_number(param), param_name)
modelspecs <- de@modelspecs
init <- de@init

Expand Down
Loading

0 comments on commit fac045c

Please sign in to comment.