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.

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

833 cleanup pseudo dual flexi simulations #834

Open
wants to merge 25 commits into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from 14 commits
Commits
Show all changes
25 commits
Select commit Hold shift + click to select a range
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
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -387,6 +387,7 @@ export(OneParExpPrior)
export(OneParLogNormalPrior)
export(ProbitLogNormal)
export(ProbitLogNormalRel)
export(PseudoDualFlexiSimulations)
export(PseudoDualSimulations)
export(PseudoSimulations)
export(Quantiles2LogisticNormal)
Expand Down
2 changes: 1 addition & 1 deletion R/Design-methods.R
Original file line number Diff line number Diff line change
Expand Up @@ -3442,7 +3442,7 @@ setMethod("simulate",
fit = fitDLEList,
fit_eff = fitEffList,
sigma2_est = sigma2Estimates,
sigma2betaWest = sigma2betaWEstimates,
sigma2_beta_west = sigma2betaWEstimates,
pengguanya marked this conversation as resolved.
Show resolved Hide resolved
stop_reasons = stopReasons,
stop_report = stop_report,
seed = RNGstate
Expand Down
54 changes: 24 additions & 30 deletions R/Simulations-class.R
Original file line number Diff line number Diff line change
Expand Up @@ -702,48 +702,41 @@ PseudoDualSimulations <- function(fit_eff,
stop("Class PseudoDualSimulations cannot be instantiated directly. Please use a subclass.")
}

# nolint start
# PseudoDualFlexiSimulations ----

## class ----

## -------------------------------------------------------------------------------
## Class for Pseudo simulation using DLE and efficacy responses using 'EffFlex' efficacy model
## -----------------------------------------------------------------------------------
##' This is a class which captures the trial simulations design using both the
##' DLE and efficacy responses. The design of model from \code{\linkS4class{ModelTox}}
##' class and the efficacy model from \code{\linkS4class{EffFlexi}} class
##' It contains all slots from
##' \code{\linkS4class{GeneralSimulations}}, \code{\linkS4class{PseudoSimulations}}
##' and \code{\linkS4class{PseudoDualSimulations}} object.
##' In comparison to the parent class \code{\linkS4class{PseudoDualSimulations}},
##' it contains additional slots to
##' capture the sigma2betaW estimates.
##'
##' @slot sigma2betaWest the vector of the final posterior mean sigma2betaW estimates
##'
##' @export
##' @keywords class
#' `PseudoDualFlexiSimulations`
#'
#' @description `r lifecycle::badge("stable")`
#' This class captures the trial simulations design using both the DLE and
#' efficacy responses using [`EffFlexi`] efficacy model.
#' It extends [`PseudoDualSimulations`] by adding the capability to capture the sigma2betaW estimates.
#'
#' @slot sigma2_beta_west (`numeric`)\cr the vector of the final posterior mean sigma2betaW estimates
#' @aliases PseudoDualFlexiSimulations
#' @export
.PseudoDualFlexiSimulations <-
setClass(
Class = "PseudoDualFlexiSimulations",
representation(sigma2betaWest = "numeric"),
prototype(sigma2betaWest = c(0.001, 0.002)),
contains = "PseudoDualSimulations",
validity = v_pseudo_dual_flex_simulations
slots = c(sigma2_beta_west = "numeric"),
prototype = prototype(sigma2_beta_west = c(0.001, 0.002)),
contains = "PseudoDualSimulations"
)

validObject(.PseudoDualFlexiSimulations())
## constructor ----

##' Initialization function for 'PseudoDualFlexiSimulations' class
##' @param sigma2betaWest please refer to \code{\linkS4class{PseudoDualFlexiSimulations}} class object
##' @param \dots additional parameters from \code{\linkS4class{PseudoDualSimulations}}
##' @return the \code{\linkS4class{PseudoDualFlexiSimulations}} object
PseudoDualFlexiSimulations <- function(sigma2betaWest,
#' @rdname PseudoDualFlexiSimulations-class
#'
#' @param sigma2_beta_west (`numeric`)\cr the vector of the final posterior mean sigma2betaW estimates
#' @param \dots additional parameters from [`PseudoDualSimulations`]
#'
#' @export
PseudoDualFlexiSimulations <- function(sigma2_beta_west,
...) {
start <- PseudoDualSimulations(...)
.PseudoDualFlexiSimulations(start,
sigma2betaWest = sigma2betaWest
sigma2_beta_west = sigma2_beta_west
)
}

Expand All @@ -753,9 +746,10 @@ PseudoDualFlexiSimulations <- function(sigma2betaWest,
#' @note Typically, end users will not use the `.DefaultPseudoFlexiSimulations()` function.
#' @export
.DefaultPseudoDualFlexiSimulations <- function() {
stop(paste0("Class PseudoFlexiSimulations cannot be instantiated directly. Please use one of its subclasses instead."))
stop("Class PseudoFlexiSimulations cannot be instantiated directly. Please use one of its subclasses instead.")
}

# nolint start
## -------------------------------------------------------------------------------------------------------
## ================================================================================================

Expand Down
2 changes: 1 addition & 1 deletion R/Simulations-methods.R
Original file line number Diff line number Diff line change
Expand Up @@ -2408,7 +2408,7 @@ setMethod("plot",
## save the plot
plotList[[plotIndex <- plotIndex + 1L]] <-
qplot(factor(0),
y = y, data = data.frame(y = x@sigma2betaWest), geom = "boxplot",
y = y, data = data.frame(y = x@sigma2_beta_west), geom = "boxplot",
xlab = "", ylab = "Random walk model variance estimates"
) +
coord_flip() + scale_x_discrete(breaks = NULL)
Expand Down
6 changes: 3 additions & 3 deletions R/Simulations-validity.R
Original file line number Diff line number Diff line change
Expand Up @@ -138,15 +138,15 @@ v_pseudo_dual_simulations <- function(object) {
}

#' @describeIn v_pseudo_simulations validates that the [`PseudoDualFlexiSimulations`]
#' object contains valid `sigma2betaWest` vector of the final posterior mean
#' object contains valid `sigma2_beta_west` vector of the final posterior mean
#' sigma2betaW estimates.`FinalGstarEstimates` , `FinalGstarAtDoseGrid`,
#'
v_pseudo_dual_flex_simulations <- function(object) {
v <- Validate()
nSims <- length(object@data)
v$check(
identical(length(object@sigma2betaWest), nSims),
"sigma2betaWest has to have same length as data"
identical(length(object@sigma2_beta_west), nSims),
"sigma2_beta_west has to have same length as data"
)
v$result()
}
Expand Down
34 changes: 14 additions & 20 deletions man/PseudoDualFlexiSimulations-class.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

19 changes: 0 additions & 19 deletions man/PseudoDualFlexiSimulations.Rd

This file was deleted.

2 changes: 1 addition & 1 deletion man/v_pseudo_simulations.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

89 changes: 89 additions & 0 deletions tests/testthat/test-Simulations-class.R
Original file line number Diff line number Diff line change
Expand Up @@ -479,3 +479,92 @@ test_that("PseudoDualSimulations user constructor argument names are as expected
ordered = TRUE
)
})

# PseudoDualFlexiSimulations-class ----
test_that("PseudoDualFlexiSimulations can be generated without error and return a valid object", {
result <- expect_silent(.PseudoDualFlexiSimulations())
expect_valid(result, "PseudoDualFlexiSimulations")
})

test_that("PseudoDualFlexiSimulations can be instantiated using the constructor", {
fit_eff <- list(c(0.1, 0.2), c(0.3, 0.4))
final_gstar_estimates <- c(0.1, 0.2)
final_gstar_at_dose_grid <- c(0.3, 0.4)
final_gstar_cis <- list(c(0.1, 0.2), c(0.3, 0.4))
final_gstar_ratios <- c(0.1, 0.2)
final_optimal_dose <- c(0.5, 0.6)
final_optimal_dose_at_dose_grid <- c(0.7, 0.8)
sigma2_est <- c(0.01, 0.02)
sigma2_beta_west <- c(0.03, 0.04)

fit <- list(c(0.1, 0.2), c(0.3, 0.4))
final_td_target_during_trial_estimates <- c(0.5, 0.6)
final_td_target_end_of_trial_estimates <- c(0.7, 0.8)
final_td_target_during_trial_at_dose_grid <- c(0.9, 1.0)
final_td_target_end_of_trial_at_dose_grid <- c(1.1, 1.2)
final_tdeot_cis <- list(c(0.1, 0.2), c(0.3, 0.4))
final_tdeot_ratios <- c(0.5, 0.6)
final_cis <- list(c(0.7, 0.8), c(0.9, 1.0))
final_ratios <- c(1.1, 1.2)
stop_report <- matrix(TRUE, nrow = 2)
stop_reasons <- list("A", "B")

data <- list(
Data(
x = 1:3,
y = c(0, 1, 0), # Adjusted values to meet the constraint
doseGrid = 1:3,
ID = 1L:3L,
cohort = 1L:3L
),
Data(
x = 4:6,
y = c(1, 0, 1), # Adjusted values to meet the constraint
doseGrid = 4:6,
ID = 1L:3L,
cohort = 1L:3L
)
)

doses <- c(1, 2)
seed <- as.integer(123)

sim_obj <- PseudoDualFlexiSimulations(
fit_eff = fit_eff,
final_gstar_estimates = final_gstar_estimates,
final_gstar_at_dose_grid = final_gstar_at_dose_grid,
final_gstar_cis = final_gstar_cis,
final_gstar_ratios = final_gstar_ratios,
final_optimal_dose = final_optimal_dose,
final_optimal_dose_at_dose_grid = final_optimal_dose_at_dose_grid,
sigma2_est = sigma2_est,
sigma2_beta_west = sigma2_beta_west,
fit = fit,
data = data,
doses = doses,
final_td_target_during_trial_estimates = final_td_target_during_trial_estimates,
final_td_target_end_of_trial_estimates = final_td_target_end_of_trial_estimates,
final_td_target_during_trial_at_dose_grid = final_td_target_during_trial_at_dose_grid,
final_td_target_end_of_trial_at_dose_grid = final_td_target_end_of_trial_at_dose_grid,
final_tdeot_cis = final_tdeot_cis,
final_tdeot_ratios = final_tdeot_ratios,
final_cis = final_cis,
final_ratios = final_ratios,
stop_report = stop_report,
stop_reasons = stop_reasons,
seed = seed
)

expect_valid(sim_obj, "PseudoDualFlexiSimulations")
expect_identical(sim_obj@sigma2_beta_west, sigma2_beta_west)
})

test_that("PseudoDualFlexiSimulations user constructor argument names", {
expect_function(
PseudoDualFlexiSimulations,
args = c(
"sigma2_beta_west", "..."
),
ordered = TRUE
)
})
Loading