Skip to content

Commit

Permalink
New commit for additional statistics (#663)
Browse files Browse the repository at this point in the history 
* New commit for additional statistics

* [skip actions] Restyle files

* Update: additional statstics added to other designs bug correction suggetions by Clara

* bug corrected

* Update: Additional_stats

* update: additional_stats

* updaze: error_corrections (additional_stats)

* update: additional_statistics

* Dynamic: Additional_statistical_summary

* Additional statistical summary function update

* additional statistical summary changes

* Update: Additional Statistical Summary

* small change: additional stat summary

* Suggested changes: additional_statistics and validation

* [skip actions] Restyle files

* Simulation refectoring

* Simulation small update

* [skip actions] Restyle files

* small update

* incorrectly named file:delete

* removing documentation errors

* update yaml file

---------

Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: Clara <clara.beck@bayer.com>
Co-authored-by: Oliver Boix <95433070+0liver0815@users.noreply.github.com>
Co-authored-by: Daniel Sabanes Bove <danielinteractive@users.noreply.github.com>
  • Loading branch information
@Prerana17 @github-actions
@ClaraBeckBayer @0liver0815 @danielinteractive
5 people authored Oct 11, 2023
1 parent f16e814 commit 14d4d52
Show file tree
Hide file tree
Showing 21 changed files with 463 additions and 134 deletions.
1 change: 1 addition & 0 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -99,6 +99,7 @@ Collate:
'Samples-validity.R'
'Samples-class.R'
'mcmc.R'
'Simulations-validity.R'
'Simulations-class.R'
'helpers_rules.R'
'Model-methods.R'
Expand Down
2 changes: 2 additions & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -59,6 +59,8 @@ usable instances of all concrete subclasses of `Increments`, `Model`, `NextBest`
* Include rolling CRM design, which was previously only available in a separate
GitHub branch.
* Additional authors and change of maintainer.
* Included 'additional_stats' to add reporting of additional parameters to method simulate to summarize MTD.
* 'report_label' can be added to stopping rules for individual or combined stopping rule reporting.

# Version 1.0.0

Expand Down
78 changes: 72 additions & 6 deletions R/Design-methods.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,6 +38,9 @@ NULL
##' @param nCores how many cores should be used for parallel computing?
##' Defaults to the number of cores on the machine, maximum 5.
##' @param \dots not used
##' @param derive a named list of functions which derives statistics, based on the
##' vector of posterior MTD samples. Each list element must therefore accept
##' one and only one argument, which is a numeric vector, and return a number.
##'
##' @return an object of class \code{\linkS4class{Simulations}}
##'
Expand All @@ -57,7 +60,7 @@ setMethod("simulate",
truth, args = NULL, firstSeparate = FALSE,
mcmcOptions = McmcOptions(),
parallel = FALSE, nCores =
min(parallel::detectCores(), 5L),
min(parallel::detectCores(), 5), derive = list(),
...) {
## checks and extracts
assert_function(truth)
Expand Down Expand Up @@ -259,6 +262,18 @@ setMethod("simulate",
data = thisData
)

# Get the MTD estimate from the samples.

target_dose_samples <- dose(
mean(object@nextBest@target),
model = object@model,
samples = thisSamples
)

# Create a function for additional statistical summary.

additional_stats <- lapply(derive, function(f) f(target_dose_samples))

## return the results
thisResult <-
list(
Expand All @@ -273,7 +288,8 @@ setMethod("simulate",
stopit,
"message"
),
report_results = stopit_results
report_results = stopit_results,
additional_stats = additional_stats
)
return(thisResult)
}
Expand Down Expand Up @@ -313,13 +329,17 @@ setMethod("simulate",
stopResults <- lapply(resultList, "[[", "report_results")
stop_matrix <- as.matrix(do.call(rbind, stopResults))

# Result list of additional statistical summary.
additional_stats <- lapply(resultList, "[[", "additional_stats")

## return the results in the Simulations class object
ret <- Simulations(
data = dataList,
doses = recommendedDoses,
fit = fitList,
stop_report = stop_matrix,
stop_reasons = stopReasons,
additional_stats = additional_stats,
seed = RNGstate
)

Expand Down Expand Up @@ -528,6 +548,9 @@ setMethod("simulate",
##' @param nCores how many cores should be used for parallel computing?
##' Defaults to the number of cores on the machine, maximum 5.
##' @param \dots not used
##' @param derive a named list of functions which derives statistics, based on the
##' vector of posterior MTD samples. Each list element must therefore accept
##' one and only one argument, which is a numeric vector, and return a number.
##'
##' @return an object of class \code{\linkS4class{DualSimulations}}
##'
Expand All @@ -546,7 +569,7 @@ setMethod("simulate",
mcmcOptions = McmcOptions(),
parallel = FALSE,
nCores =
min(parallel::detectCores(), 5L),
min(parallel::detectCores(), 5), derive = list(),
...) {
## checks and extracts
assert_function(trueTox)
Expand Down Expand Up @@ -837,6 +860,19 @@ setMethod("simulate",
data = thisData
)

# Get the MTD estimate from the samples.

target_dose_samples <- dose(
mean(object@nextBest@target),
model = object@model,
samples = thisSamples
)

# Create a function for additional statistical summary.

additional_stats <- lapply(derive, function(f) f(target_dose_samples))


## return the results
thisResult <-
list(
Expand All @@ -861,7 +897,8 @@ setMethod("simulate",
attr(
stopit,
"message"
)
),
additional_stats = additional_stats
)

return(thisResult)
Expand Down Expand Up @@ -912,6 +949,9 @@ setMethod("simulate",
## for dual simulations as it would fail in summary otherwise (for dual simulations reporting is not implemented)
stop_report <- matrix(TRUE, nrow = nsim)

## For dual simulations summary of additional statistics.
additional_stats <- lapply(resultList, "[[", "additional_stats")

## return the results in the DualSimulations class object
ret <- DualSimulations(
data = dataList,
Expand All @@ -922,6 +962,7 @@ setMethod("simulate",
fit_biomarker = fitBiomarkerList,
stop_report = stop_report,
stop_reasons = stopReasons,
additional_stats = additional_stats,
seed = RNGstate
)

Expand Down Expand Up @@ -3968,6 +4009,9 @@ setMethod("simulate",
##' @param nCores how many cores should be used for parallel computing?
##' Defaults to the number of cores on the machine (maximum 5)
##' @param \dots not used
##' @param derive a named list of functions which derives statistics, based on the
##' vector of posterior MTD samples. Each list element must therefore accept
##' one and only one argument, which is a numeric vector, and return a number.
##'
##' @return an object of class \code{\linkS4class{Simulations}}
##'
Expand All @@ -3987,7 +4031,8 @@ setMethod("simulate",
deescalate = TRUE,
mcmcOptions = McmcOptions(),
DA = TRUE,
parallel = FALSE, nCores = min(parallel::detectCores(), 5L),
parallel = FALSE, nCores = min(parallel::detectCores(), 5),
derive = list(),
...) {
## checks and extracts
assert_function(truthTox)
Expand Down Expand Up @@ -4456,6 +4501,19 @@ setMethod("simulate",
data = thisData
)

# Get the MTD estimate from the samples.

target_dose_samples <- dose(
mean(object@nextBest@target),
model = object@model,
samples = thisSamples
)

# Create a function for additional statistical summary.

additional_stats <- lapply(derive, function(f) f(target_dose_samples))


## return the results
thisResult <-
list(
Expand All @@ -4470,7 +4528,8 @@ setMethod("simulate",
attr(
stopit,
"message"
)
),
additional_stats = additional_stats
)
return(thisResult)
}
Expand Down Expand Up @@ -4514,17 +4573,22 @@ setMethod("simulate",
stopReasons <- lapply(resultList, "[[", "stop")

stop_report <- matrix(TRUE, nrow = nsim)

additional_stats <- lapply(resultList, "[[", "additional_stats")

## return the results in the Simulations class object
ret <- DASimulations(
data = dataList,
doses = recommendedDoses,
fit = fitList,
trialduration = trialduration,
stop_report = stop_report,
additional_stats = additional_stats,
stop_reasons = stopReasons,
seed = RNGstate
)


return(ret)
}
)
Expand Down Expand Up @@ -4686,13 +4750,15 @@ setMethod(
stop_reasons <- lapply(this_list, "[[", "stop")
report_results <- lapply(this_list, "[[", "results")
stop_report <- as.matrix(do.call(rbind, report_results))
additional_stats <- lapply(this_list, "[[", "additional_stats")

Simulations(
data = data_list,
doses = recommended_doses,
fit = fit_list,
stop_reasons = stop_reasons,
stop_report = stop_report,
additional_stats = additional_stats,
seed = rng_state
)
})
Expand Down
Loading

0 comments on commit 14d4d52

Please sign in to comment.