Design output improved

rpact-com · May 28, 2024 · 2d42c41 · 2d42c41
1 parent 8735fcd
commit 2d42c41
Show file tree

Hide file tree

Showing 12 changed files with 55 additions and 52 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.9241
-Date: 2024-05-23
+Version: 4.0.0.9242
+Date: 2024-05-28
 Authors@R: c(
 	person(
 		given = "Gernot", 

diff --git a/NEWS.md b/NEWS.md
@@ -6,7 +6,7 @@
 * 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 `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 below 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))
+* 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

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: 7940 $
-## |  Last changed: $Date: 2024-05-27 15:47:41 +0200 (Mo, 27 Mai 2024) $
+## |  File version: $Revision: 7941 $
+## |  Last changed: $Date: 2024-05-28 08:44:36 +0200 (Di, 28 Mai 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -2856,24 +2856,25 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
         return(invisible(summaryFactory))
     }
 
-    informationRatesCaption <- ifelse(inherits(design, "TrialDesignGroupSequential"), 
-        "Planned information rate", "Fixed weight")
-
-    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(informationRatesCaption, .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))

diff --git a/R/f_core_constants.R b/R/f_core_constants.R
@@ -1075,16 +1075,6 @@ C_PARAMETER_NAMES_PLOT_SETTINGS <- createDictionary("C_PARAMETER_NAMES_PLOT_SETT
     parameterName <- .getParameterNameTrialDesign(parameterName, obj)
 
     pluralExt <- ifelse(tableOutputEnabled, "", "s")
-
-    if (identical(parameterName, "informationRates") && 
-            (
-                .isTrialDesignInverseNormalOrFisher(obj) ||
-                ((inherits(obj, "TrialDesignPlan") || inherits(obj, "SimulationResults")) && 
-                .isTrialDesignInverseNormalOrFisher(obj[[".design"]]))
-            )
-        ) {
-        return(paste0("Fixed weight", pluralExt))
-    }
 
     if (identical(parameterName, "futilityBounds") &&
             inherits(obj, "TrialDesignSet") && length(obj$designs) > 1) {

diff --git a/R/parameter_descriptions.R b/R/parameter_descriptions.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: info@rpact.com
 ## |
-## |  File version: $Revision: 7940 $
-## |  Last changed: $Date: 2024-05-27 15:47:41 +0200 (Mo, 27 Mai 2024) $
+## |  File version: $Revision: 7941 $
+## |  Last changed: $Date: 2024-05-28 08:44:36 +0200 (Di, 28 Mai 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -65,8 +65,8 @@ NULL
 #' Parameter Description: Information Rates
 #' @param informationRates The information rates t_1, ..., t_kMax (that must be fixed prior to the trial),
 #'   default is \code{(1:kMax) / kMax}. For the weighted inverse normal design, the weights are derived
-#'   through w_1 = sqrt(t_1), and w_k = sqrt(t_k - t_[k-1]). For the weighted Fisher's combination test, the 
-#'   weights (scales) are w_k = sqrt((t_k - t_[k-1]) / t_1) (see the documentation).
+#'   through w_1 = sqrt(t_1), and w_k = sqrt(t_k - t_(k-1)). For the weighted Fisher's combination test, the 
+#'   weights (scales) are w_k = sqrt((t_k - t_(k-1)) / t_1) (see the documentation).
 #' @name param_informationRates
 #' @keywords internal
 NULL

diff --git a/inst/doc/rpact_getting_started.html b/inst/doc/rpact_getting_started.html
@@ -12,7 +12,7 @@
 
 <meta name="author" content="Friedrich Pahlke and Gernot Wassmer" />
 
-<meta name="date" content="2024-05-27" />
+<meta name="date" content="2024-05-28" />
 
 <title>Getting started with rpact</title>
 
@@ -239,7 +239,7 @@
 
 <h1 class="title toc-ignore">Getting started with rpact</h1>
 <h4 class="author">Friedrich Pahlke and Gernot Wassmer</h4>
-<h4 class="date">2024-05-27</h4>
+<h4 class="date">2024-05-28</h4>
 
 
 

diff --git a/man/getDesignFisher.Rd b/man/getDesignFisher.Rd
diff --git a/man/getDesignGroupSequential.Rd b/man/getDesignGroupSequential.Rd
diff --git a/man/getDesignInverseNormal.Rd b/man/getDesignInverseNormal.Rd
diff --git a/man/getGroupSequentialProbabilities.Rd b/man/getGroupSequentialProbabilities.Rd
diff --git a/man/param_informationRates.Rd b/man/param_informationRates.Rd
diff --git a/tests/testthat/test-f_design_plan_count_data.R b/tests/testthat/test-f_design_plan_count_data.R
@@ -14,10 +14,10 @@
 ## |  Contact us for information about our services: info@rpact.com
 ## |
 ## |  File name: test-f_design_plan_count_data.R
-## |  Creation date: 16 January 2024, 11:26:11
-## |  File version: $Revision: 7929 $
-## |  Last changed: $Date: 2024-05-26 13:03:06 +0200 (So, 26 Mai 2024) $
-## |  Last changed by: $Author: wassmer $
+## |  Creation date: 28 May 2024, 09:45:32
+## |  File version: $Revision$
+## |  Last changed: $Date$
+## |  Last changed by: $Author$
 ## |
 
 test_plan_section("Testing the Sample Size Calculation of Count Data Designs for Different Designs and Arguments")
@@ -637,6 +637,8 @@ test_that("'getSampleSizeCounts': Sample size calculation of testing count data
     ## Comparison of the results of TrialDesignPlanCountData object 'result4' with expected results
     expect_equal(result4$directionUpper, c(FALSE, FALSE, FALSE), label = paste0(result4$directionUpper))
     expect_equal(result4$theta, c(0.75, 0.85714286, 0.96428571), tolerance = 1e-07, label = paste0(result4$theta))
+    expect_equal(result4$maxNumberOfSubjects1, c(80, 80, 80), label = paste0(result4$maxNumberOfSubjects1))
+    expect_equal(result4$maxNumberOfSubjects2, c(20, 20, 20), label = paste0(result4$maxNumberOfSubjects2))
     expect_equal(result4$rejectPerStage[1, ], 0.19514116, tolerance = 1e-07, label = paste0(result4$rejectPerStage[1, ]))
     expect_equal(result4$rejectPerStage[2, ], 0.37204423, tolerance = 1e-07, label = paste0(result4$rejectPerStage[2, ]))
     expect_equal(result4$rejectPerStage[3, ], 0.33281461, tolerance = 1e-07, label = paste0(result4$rejectPerStage[3, ]))
@@ -669,6 +671,8 @@ test_that("'getSampleSizeCounts': Sample size calculation of testing count data
         result4CodeBased <- eval(parse(text = getObjectRCode(result4, stringWrapParagraphWidth = NULL)))
         expect_equal(result4CodeBased$directionUpper, result4$directionUpper, tolerance = 1e-07)
         expect_equal(result4CodeBased$theta, result4$theta, tolerance = 1e-07)
+        expect_equal(result4CodeBased$maxNumberOfSubjects1, result4$maxNumberOfSubjects1, tolerance = 1e-07)
+        expect_equal(result4CodeBased$maxNumberOfSubjects2, result4$maxNumberOfSubjects2, tolerance = 1e-07)
         expect_equal(result4CodeBased$rejectPerStage, result4$rejectPerStage, tolerance = 1e-07)
         expect_equal(result4CodeBased$futilityStop, result4$futilityStop, tolerance = 1e-07)
         expect_equal(result4CodeBased$futilityPerStage, result4$futilityPerStage, tolerance = 1e-07)
@@ -775,6 +779,8 @@ test_that("'getSampleSizeCounts': Sample size calculation of testing count data
     ## Comparison of the results of TrialDesignPlanCountData object 'result6' with expected results
     expect_equal(result6$directionUpper, c(FALSE, FALSE), label = paste0(result6$directionUpper))
     expect_equal(result6$theta, c(0.64705882, 0.67647059), tolerance = 1e-07, label = paste0(result6$theta))
+    expect_equal(result6$maxNumberOfSubjects1, c(150, 150), label = paste0(result6$maxNumberOfSubjects1))
+    expect_equal(result6$maxNumberOfSubjects2, c(150, 150), label = paste0(result6$maxNumberOfSubjects2))
     expect_equal(result6$rejectPerStage[1, ], 0.19514116, tolerance = 1e-07, label = paste0(result6$rejectPerStage[1, ]))
     expect_equal(result6$rejectPerStage[2, ], 0.37204423, tolerance = 1e-07, label = paste0(result6$rejectPerStage[2, ]))
     expect_equal(result6$rejectPerStage[3, ], 0.33281461, tolerance = 1e-07, label = paste0(result6$rejectPerStage[3, ]))
@@ -807,6 +813,8 @@ test_that("'getSampleSizeCounts': Sample size calculation of testing count data
         result6CodeBased <- eval(parse(text = getObjectRCode(result6, stringWrapParagraphWidth = NULL)))
         expect_equal(result6CodeBased$directionUpper, result6$directionUpper, tolerance = 1e-07)
         expect_equal(result6CodeBased$theta, result6$theta, tolerance = 1e-07)
+        expect_equal(result6CodeBased$maxNumberOfSubjects1, result6$maxNumberOfSubjects1, tolerance = 1e-07)
+        expect_equal(result6CodeBased$maxNumberOfSubjects2, result6$maxNumberOfSubjects2, tolerance = 1e-07)
         expect_equal(result6CodeBased$rejectPerStage, result6$rejectPerStage, tolerance = 1e-07)
         expect_equal(result6CodeBased$futilityStop, result6$futilityStop, tolerance = 1e-07)
         expect_equal(result6CodeBased$futilityPerStage, result6$futilityPerStage, tolerance = 1e-07)
@@ -1215,7 +1223,7 @@ test_that("'getSampleSizeCounts': Sample size calculation of testing count data
     expect_equal(result3$rejectPerStage[3, ], 0.49132609, tolerance = 1e-07, label = paste0(result3$rejectPerStage[3, ]))
     expect_equal(result3$earlyStop, 0.30867391, tolerance = 1e-07, label = paste0(result3$earlyStop))
     expect_equal(result3$calendarTime[1, ], c(3.2316907, 3.2313779), tolerance = 1e-07, label = paste0(result3$calendarTime[1, ]))
-    expect_equal(result3$calendarTime[2, ], c(4.9818015, 4.9813797), tolerance = 1e-07, label = paste0(result3$calendarTime[2, ]))
+    expect_equal(result3$calendarTime[2, ], c(4.9818015, 4.9813796), tolerance = 1e-07, label = paste0(result3$calendarTime[2, ]))
     expect_equal(result3$calendarTime[3, ], c(9, 9), label = paste0(result3$calendarTime[3, ]))
     expect_equal(result3$expectedStudyDurationH1, c(7.7010947, 7.7009681), tolerance = 1e-07, label = paste0(result3$expectedStudyDurationH1))
     expect_equal(result3$numberOfSubjects[1, ], c(4348, 10310), label = paste0(result3$numberOfSubjects[1, ]))
@@ -1271,6 +1279,8 @@ test_that("'getSampleSizeCounts': Sample size calculation of testing count data
     ## Comparison of the results of TrialDesignPlanCountData object 'result4' with expected results
     expect_equal(result4$directionUpper, c(FALSE, FALSE, FALSE), label = paste0(result4$directionUpper))
     expect_equal(result4$theta, c(0.75, 0.85714286, 0.96428571), tolerance = 1e-07, label = paste0(result4$theta))
+    expect_equal(result4$maxNumberOfSubjects1, c(80, 80, 80), label = paste0(result4$maxNumberOfSubjects1))
+    expect_equal(result4$maxNumberOfSubjects2, c(20, 20, 20), label = paste0(result4$maxNumberOfSubjects2))
     expect_equal(result4$rejectPerStage[1, ], 0.033479189, tolerance = 1e-07, label = paste0(result4$rejectPerStage[1, ]))
     expect_equal(result4$rejectPerStage[2, ], 0.27519472, tolerance = 1e-07, label = paste0(result4$rejectPerStage[2, ]))
     expect_equal(result4$rejectPerStage[3, ], 0.49132609, tolerance = 1e-07, label = paste0(result4$rejectPerStage[3, ]))
@@ -1298,6 +1308,8 @@ test_that("'getSampleSizeCounts': Sample size calculation of testing count data
         result4CodeBased <- eval(parse(text = getObjectRCode(result4, stringWrapParagraphWidth = NULL)))
         expect_equal(result4CodeBased$directionUpper, result4$directionUpper, tolerance = 1e-07)
         expect_equal(result4CodeBased$theta, result4$theta, tolerance = 1e-07)
+        expect_equal(result4CodeBased$maxNumberOfSubjects1, result4$maxNumberOfSubjects1, tolerance = 1e-07)
+        expect_equal(result4CodeBased$maxNumberOfSubjects2, result4$maxNumberOfSubjects2, tolerance = 1e-07)
         expect_equal(result4CodeBased$rejectPerStage, result4$rejectPerStage, tolerance = 1e-07)
         expect_equal(result4CodeBased$earlyStop, result4$earlyStop, tolerance = 1e-07)
         expect_equal(result4CodeBased$calendarTime, result4$calendarTime, tolerance = 1e-07)
@@ -1535,9 +1547,9 @@ test_that("'getSampleSizeCounts': Sample size calculation of testing count data
     expect_equal(result8$rejectPerStage[3, ], 0.49132609, tolerance = 1e-07, label = paste0(result8$rejectPerStage[3, ]))
     expect_equal(result8$earlyStop, 0.30867391, tolerance = 1e-07, label = paste0(result8$earlyStop))
     expect_equal(result8$calendarTime[1, ], c(4.4478569, 4.4878996), tolerance = 1e-07, label = paste0(result8$calendarTime[1, ]))
-    expect_equal(result8$calendarTime[2, ], c(5.9668445, 5.9911665), tolerance = 1e-07, label = paste0(result8$calendarTime[2, ]))
+    expect_equal(result8$calendarTime[2, ], c(5.9668444, 5.9911665), tolerance = 1e-07, label = paste0(result8$calendarTime[2, ]))
     expect_equal(result8$calendarTime[3, ], c(8, 8), label = paste0(result8$calendarTime[3, ]))
-    expect_equal(result8$expectedStudyDurationH1, c(7.3215635, 7.3295973), tolerance = 1e-07, label = paste0(result8$expectedStudyDurationH1))
+    expect_equal(result8$expectedStudyDurationH1, c(7.3215634, 7.3295973), tolerance = 1e-07, label = paste0(result8$expectedStudyDurationH1))
     expect_equal(result8$numberOfSubjects[1, ], c(52, 1032), label = paste0(result8$numberOfSubjects[1, ]))
     expect_equal(result8$numberOfSubjects[2, ], c(69, 1378), label = paste0(result8$numberOfSubjects[2, ]))
     expect_equal(result8$numberOfSubjects[3, ], c(82, 1610), label = paste0(result8$numberOfSubjects[3, ]))