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 3 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_integer(nCores, lower = 1L, len = 1, any.missing = FALSE)

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_integer(nCores, lower = 1L, len = 1, any.missing = FALSE)

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_numeric(sigma2W, lower = 0, len = 1, any.mising = FALSE)
Puzzled-Face marked this conversation as resolved.
Show resolved Hide resolved
assert_numeric(rho, lower = -1, upper = 1, len = 1, any.mising = FALSE)
assert_flag(firstSeparate)
assert_count(nsim, positive = TRUE)
assert_flag(parallel)
assert_integer(nCores, lower = 1L, len = 1, any.missing = FALSE)
Puzzled-Face marked this conversation as resolved.
Show resolved Hide resolved

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_integer(maxNoIncrement, lower = 1, len = 1, any.missing = FALSE)

## 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_integer(nCores, lower = 1L, len = 1, any.missing = FALSE)

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_integer(nCores, lower = 1L, len = 1, any.missing = FALSE)

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_integer(nCores, lower = 1L, len = 1, any.missing = FALSE)

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_integer(nCores, lower = 1L, len = 1, any.missing = FALSE)

## 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_integer(nCores, lower = 1L, len = 1, any.missing = FALSE)

args <- as.data.frame(args)
nArgs <- max(nrow(args), 1L)
Expand Down
12 changes: 9 additions & 3 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_numeric(sigma2W, len = 1),
rho = test_numeric(rho, len = 1)
)
betaZ_params <- ModelParamsNormal(mean, cov)

datamodel <- function() {
for (i in 1:nObs) {
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_numeric(sigma2W, len = 1),
sigma2betaW = test_numeric(sigma2betaW, len = 1)
)

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_numeric(param, len = 1, any.missing = FALSE), param_name)
Puzzled-Face marked this conversation as resolved.
Show resolved Hide resolved
modelspecs <- de@modelspecs
init <- de@init

Expand Down
22 changes: 9 additions & 13 deletions design/single_combo_grouped.Rmd
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ library(crmPack)
library(checkmate)
library(ggplot2)

knitr::opts_chunk$set(echo = TRUE)
knitr::opts_chunk$set(echo = TRUE, error = TRUE)
```

This design introduces prototypes for a design where a monotherapy dose escalation
Expand Down Expand Up @@ -296,7 +296,7 @@ as well.

## Example

```{r LogisticLogNormalGrouped-example}
```{r LogisticLogNormalGrouped-example, error = TRUE}
my_model <- LogisticLogNormalGrouped(
mean = rep(0, 4),
cov = diag(rep(1, 4)),
Expand Down Expand Up @@ -335,7 +335,7 @@ For this to work well we also need to pass additional arguments in the plot meth

We have added a unit test for the plot method of the Samples class already as well.

```{r initial-pars}
```{r initial-pars, error = TRUE}
# Need to choose the prior parameters here.
my_model <- LogisticLogNormalGrouped(
mean = rep(0, 4),
Expand Down Expand Up @@ -370,7 +370,7 @@ intervals are pretty narrow. We also expect a high toxicity already at low dose
levels.
Let's therefore modify the parameters.

```{r prior-elicitation}
```{r prior-elicitation, error = TRUE}
# Need to choose the prior parameters here.
my_model <- LogisticLogNormalGrouped(
mean = c(-4, -4, -4, -4),
Expand Down Expand Up @@ -483,15 +483,11 @@ setMethod("simulate",
nsim <- crmPack:::safeInteger(nsim)

## checks and extracts
stopifnot(
is.function(truth),
is.function(combo_truth),
crmPack:::is.scalar(nsim),
nsim > 0,
crmPack:::is.bool(parallel),
crmPack:::is.scalar(nCores),
nCores > 0
)
assert_function(truth)
assert_function(combo_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
Loading