Merge 92421f2 into 75659a9

NAMESPACE

@@ -387,6 +387,7 @@ export(OneParExpPrior)
 export(OneParLogNormalPrior)
 export(ProbitLogNormal)
 export(ProbitLogNormalRel)
+export(PseudoDualFlexiSimulations)
 export(PseudoDualSimulations)
 export(PseudoSimulations)
 export(Quantiles2LogisticNormal)

R/Design-methods.R

@@ -3442,7 +3442,7 @@ setMethod("simulate",
           fit = fitDLEList,
           fit_eff = fitEffList,
           sigma2_est = sigma2Estimates,
-          sigma2betaWest = sigma2betaWEstimates,
+          sigma2_beta_w_est = sigma2betaWEstimates,
           stop_reasons = stopReasons,
           stop_report = stop_report,
           seed = RNGstate

R/Simulations-class.R

@@ -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_w_est (`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_w_est = "numeric"),
+    prototype = prototype(sigma2_beta_w_est = 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_w_est (`numeric`)\cr the vector of the final posterior mean sigma2betaW estimates
+#' @param \dots additional parameters from [`PseudoDualSimulations`]
+#'
+#' @export
+PseudoDualFlexiSimulations <- function(sigma2_beta_w_est,
                                        ...) {
   start <- PseudoDualSimulations(...)
   .PseudoDualFlexiSimulations(start,
-    sigma2betaWest = sigma2betaWest
+    sigma2_beta_w_est = sigma2_beta_w_est
   )
 }
 
@@ -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
 ## -------------------------------------------------------------------------------------------------------
 ## ================================================================================================
 

R/Simulations-methods.R

@@ -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_w_est), geom = "boxplot",
             xlab = "", ylab = "Random walk model variance estimates"
           ) +
           coord_flip() + scale_x_discrete(breaks = NULL)

R/Simulations-validity.R

@@ -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_w_est` 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_w_est), nSims),
+    "sigma2_beta_w_est has to have same length as data"
   )
   v$result()
 }

tests/testthat/test-Simulations-class.R

@@ -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_w_est <- 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_w_est = sigma2_beta_w_est,
+    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_w_est, sigma2_beta_w_est)
+})
+
+test_that("PseudoDualFlexiSimulations user constructor argument names", {
+  expect_function(
+    PseudoDualFlexiSimulations,
+    args = c(
+      "sigma2_beta_w_est", "..."
+    ),
+    ordered = TRUE
+  )
+})