Merge pull request #71 from rpact-com/dev/4.1.1

Added support for unequal variances between two groups
rpact-com · Jan 28, 2025 · a6516fa · a6516fa
2 parents da01d89 + 2576e4d
commit a6516fa
Show file tree

Hide file tree

Showing 35 changed files with 1,137 additions and 630 deletions.
diff --git a/.gitignore b/.gitignore
@@ -37,3 +37,9 @@ testthat-problems.rds
 /figure/create_designPlan-1.png
 /figure/create_designPlan-2.png
 /hs_err_pid51656.log
+/log.txt
+/rpact-Ex.R
+/rpact-Ex.Rout
+/rpact-Ex.pdf
+/tests/rpact_test_result_report.pdf
+/tests/testthat.Rout
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: rpact
 Title: Confirmatory Adaptive Clinical Trial Design and Analysis
-Version: 4.1.1.9273
-Date: 2024-12-12
+Version: 4.1.1.9279
+Date: 2025-01-27
 Authors@R: c(
 	person(
 		given = "Gernot", 
@@ -43,7 +43,8 @@ LazyData: true
 URL: https://www.rpact.org,
     https://www.rpact.com,
     https://github.com/rpact-com/rpact,
-    https://rpact-com.github.io/rpact/
+    https://rpact-com.github.io/rpact,
+    https://rpact.shinyapps.io/connect
 BugReports: https://github.com/rpact-com/rpact/issues
 Language: en-US
 Depends: 

diff --git a/NEWS.md b/NEWS.md
@@ -3,10 +3,11 @@
 ## New features
 
 * For the functions `getSimulationMultiArmMeans()`, `getSimulationMultiArmRates()`, and `getSimulationMultiArmSurvival()` it is now possible to specify a parameter `doseLevels` to define the dose levels for a `linear` or `sigmoidEmax` dose-response relationship (see feature request [#63](https://github.com/rpact-com/rpact/issues/63))
+* Added support for unequal variances between two groups in `getSampleSizeMeans()`, `getPowerMeans()`, and `getSimulationMeans()` functions, see enhancement [#70](https://github.com/rpact-com/rpact/issues/70)
 * `testPackage()` produces a comprehensive installation qualification report in html and pdf format (see new vignette [Installation Qualification of rpact](https://www.rpact.org/vignettes/utilities/rpact_installation_qualification))
-* `setupPackageTests()` sets up the package tests by downloading the test files and copying them to the rpact installation directory.
-* `saveOptions()` saves the current `rpact` options to a configuration file.
-* `resetOptions()` resets the `rpact` options to their default values.
+* `setupPackageTests()` sets up the package tests by downloading the test files and copying them to the rpact installation directory
+* `saveOptions()` saves the current `rpact` options to a configuration file
+* `resetOptions()` resets the `rpact` options to their default values
 
 ## Improvements, issues, and changes
 
@@ -18,6 +19,7 @@
 * Issue [#61](https://github.com/rpact-com/rpact/issues/61) fixed
 * Issue [#68](https://github.com/rpact-com/rpact/issues/68) fixed
 * Flexibility of function `getPiecewiseSurvivalTime()` improved
+* Simulation allows the case #events = #patients
 * Test coverage improved
 * Minor improvements
 

diff --git a/R/class_analysis_results.R b/R/class_analysis_results.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: [email protected]
 ## |
-## |  File version: $Revision: 8360 $
-## |  Last changed: $Date: 2024-11-04 15:40:23 +0100 (Mo, 04 Nov 2024) $
+## |  File version: $Revision: 8474 $
+## |  Last changed: $Date: 2025-01-14 14:32:53 +0100 (Di, 14 Jan 2025) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -1972,7 +1972,8 @@ plot.AnalysisResults <- function(x, y, ...,
     if (nrow(data) == 0) {
         stop(
             C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
-            "unable to create plot because no RCIs are available in the specified analysis result"
+            "unable to create plot because no RCIs are available in the specified analysis result", 
+            call. = FALSE
         )
     }
 
@@ -2136,7 +2137,9 @@ plot.AnalysisResults <- function(x, y, ...,
 
     .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE)
     if (!(type %in% c(1, 2))) {
-        stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1 or 2")
+        stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, 
+            "'type' (", type, ") is not allowed; must be 1 or 2", 
+            call. = FALSE)
     }
 
     .assertIsAnalysisResults(x)
@@ -2162,7 +2165,9 @@ plot.AnalysisResults <- function(x, y, ...,
     }
 
     if (!.isConditionalPowerEnabled(x$nPlanned) && !.isConditionalPowerEnabled(nPlanned)) {
-        stop("'nPlanned' must be defined to create conditional power plot")
+        stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT,
+            "'nPlanned' must be defined to create conditional power plot", 
+            call. = FALSE)
     }
 
     .warnInCaseOfUnknownArguments(

diff --git a/R/class_analysis_stage_results.R b/R/class_analysis_stage_results.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: [email protected]
 ## |
-## |  File version: $Revision: 8141 $
-## |  Last changed: $Date: 2024-08-28 15:03:46 +0200 (Mi, 28 Aug 2024) $
+## |  File version: $Revision: 8474 $
+## |  Last changed: $Date: 2025-01-14 14:32:53 +0100 (Di, 14 Jan 2025) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -1411,7 +1411,9 @@ as.data.frame.StageResults <- function(x, row.names = NULL,
         dataInput <- x[[".dataInput"]]
     }
     if (is.null(dataInput) || !inherits(dataInput, "Dataset")) {
-        stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to get 'dataInput' from ", .getClassName(x))
+        stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, 
+            "failed to get 'dataInput' from ", .getClassName(x), 
+            call. = FALSE)
     }
 
     numberOfTreatments <- dataInput$getNumberOfGroups()
@@ -1432,7 +1434,8 @@ as.data.frame.StageResults <- function(x, row.names = NULL,
         stop(
             C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'treatmentArms' (",
             .arrayToString(treatmentArmsToShow), ") must be a vector ",
-            "containing one or more values of ", .arrayToString(validComparisons)
+            "containing one or more values of ", .arrayToString(validComparisons), 
+            call. = FALSE
         )
     }
     treatmentArmsToShow <- sort(unique(treatmentArmsToShow))
@@ -1445,7 +1448,9 @@ as.data.frame.StageResults <- function(x, row.names = NULL,
         dataInput <- x[[".dataInput"]]
     }
     if (is.null(dataInput) || !inherits(dataInput, "Dataset")) {
-        stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to get 'dataInput' from ", .getClassName(x))
+        stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, 
+            "failed to get 'dataInput' from ", .getClassName(x), 
+            call. = FALSE)
     }
 
     numberOfPopulations <- gMax
@@ -1467,7 +1472,8 @@ as.data.frame.StageResults <- function(x, row.names = NULL,
         stop(
             C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'populations' (",
             .arrayToString(populationsToShow), ") must be a vector ",
-            "containing one or more values of ", .arrayToString(validComparisons)
+            "containing one or more values of ", .arrayToString(validComparisons), 
+            call. = FALSE
         )
     }
     populationsToShow <- sort(unique(populationsToShow))
@@ -1609,7 +1615,9 @@ plot.StageResults <- function(
     .stopInCaseOfIllegalStageDefinition2(...)
 
     if (x$.design$kMax == 1) {
-        stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot plot stage results of a fixed design")
+        stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, 
+            "cannot plot stage results of a fixed design", 
+            call. = FALSE)
     }
 
     if (!is.logical(showSource) || isTRUE(showSource)) {

diff --git a/R/class_core_parameter_set.R b/R/class_core_parameter_set.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: [email protected]
 ## |
-## |  File version: $Revision: 8455 $
-## |  Last changed: $Date: 2024-12-12 09:33:14 +0100 (Do, 12 Dez 2024) $
+## |  File version: $Revision: 8508 $
+## |  Last changed: $Date: 2025-01-24 09:01:34 +0100 (Fr, 24 Jan 2025) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -921,7 +921,8 @@ ParameterSet <- R6::R6Class("ParameterSet",
         "adjustedStageWisePValues", 
         "overallAdjustedTestStatistics",
         "plannedCalendarTime",
-        "doseLevels"
+        "doseLevels",
+        "stDev"
     ))]
 
     if (!is.null(parameterSet[[".piecewiseSurvivalTime"]]) &&
@@ -1158,7 +1159,7 @@ ParameterSet <- R6::R6Class("ParameterSet",
     for (parameterName in parameterNames) {
         tryCatch(
             {
-                if (!(parameterName %in% c("stages", "adaptations", "effectList", "doseLevels", "plannedCalendarTime")) &&
+                if (!(parameterName %in% c("stages", "adaptations", "effectList", "doseLevels", "plannedCalendarTime", "stDev")) &&
                         !grepl("Function$", parameterName) &&
                         (is.null(variedParameter) || parameterName != variedParameter)) {
                     columnValues <- .getDataFrameColumnValues(

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: [email protected]
 ## |
-## |  File version: $Revision: 8225 $
-## |  Last changed: $Date: 2024-09-18 09:38:40 +0200 (Mi, 18 Sep 2024) $
+## |  File version: $Revision: 8490 $
+## |  Last changed: $Date: 2025-01-20 09:58:53 +0100 (Mo, 20 Jan 2025) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -26,11 +26,18 @@ PlotSubTitleItem <- R6::R6Class("PlotSubTitleItem",
         digits = NULL,
         initialize = function(..., title, value, subscript = NA_character_, digits = 3L) {
             self$title <- trimws(title)
-            self$value <- value
             self$subscript <- trimws(subscript)
             self$digits <- digits
 
-            self$value <- round(value, digits)
+            if (is.numeric(value)) {
+                self$value <- round(value, digits)
+            } else {
+                self$value <- value
+            }
+
+            if (length(self$value) > 1) {
+                self$value <- .arrayToString(self$value, vectorLookAndFeelEnabled = TRUE)
+            }
         },
         show = function() {
             cat(self$toString(), "\n")
@@ -663,7 +670,8 @@ PlotSettings <- R6::R6Class("PlotSettings",
             if (!(length(margin) %in% c(1, 4))) {
                 stop(
                     C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'margin' (", .arrayToString(margin),
-                    ") must be a numeric vector with length 1 or 4"
+                    ") must be a numeric vector with length 1 or 4", 
+                    call. = FALSE
                 )
             }
             p <- p + ggplot2::theme(plot.margin = ggplot2::unit(margin, "cm"))

diff --git a/R/class_design.R b/R/class_design.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: [email protected]
 ## |
-## |  File version: $Revision: 8429 $
-## |  Last changed: $Date: 2024-11-20 14:14:32 +0100 (Mi, 20 Nov 2024) $
+## |  File version: $Revision: 8495 $
+## |  Last changed: $Date: 2025-01-21 08:10:38 +0100 (Di, 21 Jan 2025) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -648,8 +648,8 @@ TrialDesignInverseNormal <- R6::R6Class("TrialDesignInverseNormal",
         },
         .pasteComparisonResult = function(name, newValue, oldValue) {
             return(paste0(
-                name, "_new = ", .arrayToString(.formatComparisonResult(newValue)), " (", .getClassName(newValue), "), ",
-                name, "_old = ", .arrayToString(.formatComparisonResult(oldValue)), " (", .getClassName(oldValue), ")"
+                name, "_new = ", .arrayToString(self$.formatComparisonResult(newValue)), " (", .getClassName(newValue), "), ",
+                name, "_old = ", .arrayToString(self$.formatComparisonResult(oldValue)), " (", .getClassName(oldValue), ")"
             ))
         },
         hasChanged = function(...,
@@ -1274,7 +1274,8 @@ plot.TrialDesignCharacteristics <- function(x, y, ..., type = 1L, grid = 1) {
     if (any(.isTrialDesignFisher(x)) && !(type %in% c(1, 3, 4))) {
         stop(
             C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
-            "'type' (", type, ") is not allowed for Fisher designs; must be 1, 3 or 4"
+            "'type' (", type, ") is not allowed for Fisher designs; must be 1, 3 or 4", 
+            call. = FALSE
         )
     }
 
@@ -1302,7 +1303,8 @@ plot.TrialDesignCharacteristics <- function(x, y, ..., type = 1L, grid = 1) {
                 stop(
                     C_EXCEPTION_TYPE_MISSING_ARGUMENT,
                     "'variedParameters' needs to be specified, ",
-                    "e.g., variedParameters = \"typeOfDesign\""
+                    "e.g., variedParameters = \"typeOfDesign\"", 
+                    call. = FALSE
                 )
             }
         }

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: [email protected]
 ## |
-## |  File version: $Revision: 8183 $
-## |  Last changed: $Date: 2024-09-06 12:08:59 +0200 (Fr, 06 Sep 2024) $
+## |  File version: $Revision: 8474 $
+## |  Last changed: $Date: 2025-01-14 14:32:53 +0100 (Di, 14 Jan 2025) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -144,7 +144,8 @@ TrialDesignPlan <- R6::R6Class("TrialDesignPlan",
             if (length(objectType) == 0 || !(objectType %in% c("sampleSize", "power"))) {
                 stop(
                     C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.objectType' (", objectType,
-                    ") must be specified as 'sampleSize' or 'power'"
+                    ") must be specified as 'sampleSize' or 'power'", 
+                    call. = FALSE
                 )
             }
             self$.objectType <- objectType
@@ -153,7 +154,8 @@ TrialDesignPlan <- R6::R6Class("TrialDesignPlan",
             if (length(self$.objectType) == 0 || !(self$.objectType %in% c("sampleSize", "power"))) {
                 stop(
                     C_EXCEPTION_TYPE_RUNTIME_ISSUE,
-                    "'.objectType' must be specified as 'sampleSize' or 'power'"
+                    "'.objectType' must be specified as 'sampleSize' or 'power'", 
+                    call. = FALSE
                 )
             }
             return(self$.objectType == "sampleSize")
@@ -162,7 +164,8 @@ TrialDesignPlan <- R6::R6Class("TrialDesignPlan",
             if (length(self$.objectType) == 0 || !(self$.objectType %in% c("sampleSize", "power"))) {
                 stop(
                     C_EXCEPTION_TYPE_RUNTIME_ISSUE,
-                    "'.objectType' must be specified as 'sampleSize' or 'power'"
+                    "'.objectType' must be specified as 'sampleSize' or 'power'", 
+                    call. = FALSE
                 )
             }
             return(self$.objectType == "power")

diff --git a/R/class_design_power_and_asn.R b/R/class_design_power_and_asn.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: [email protected]
 ## |
-## |  File version: $Revision: 8225 $
-## |  Last changed: $Date: 2024-09-18 09:38:40 +0200 (Mi, 18 Sep 2024) $
+## |  File version: $Revision: 8474 $
+## |  Last changed: $Date: 2025-01-14 14:32:53 +0100 (Di, 14 Jan 2025) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -119,7 +119,9 @@ PowerAndAverageSampleNumberResult <- R6::R6Class("PowerAndAverageSampleNumberRes
             .assertIsValidSidedParameter(self$.design$sided)
 
             if (self$nMax <= 0) {
-                stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'nMax' must be an integer > 0")
+                stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, 
+                    "'nMax' must be an integer > 0", 
+                    call. = FALSE)
             }
 
             self$.setParameterType("nMax", ifelse(self$nMax == C_NA_MAX_DEFAULT,

diff --git a/R/class_event_probabilities.R b/R/class_event_probabilities.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: [email protected]
 ## |
-## |  File version: $Revision: 8141 $
-## |  Last changed: $Date: 2024-08-28 15:03:46 +0200 (Mi, 28 Aug 2024) $
+## |  File version: $Revision: 8474 $
+## |  Last changed: $Date: 2025-01-14 14:32:53 +0100 (Di, 14 Jan 2025) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -361,9 +361,10 @@ plot.EventProbabilities <- function(
         maxNumberOfSubjectsToUse <- x$maxNumberOfSubjects
     } else if (!is.na(x$maxNumberOfSubjects) &&
             x$maxNumberOfSubjects != maxNumberOfSubjectsToUse) {
-        stop(
+        stop(C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, 
             "'x' (EventProbabilities) and 'y' (NumberOfSubjects) ",
-            "must have the same 'maxNumberOfSubjects' defined"
+            "must have the same 'maxNumberOfSubjects' defined", 
+            call. = FALSE
         )
     }
 

diff --git a/R/class_simulation_results.R b/R/class_simulation_results.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: [email protected]
 ## |
-## |  File version: $Revision: 8451 $
-## |  Last changed: $Date: 2024-12-10 13:26:18 +0100 (Di, 10 Dez 2024) $
+## |  File version: $Revision: 8474 $
+## |  Last changed: $Date: 2025-01-14 14:32:53 +0100 (Di, 14 Jan 2025) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -140,7 +140,8 @@ SimulationResults <- R6::R6Class("SimulationResults",
                     stop(
                         C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
                         "'showStatistics' (", .arrayToString(showStatistics),
-                        ") must be a single logical or character"
+                        ") must be a single logical or character", 
+                        call. = FALSE
                     )
                 }