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

Dev/4.0.0
rpact-com · Jun 3, 2024 · 9e9026a · 9e9026a
2 parents 0acfa29 + 7f20297
commit 9e9026a
Show file tree

Hide file tree

Showing 47 changed files with 1,174 additions and 428 deletions.
diff --git a/.gitignore b/.gitignore
@@ -33,3 +33,4 @@ testthat-problems.rds
 /README.html
 /tests/testthat/Rplots.pdf
 /tests/testthat/index.txt
+/rpact.Rproj
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: rpact
 Title: Confirmatory Adaptive Clinical Trial Design and Analysis
-Version: 4.0.0.9243
-Date: 2024-05-28
+Version: 4.0.0
+Date: 2024-05-31
 Authors@R: c(
 	person(
 		given = "Gernot", 

diff --git a/NAMESPACE b/NAMESPACE
@@ -11,6 +11,7 @@ S3method(as.data.frame,TrialDesignSet)
 S3method(as.list,Dictionary)
 S3method(as.matrix,FieldSet)
 S3method(as.vector,Dictionary)
+S3method(fetch,ParameterSet)
 S3method(kable,ParameterSet)
 S3method(knit_print,ParameterSet)
 S3method(knit_print,SummaryFactory)
@@ -20,6 +21,7 @@ S3method(names,FieldSet)
 S3method(names,SimulationResults)
 S3method(names,StageResults)
 S3method(names,TrialDesignSet)
+S3method(obtain,ParameterSet)
 S3method(plot,AnalysisResults)
 S3method(plot,Dataset)
 S3method(plot,EventProbabilities)
@@ -46,6 +48,7 @@ S3method(summary,ParameterSet)
 S3method(summary,TrialDesignSet)
 export(as251Normal)
 export(as251StudentT)
+export(fetch)
 export(getAccrualTime)
 export(getAnalysisResults)
 export(getAvailablePlotTypes)
@@ -116,6 +119,7 @@ export(getWideFormat)
 export(kable)
 export(mvnprd)
 export(mvstud)
+export(obtain)
 export(plotTypes)
 export(ppwexp)
 export(printCitation)

diff --git a/NEWS.md b/NEWS.md
@@ -7,7 +7,7 @@
 * 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 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))
-
+* The `fetch()` and `obtain()` functions can be used to extract a single parameter from an rpact result object, which is useful for writing pipe-operator linked commands
 
 ## Improvements, issues, and changes
 

diff --git a/R/class_analysis_dataset.R b/R/class_analysis_dataset.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: info@rpact.com
 ## |
-## |  File version: $Revision: 7808 $
-## |  Last changed: $Date: 2024-04-05 18:22:34 +0200 (Fr, 05 Apr 2024) $
+## |  File version: $Revision: 7962 $
+## |  Last changed: $Date: 2024-05-31 13:41:37 +0200 (Fr, 31 Mai 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -1193,7 +1193,7 @@ getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) {
     for (s in subsets) {
         subsetStages <- as.integer(sort(unique(na.omit(as.character(dataFrame$stage[dataFrame$subset == s])))))
         kMax <- max(subsetStages)
-        if (!identical(1:kMax, subsetStages)) {
+        if (!isTRUE(all.equal(1:kMax, subsetStages))) {
             stop(
                 C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT,
                 gettextf("subset %s has incomplete stages (%s)", s, .arrayToString(subsetStages))

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: info@rpact.com
 ## |
-## |  File version: $Revision: 7742 $
-## |  Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $
+## |  File version: $Revision: 7962 $
+## |  Last changed: $Date: 2024-05-31 13:41:37 +0200 (Fr, 31 Mai 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -1911,7 +1911,7 @@ plot.AnalysisResults <- function(x, y, ..., type = 1L,
     }
 
     treatmentArmsToShowCmd <- ""
-    if (!is.null(treatmentArmsToShow) && !identical(sort(unique(treatmentArmsToShow)), 1:nrow(data))) {
+    if (!is.null(treatmentArmsToShow) && !isTRUE(all.equal(sort(unique(treatmentArmsToShow)), 1:nrow(data)))) {
         treatmentArmsToShowCmd <- paste0(", ", .arrayToString(treatmentArmsToShow, mode = "vector"))
     }
     dataCmd <- paste0("rpact:::.getConfidenceIntervalData(", analysisResultsName, treatmentArmsToShowCmd, ")")

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: info@rpact.com
 ## |
-## |  File version: $Revision: 7742 $
-## |  Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $
+## |  File version: $Revision: 7962 $
+## |  Last changed: $Date: 2024-05-31 13:41:37 +0200 (Fr, 31 Mai 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -75,7 +75,14 @@ StageResults <- R6::R6Class("StageResults",
         weightsInverseNormal = NULL,
         thetaH0 = NULL,
         direction = NULL,
-        initialize = function(..., stage = NULL, stages = NULL, pValues = NULL, weightsFisher = NULL, weightsInverseNormal = NULL, thetaH0 = NULL, direction = NULL) {
+        initialize = function(..., 
+                stage = NULL, 
+                stages = NULL, 
+                pValues = NULL, 
+                weightsFisher = NULL, 
+                weightsInverseNormal = NULL, 
+                thetaH0 = NULL, 
+                direction = NULL) {
             self$stage <- stage
             self$stages <- stages
             self$pValues <- pValues
@@ -105,7 +112,7 @@ StageResults <- R6::R6Class("StageResults",
                 self$.isMultiArm(), C_PARAM_NOT_APPLICABLE, C_PARAM_GENERATED
             ))
             self$.setParameterType("thetaH0", ifelse(
-                identical(self$thetaH0, C_THETA_H0_MEANS_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED
+                isTRUE(all.equal(self$thetaH0, C_THETA_H0_MEANS_DEFAULT)), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED
             ))
             self$.setParameterType("direction", ifelse(
                 identical(self$direction, C_DIRECTION_UPPER), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED
@@ -307,7 +314,9 @@ StageResultsMeans <- R6::R6Class("StageResultsMeans",
         overallSampleSizes2 = NULL,
         equalVariances = NULL,
         normalApproximation = NULL,
-        initialize = function(design, dataInput, ...,
+        initialize = function(
+                design, 
+                dataInput, ...,
                 combInverseNormal = NULL,
                 combFisher = NULL,
                 overallTestStatistics = NULL,
@@ -323,7 +332,8 @@ StageResultsMeans <- R6::R6Class("StageResultsMeans",
                 overallSampleSizes = NULL,
                 overallSampleSizes1 = NULL,
                 overallSampleSizes2 = NULL,
-                equalVariances = TRUE, normalApproximation = FALSE) {
+                equalVariances = TRUE, 
+                normalApproximation = FALSE) {
             super$initialize(.design = design, .dataInput = dataInput, ...) 
 
             self$combInverseNormal <- combInverseNormal
@@ -491,7 +501,9 @@ StageResultsMultiArmMeans <- R6::R6Class("StageResultsMultiArmMeans",
         varianceOption = NULL,
         normalApproximation = NULL,
         directionUpper = NULL,
-        initialize = function(design, dataInput, ...,
+        initialize = function(
+                design, 
+                dataInput, ...,
                 combInverseNormal = NULL,
                 combFisher = NULL,
                 overallTestStatistics = NULL,
@@ -502,8 +514,10 @@ StageResultsMultiArmMeans <- R6::R6Class("StageResultsMultiArmMeans",
                 separatePValues = NULL,
                 effectSizes = NULL,
                 singleStepAdjustedPValues = NULL,
-                intersectionTest = NULL, varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT,
-                normalApproximation = FALSE, directionUpper = NULL) {
+                intersectionTest = NULL, 
+                varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT,
+                normalApproximation = FALSE, 
+                directionUpper = NULL) {
             super$initialize(...)
             self$combInverseNormal <- combInverseNormal
             self$combFisher <- combFisher
@@ -539,13 +553,16 @@ StageResultsMultiArmMeans <- R6::R6Class("StageResultsMultiArmMeans",
             }
 
             self$.setParameterType("varianceOption", ifelse(
-                identical(self$varianceOption, C_VARIANCE_OPTION_MULTIARMED_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED
+                identical(self$varianceOption, C_VARIANCE_OPTION_MULTIARMED_DEFAULT), 
+                C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED
             ))
             self$.setParameterType("normalApproximation", ifelse(
-                identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED
+                identical(self$normalApproximation, FALSE), 
+                C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED
             ))
             self$.setParameterType("directionUpper", ifelse(
-                identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED
+                identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), 
+                C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED
             ))
         },
         .getParametersToShow = function() {
@@ -693,7 +710,8 @@ StageResultsRates <- R6::R6Class("StageResultsRates",
             }
 
             self$.setParameterType("normalApproximation", ifelse(
-                identical(self$normalApproximation, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED
+                identical(self$normalApproximation, TRUE), 
+                C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED
             ))
         },
         .getParametersToShow = function() {
@@ -812,7 +830,9 @@ StageResultsMultiArmRates <- R6::R6Class("StageResultsMultiArmRates",
         intersectionTest = NULL,
         normalApproximation = NULL,
         directionUpper = NULL,
-        initialize = function(design, dataInput, ...,
+        initialize = function(
+                design, 
+                dataInput, ...,
                 overallPiTreatments = NULL,
                 overallPiControl = NULL,
                 combInverseNormal = NULL,
@@ -861,10 +881,12 @@ StageResultsMultiArmRates <- R6::R6Class("StageResultsMultiArmRates",
             }
 
             self$.setParameterType("normalApproximation", ifelse(
-                identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED
+                identical(self$normalApproximation, FALSE), 
+                C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED
             ))
             self$.setParameterType("directionUpper", ifelse(
-                identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED
+                identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), 
+                C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED
             ))
         },
         .getParametersToShow = function() {
@@ -1131,7 +1153,8 @@ StageResultsMultiArmSurvival <- R6::R6Class("StageResultsMultiArmSurvival",
             }
 
             self$.setParameterType("directionUpper", ifelse(
-                identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED
+                identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), 
+                C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED
             ))
         },
         .getParametersToShow = function() {
@@ -1254,8 +1277,10 @@ StageResultsEnrichmentRates <- R6::R6Class("StageResultsEnrichmentRates",
         stratifiedAnalysis = NULL,
         .getParametersToShow = function() {
             parametersToShow <- super$.getParametersToShow()
-            parametersToShow <- parametersToShow[!(parametersToShow %in% c("overallPiTreatments", "overallPiControl"))]
-            return(c(parametersToShow, "stratifiedAnalysis", "overallPisTreatment", "overallPisControl"))
+            parametersToShow <- parametersToShow[
+                !(parametersToShow %in% c("overallPiTreatments", "overallPiControl"))]
+            return(c(parametersToShow, "stratifiedAnalysis", 
+                "overallPisTreatment", "overallPisControl"))
         }
     )
 )
@@ -1547,7 +1572,8 @@ plot.StageResults <- function(x, y, ..., type = 1L,
             "condPow <- getConditionalPower(", stageResultsName,
             ", nPlanned = ", .arrayToString(nPlanned, vectorLookAndFeelEnabled = TRUE)
         )
-        if (.isConditionalPowerEnabled(nPlanned) && allocationRatioPlanned != C_ALLOCATION_RATIO_DEFAULT) {
+        if (.isConditionalPowerEnabled(nPlanned) && 
+                allocationRatioPlanned != C_ALLOCATION_RATIO_DEFAULT) {
             cmd <- paste0(cmd, ", allocationRatioPlanned = ", allocationRatioPlanned)
         }
         if (grepl("Means|Survival", .getClassName(x))) {