Merge pull request #37 from rpact-com/dev/4.0.0

Dev/4.0.0
rpact-com · May 29, 2024 · 0acfa29 · 0acfa29
2 parents e360b7c + a918de4
commit 0acfa29
Show file tree

Hide file tree

Showing 73 changed files with 5,917 additions and 5,540 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: rpact
 Title: Confirmatory Adaptive Clinical Trial Design and Analysis
-Version: 4.0.0.9239
-Date: 2024-04-05
+Version: 4.0.0.9243
+Date: 2024-05-28
 Authors@R: c(
 	person(
 		given = "Gernot", 

diff --git a/NAMESPACE b/NAMESPACE
@@ -101,7 +101,6 @@ export(getSampleSizeCounts)
 export(getSampleSizeMeans)
 export(getSampleSizeRates)
 export(getSampleSizeSurvival)
-export(getSimulationCounts)
 export(getSimulationEnrichmentMeans)
 export(getSimulationEnrichmentRates)
 export(getSimulationEnrichmentSurvival)

diff --git a/NEWS.md b/NEWS.md
@@ -3,13 +3,16 @@
 
 ## New features
 
+* All reference classes in the package have been replaced by [R6](https://cran.r-project.org/package=R6) classes. This change brings significant advantages, including improved performance, more flexible and cleaner object-oriented programming, and enhanced encapsulation of methods and properties. The transition to R6 classes allows for more efficient memory management and faster execution, making the package more robust and scalable. Additionally, R6 classes provide a more intuitive and user-friendly interface for developers, facilitating the creation and maintenance of complex data structures and workflows.
 * Extension of the function `getPerformanceScore()` for sample size recalculation rules to the setting of binary endpoints according to [Bokelmann et al. (2024)](https://doi.org/10.1186/s12874-024-02150-4)
-* The new functions `getSimulationCounts()` can be used to perform power simulations and the assessment of test characteristics for clinical trials with negative binomial distributed count data.
+* The `getSimulationMultiArmMeans()`, `getSimulationMultiArmRates()`, and `getSimulationMultiArmSurvival()` functions now support an enhanced `selectArmsFunction` argument. Previously, only `effectVector` and `stage` were allowed as arguments. Now, users can optionally utilize additional arguments for more powerful custom function implementations, including `conditionalPower`, `conditionalCriticalValue`, `plannedSubjects/plannedEvents`, `allocationRatioPlanned`, `selectedArms`, `thetaH1` (for means and survival), `stDevH1` (for means), `overallEffects`, and for rates additionally: `piTreatmentsH1`, `piControlH1`, `overallRates`, and `overallRatesControl`.
+* Same as above for`getSimulationEnrichmentMeans()`, `getSimulationEnrichmentRates()`, and `getSimulationEnrichmentSurvival()`. Specifically, support for population selection with `selectPopulationsFunction` argument based on predictive/posterior probabilities added (see [#32](https://github.com/rpact-com/rpact/issues/32))
+
 
 ## Improvements, issues, and changes
 
-* All reference classes were replaced by [R6](https://cran.r-project.org/package=R6) classes due to better performance
-* Issue [#25](https://github.com/rpact-com/rpact/issues/25) fixed
+* Issues [#25](https://github.com/rpact-com/rpact/issues/25), [#35](https://github.com/rpact-com/rpact/issues/35), and [#36](https://github.com/rpact-com/rpact/issues/36) fixed
+* Minor improvements
 
 
 # rpact 3.5.1

diff --git a/R/class_core_plot_settings.R b/R/class_core_plot_settings.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: info@rpact.com
 ## |
-## |  File version: $Revision: 7742 $
-## |  Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $
+## |  File version: $Revision: 7916 $
+## |  Last changed: $Date: 2024-05-22 17:52:27 +0200 (Mi, 22 Mai 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -476,22 +476,22 @@ PlotSettings <- R6::R6Class("PlotSettings",
                     p <- p + ggplot2::theme(aspect.ratio = 1)
                 },
                 "1" = {
-                    p <- p + ggplot2::theme(legend.position = c(0.05, 1), legend.justification = c(0, 1))
+                    p <- p + ggplot2::theme(legend.position = "inside", legend.position.inside = c(0.05, 1), legend.justification = c(0, 1))
                 },
                 "2" = {
-                    p <- p + ggplot2::theme(legend.position = c(0.05, 0.5), legend.justification = c(0, 0.5))
+                    p <- p + ggplot2::theme(legend.position = "inside", legend.position.inside = c(0.05, 0.5), legend.justification = c(0, 0.5))
                 },
                 "3" = {
-                    p <- p + ggplot2::theme(legend.position = c(0.05, 0.05), legend.justification = c(0, 0))
+                    p <- p + ggplot2::theme(legend.position = "inside", legend.position.inside = c(0.05, 0.05), legend.justification = c(0, 0))
                 },
                 "4" = {
-                    p <- p + ggplot2::theme(legend.position = c(0.95, 1), legend.justification = c(1, 1))
+                    p <- p + ggplot2::theme(legend.position = "inside", legend.position.inside = c(0.95, 1), legend.justification = c(1, 1))
                 },
                 "5" = {
-                    p <- p + ggplot2::theme(legend.position = c(0.95, 0.5), legend.justification = c(1, 0.5))
+                    p <- p + ggplot2::theme(legend.position = "inside", legend.position.inside = c(0.95, 0.5), legend.justification = c(1, 0.5))
                 },
                 "6" = {
-                    p <- p + ggplot2::theme(legend.position = c(0.95, 0.05), legend.justification = c(1, 0))
+                    p <- p + ggplot2::theme(legend.position = "inside", legend.position.inside = c(0.95, 0.05), legend.justification = c(1, 0))
                 }
             )
 

diff --git a/R/class_design_plan.R b/R/class_design_plan.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: info@rpact.com
 ## |
-## |  File version: $Revision: 7750 $
-## |  Last changed: $Date: 2024-03-26 15:44:44 +0100 (Di, 26 Mrz 2024) $
+## |  File version: $Revision: 7940 $
+## |  Last changed: $Date: 2024-05-27 15:47:41 +0200 (Mo, 27 Mai 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -898,16 +898,23 @@ TrialDesignPlanSurvival <- R6::R6Class("TrialDesignPlanSurvival",
                 if (any(is.na(pi1))) {
                     pi1Temp <- self$pi1
                 }
+            } else {
+                if (self$.objectType == "sampleSize") {
+                    pi1Temp <- C_PI_1_SAMPLE_SIZE_DEFAULT 
+                } else {
+                    pi1Temp <- C_PI_1_DEFAULT
+                }
             }
             accrualTimeTemp <- self$.getParameterValueIfUserDefinedOrDefault("accrualTime")
             if (!is.null(accrualTimeTemp) && length(accrualTimeTemp) > 0 &&
-                    !all(is.na(accrualTimeTemp)) && accrualTimeTemp[1] != 0) {
-                accrualTimeTemp <- c(0, accrualTimeTemp)
+                    !all(is.na(accrualTimeTemp)) && accrualTimeTemp[1] != 0L) {
+                accrualTimeTemp <- c(0L, as.integer(accrualTimeTemp))
             }
             accrualIntensityTemp <- self$.getParameterValueIfUserDefinedOrDefault("accrualIntensity")
             if (all(is.na(accrualIntensityTemp))) {
                 accrualIntensityTemp <- C_ACCRUAL_INTENSITY_DEFAULT
             }
+
             if (self$.objectType == "sampleSize") {
                 return(getSampleSizeSurvival(
                     design = self$.design,
@@ -917,7 +924,7 @@ TrialDesignPlanSurvival <- R6::R6Class("TrialDesignPlanSurvival",
                     pi2 = self$.getParameterValueIfUserDefinedOrDefault("pi2"),
                     allocationRatioPlanned = self$allocationRatioPlanned,
                     accountForObservationTimes = self$.getParameterValueIfUserDefinedOrDefault("accountForObservationTimes"),
-                    eventTime = self$eventTime,
+                    eventTime = ifelse(all(is.na(self$eventTime)), C_EVENT_TIME_DEFAULT, self$eventTime),
                     accrualTime = accrualTimeTemp,
                     accrualIntensity = accrualIntensityTemp,
                     kappa = self$kappa,
@@ -944,7 +951,7 @@ TrialDesignPlanSurvival <- R6::R6Class("TrialDesignPlanSurvival",
                     pi2 = self$.getParameterValueIfUserDefinedOrDefault("pi2"),
                     directionUpper = directionUpperTemp,
                     allocationRatioPlanned = self$allocationRatioPlanned,
-                    eventTime = self$eventTime,
+                    eventTime = ifelse(all(is.na(self$eventTime)), C_EVENT_TIME_DEFAULT, self$eventTime),
                     accrualTime = accrualTimeTemp,
                     accrualIntensity = accrualIntensityTemp,
                     kappa = self$kappa,

diff --git a/R/class_summary.R b/R/class_summary.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: info@rpact.com
 ## |
-## |  File version: $Revision: 7763 $
-## |  Last changed: $Date: 2024-03-28 14:35:29 +0100 (Do, 28 Mrz 2024) $
+## |  File version: $Revision: 7946 $
+## |  Last changed: $Date: 2024-05-28 12:08:57 +0200 (Di, 28 Mai 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -123,7 +123,7 @@ knit_print.SummaryFactory <- function(x, ...) {
             paste0(utils::capture.output(x$object$.catMarkdownText()), collapse = "\n")
         )
     }
-    
+
     if (isTRUE(x[["markdown"]])) {
         sep <- "\n-----\n\n"
         result <- paste0(sep, result)
@@ -2190,11 +2190,14 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
             ))
         }
         if (!is.null(designPlan[["followUpTime"]]) &&
-                designPlan$.getParameterType("followUpTime") == C_PARAM_USER_DEFINED &&
+                designPlan$.getParameterType("followUpTime") %in% c(C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE) &&
                 length(designPlan$followUpTime) == 1 &&
                 !is.na(designPlan$followUpTime)) {
             header <- .concatenateSummaryText(header, paste0(
-                "follow-up time = ", designPlan$followUpTime[1]
+                "follow-up time = ", round(
+                    designPlan$followUpTime[1],
+                    as.integer(getOption("rpact.summary.digits", 3))
+                )
             ))
         }
         if (settings$survivalEnabled && !is.null(designPlan[["dropoutTime"]])) {
@@ -2378,20 +2381,24 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
 
 .createSummary <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) {
     output <- match.arg(output)
-    
+
     markdown <- attr(object, "markdown")
     if (is.null(markdown) || length(markdown) == 0 || !is.logical(markdown)) {
         markdown <- FALSE
     }
-    
+
     if (inherits(object, "TrialDesignCharacteristics")) {
-        return(.createSummaryDesignPlan(object, digits = digits, output = output, 
-                showStageLevels = TRUE, markdown = markdown))
+        return(.createSummaryDesignPlan(object,
+            digits = digits, output = output,
+            showStageLevels = TRUE, markdown = markdown
+        ))
     }
 
     if (.isTrialDesign(object) || .isTrialDesignPlan(object) || inherits(object, "SimulationResults")) {
-        return(.createSummaryDesignPlan(object, digits = digits, output = output, 
-                showStageLevels = !.isTrialDesignPlan(object), markdown = markdown))
+        return(.createSummaryDesignPlan(object,
+            digits = digits, output = output,
+            showStageLevels = !.isTrialDesignPlan(object), markdown = markdown
+        ))
     }
 
     if (inherits(object, "AnalysisResults")) {
@@ -2405,9 +2412,9 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
     stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "function 'summary' not implemented yet for class ", .getClassName(object))
 }
 
-.createSummaryPerformanceScore <- function(object, ..., 
-        digits = NA_integer_, 
-        output = c("all", "title", "overview", "body"), 
+.createSummaryPerformanceScore <- function(object, ...,
+        digits = NA_integer_,
+        output = c("all", "title", "overview", "body"),
         markdown = FALSE) {
     .createSummaryDesignPlan(object$.simulationResults,
         digits = digits, output = output,
@@ -2440,7 +2447,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
 #'
 #' @noRd
 #'
-.createSummaryAnalysisResults <- function(object, ..., digits = NA_integer_, 
+.createSummaryAnalysisResults <- function(object, ..., digits = NA_integer_,
         output = c("all", "title", "overview", "body"), markdown = FALSE) {
     output <- match.arg(output)
     if (!inherits(object, "AnalysisResults")) {
@@ -2478,8 +2485,10 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
         }
     }
 
-    summaryFactory <- SummaryFactory$new(object = object, 
-        intervalFormat = intervalFormat, output = output, markdown = markdown)
+    summaryFactory <- SummaryFactory$new(
+        object = object,
+        intervalFormat = intervalFormat, output = output, markdown = markdown
+    )
 
     .addDesignInformationToSummary(design, object, summaryFactory, output = output)
 
@@ -2788,6 +2797,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
     .assertIsInClosedInterval(digits, "digits", lower = -1, upper = 12, naAllowed = TRUE)
 
     digitsSampleSize <- 1
+    digitsTime <- 2
     if (digits > 0) {
         digitsGeneral <- digits
         digitsProbabilities <- NA_integer_
@@ -2807,12 +2817,14 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
         digitsSampleSize <- digits
         digitsGeneral <- digits
         digitsProbabilities <- digits
+        digitsTime <- digits
     }
     return(list(
         digits = digits,
         digitsSampleSize = digitsSampleSize,
         digitsGeneral = digitsGeneral,
-        digitsProbabilities = digitsProbabilities
+        digitsProbabilities = digitsProbabilities,
+        digitsTime = digitsTime
     ))
 }
 
@@ -2843,31 +2855,26 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
         )
         return(invisible(summaryFactory))
     }
-
-    informationRatesCaption <- ifelse(inherits(designPlan, "SimulationResults") ||
-        inherits(designPlan, "AnalysisResults"), "Fixed weight", "Information")
-
-    if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "AnalysisResults")) {
-        if (.isTrialDesignFisher(design)) {
-            weights <- .getWeightsFisher(design)
-        } else if (.isTrialDesignInverseNormal(design)) {
-            weights <- .getWeightsInverseNormal(design)
-        } else {
-            weights <- design$informationRates
-        }
-        summaryFactory$addItem(informationRatesCaption, .getSummaryValuesInPercent(weights, FALSE))
+
+    informationRatesCaption <- "Planned information rate"
+    percentFormatEnabled <- TRUE
+    if (.isTrialDesignFisher(design)) {
+        weights <- .getWeightsFisher(design)
+        informationRatesCaption <- "Fixed weight"
+        percentFormatEnabled <- FALSE
+    } else if (.isTrialDesignInverseNormal(design)) {
+        weights <- .getWeightsInverseNormal(design)
+        informationRatesCaption <- "Fixed weight"
+        percentFormatEnabled <- FALSE
     } else {
-        summaryFactory$addItem(
-            paste0(
-                informationRatesCaption,
-                ifelse(inherits(designPlan, "SimulationResults"), "", " rate")
-            ),
-            .getSummaryValuesInPercent(design$informationRates)
-        )
+        weights <- design$informationRates
     }
+    summaryFactory$addItem(informationRatesCaption, 
+        .getSummaryValuesInPercent(weights, percentFormatEnabled = percentFormatEnabled))
 
     if (design$.isDelayedResponseDesign()) {
-        summaryFactory$addItem("Delayed information", .getSummaryValuesInPercent(design$delayedInformation, TRUE))
+        summaryFactory$addItem("Delayed information", 
+            .getSummaryValuesInPercent(design$delayedInformation, percentFormatEnabled = TRUE))
     }
 
     return(invisible(summaryFactory))
@@ -2912,7 +2919,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
         if (!is.null(powerObject)) {
             summaryFactory$addParameter(powerObject,
                 parameterName = "power",
-                parameterCaption = ifelse(design$kMax == 1, "Power", "Overall power"),
+                parameterCaption = ifelse(design$kMax == 1, "Power", "Cumulative power"),
                 roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE
             )
         }
@@ -3003,6 +3010,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
     digitsSampleSize <- digitSettings$digitsSampleSize
     digitsGeneral <- digitSettings$digitsGeneral
     digitsProbabilities <- digitSettings$digitsProbabilities
+    digitsTime <- digitSettings$digitsTime
 
     outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT)
 
@@ -3266,7 +3274,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
         if (any(!is.na(designPlan[[parameterName]]))) {
             summaryFactory$addParameter(designPlan,
                 parameterName = parameterName,
-                parameterCaption = ifelse(design$kMax == 1, "Power", "Overall power"),
+                parameterCaption = ifelse(design$kMax == 1, "Power", "Cumulative power"),
                 roundDigits = digitsProbabilities, cumsumEnabled = TRUE, smoothedZeroFormat = TRUE
             )
         }
@@ -3299,7 +3307,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
             summaryFactory$addParameter(designPlan,
                 parameterName = "calendarTime",
                 parameterCaption = "Calendar time",
-                roundDigits = digitsGeneral
+                roundDigits = digitsTime
             )
         }
 
@@ -3308,7 +3316,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
             summaryFactory$addParameter(designPlan,
                 parameterName = "expectedStudyDurationH1",
                 parameterCaption = "Expected study duration under H1",
-                roundDigits = digitsGeneral,
+                roundDigits = digitsTime,
                 transpose = TRUE
             )
         }
@@ -3318,7 +3326,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
             summaryFactory$addParameter(designPlan,
                 parameterName = "studyTime",
                 parameterCaption = "Study time",
-                roundDigits = digitsGeneral
+                roundDigits = digitsTime
             )
         }
 
@@ -3435,14 +3443,17 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
             if (outputSize == "large") {
                 summaryFactory$addParameter(designPlan,
                     parameterName = "analysisTime",
-                    parameterCaption = "Analysis time", roundDigits = digitsGeneral
+                    parameterCaption = "Analysis time", 
+                    roundDigits = digitsTime
                 )
             }
 
             summaryFactory$addParameter(designPlan,
                 parameterName = "studyDuration",
                 parameterCaption = "Expected study duration",
-                roundDigits = digitsSampleSize, smoothedZeroFormat = TRUE, transpose = TRUE
+                roundDigits = digitsTime, 
+                smoothedZeroFormat = TRUE, 
+                transpose = TRUE 
             )
         }
     }