Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Remove references to is.bool and is.scalar #686

Merged
merged 7 commits into from
Oct 4, 2023
Merged

Remove references to is.bool and is.scalar #686

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
3195de0
Remove references to is.bool and is.scalar
Puzzled-Face Oct 2, 2023
c871329
Merge 3195de00fc12cbb9185d575343990d894834a927 into 43a860696596d25b3…
Puzzled-Face Oct 2, 2023
3ac71ca
[skip actions] Restyle files
github-actions[bot] Oct 2, 2023
34f4edf
Responding to review comments
Puzzled-Face Oct 3, 2023
d0e3c3e
Removing lintr moan
Puzzled-Face Oct 3, 2023
75c75f9
Merge branch '685-replace-isscalar-and-isbool-with-corresponding-func…
Puzzled-Face Oct 3, 2023
4c484ee
Updating documentation
Puzzled-Face Oct 3, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
128 changes: 54 additions & 74 deletions R/Design-methods.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -57,20 +57,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),
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 @@ -372,17 +368,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 @@ -556,21 +550,19 @@ setMethod("simulate",
mcmcOptions = McmcOptions(),
parallel = FALSE,
nCores =
min(parallel::detectCores(), 5),
min(parallel::detectCores(), 5L),
...) {
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 @@ -978,7 +970,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 @@ -1754,18 +1746,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 @@ -2120,18 +2110,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 @@ -2472,20 +2460,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 @@ -3013,18 +2999,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 @@ -4017,21 +4001,17 @@ setMethod("simulate",
deescalate = TRUE,
mcmcOptions = McmcOptions(),
DA = TRUE,
parallel = FALSE, nCores = min(parallel::detectCores(), 5),
parallel = FALSE, nCores = min(parallel::detectCores(), 5L),
...) {
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
18 changes: 12 additions & 6 deletions R/Model-class.R
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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