Merge pull request #18 from rpact-com/dev/3.5.1

Issues 15, 16, and 17 fixed
rpact-com · Feb 9, 2024 · 0c536c6 · 0c536c6
2 parents d210810 + 8344d89
commit 0c536c6
Show file tree

Hide file tree

Showing 39 changed files with 5,771 additions and 5,806 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: rpact
 Title: Confirmatory Adaptive Clinical Trial Design and Analysis
-Version: 3.5.0
-Date: 2024-01-25
+Version: 3.5.1.9231
+Date: 2024-02-09
 Authors@R: c(
 	person(
 		given = "Gernot", 
@@ -71,6 +71,7 @@ Config/testthat/start-first: *analysis*
 Collate: 
     'RcppExports.R'
     'f_logger.R'
+    'class_dictionary.R'
     'f_core_constants.R'
     'f_core_utilities.R'
     'f_core_assertions.R'

diff --git a/NAMESPACE b/NAMESPACE
@@ -8,7 +8,9 @@ S3method(as.data.frame,TrialDesign)
 S3method(as.data.frame,TrialDesignCharacteristics)
 S3method(as.data.frame,TrialDesignPlan)
 S3method(as.data.frame,TrialDesignSet)
+S3method(as.list,Dictionary)
 S3method(as.matrix,FieldSet)
+S3method(as.vector,Dictionary)
 S3method(knit_print,ParameterSet)
 S3method(knit_print,SummaryFactory)
 S3method(length,TrialDesignSet)
@@ -30,6 +32,7 @@ S3method(plot,TrialDesignCharacteristics)
 S3method(plot,TrialDesignPlan)
 S3method(plot,TrialDesignSet)
 S3method(print,Dataset)
+S3method(print,Dictionary)
 S3method(print,FieldSet)
 S3method(print,ParameterSet)
 S3method(print,SimulationResults)

diff --git a/NEWS.md b/NEWS.md
@@ -1,4 +1,10 @@
 
+# rpact 3.5.1
+
+* The fields `.parameterNames` and `.parameterFormatFunctions` were removed from all rpact result objects in favor of a more efficient solution
+* Issues [15](https://github.com/rpact-com/rpact/issues/15), [16](https://github.com/rpact-com/rpact/issues/16), and [17](https://github.com/rpact-com/rpact/issues/17) fixed
+
+
 # rpact 3.5.0
 
 ## New features

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: 7554 $
-## |  Last changed: $Date: 2024-01-12 10:19:05 +0100 (Fr, 12 Jan 2024) $
+## |  File version: $Revision: 7620 $
+## |  Last changed: $Date: 2024-02-09 12:57:37 +0100 (Fr, 09 Feb 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -1383,8 +1383,6 @@ Dataset <- setRefClass("Dataset",
                 .enrichmentEnabled = enrichmentEnabled, ...
             )
             .plotSettings <<- PlotSettings()
-            .parameterNames <<- .getParameterNames(dataset = .self)
-            .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS
 
             .id <<- NA_integer_
             .description <<- NA_character_
@@ -2347,6 +2345,7 @@ DatasetMeans <- setRefClass("DatasetMeans",
                 } else {
                     n <- dataset$getSampleSize(stage = stage, group = group)
                     n <- floor(n / numberOfVisits)
+
                     randomData <- stats::rnorm(
                         n    = sampleSize,
                         mean = dataset$getMean(stage = stage, group = group),
@@ -2365,6 +2364,7 @@ DatasetMeans <- setRefClass("DatasetMeans",
                     sampleSizeBefore <- sampleSize - numberOfDropOutsBefore
                     if (n < sampleSizeBefore) {
                         numberOfDropOuts <- sampleSizeBefore - n
+                        numberOfDropOuts <- min(numberOfDropOuts, ceiling(n * 0.2))
                         dropOuts <- sample(c(rep(1, n - numberOfDropOuts), rep(0, numberOfDropOuts)))
                         randomData[indices[dropOuts == 0]] <- NA_real_
                         if (!is.null(randomDataBefore)) {
@@ -2601,7 +2601,7 @@ plot.Dataset <- function(x, y, ..., main = "Dataset", xlab = "Stage", ylab = NA_
             # implement survival plot here
         }
     } else {
-        data$stageGroup <- interaction(data$stage, data$group)
+        data$stageGroup <- base::interaction(data$stage, data$group)
 
         if (x$isDatasetMeans()) {
             p <- ggplot2::ggplot(ggplot2::aes(
@@ -2647,9 +2647,9 @@ plot.Dataset <- function(x, y, ..., main = "Dataset", xlab = "Stage", ylab = NA_
 
     # hide second legend
     if (x$getNumberOfGroups() == 1) {
-        p <- p + ggplot2::guides(fill = FALSE, colour = FALSE)
+        p <- p + ggplot2::guides(fill = "none", colour = "none")
     } else {
-        p <- p + ggplot2::guides(colour = FALSE)
+        p <- p + ggplot2::guides(colour = "none")
     }
 
     # set theme
@@ -2680,7 +2680,7 @@ plot.Dataset <- function(x, y, ..., main = "Dataset", xlab = "Stage", ylab = NA_
     }
     p <- plotSettings$addCompanyAnnotation(p, enabled = companyAnnotationEnabled)
 
-    p
+    suppressWarnings(print(p))
 }
 
 #'

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: 7126 $
-## |  Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $
+## |  File version: $Revision: 7620 $
+## |  Last changed: $Date: 2024-02-09 12:57:37 +0100 (Fr, 09 Feb 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -62,8 +62,6 @@ ConditionalPowerResults <- setRefClass("ConditionalPowerResults",
             callSuper(...)
 
             .plotSettings <<- PlotSettings()
-            .parameterNames <<- C_PARAMETER_NAMES
-            .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS
 
             if (!is.null(.stageResults) && is.null(.design)) {
                 .design <<- .stageResults$.design
@@ -533,8 +531,6 @@ ClosedCombinationTestResults <- setRefClass("ClosedCombinationTestResults",
             callSuper(...)
 
             .plotSettings <<- PlotSettings()
-            .parameterNames <<- C_PARAMETER_NAMES
-            .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS
 
             .setParameterType("intersectionTest", C_PARAM_USER_DEFINED)
 
@@ -560,10 +556,6 @@ ClosedCombinationTestResults <- setRefClass("ClosedCombinationTestResults",
             for (param in parametersGenerated) {
                 .setParameterType(param, C_PARAM_GENERATED)
             }
-
-            if (!is.null(.design) && inherits(.design, C_CLASS_NAME_TRIAL_DESIGN_FISHER)) {
-                .parameterFormatFunctions$overallAdjustedTestStatistics <<- ".formatTestStatisticsFisher"
-            }
         },
         show = function(showType = 1, digits = NA_integer_) {
             .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE)
@@ -712,14 +704,10 @@ AnalysisResults <- setRefClass("AnalysisResults",
     methods = list(
         initialize = function(design, dataInput, ...) {
             callSuper(.design = design, .dataInput = dataInput, ...)
-
             .plotSettings <<- PlotSettings()
-            .parameterNames <<- .getParameterNames(design = design, analysisResults = .self)
-            .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS
         },
         .setStageResults = function(stageResults) {
             .stageResults <<- stageResults
-            .parameterNames <<- .getParameterNames(design = .design, stageResults = stageResults, analysisResults = .self)
         },
         getPlotSettings = function() {
             return(.plotSettings)
@@ -1162,7 +1150,6 @@ as.data.frame.AnalysisResults <- function(x, row.names = NULL, optional = FALSE,
     return(.getAsDataFrame(
         parameterSet = x,
         parameterNames = parametersToShow,
-        tableColumnNames = .getTableColumnNames(design = x$.design),
         niceColumnNamesEnabled = niceColumnNamesEnabled
     ))
 }

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: 7554 $
-## |  Last changed: $Date: 2024-01-12 10:19:05 +0100 (Fr, 12 Jan 2024) $
+## |  File version: $Revision: 7620 $
+## |  Last changed: $Date: 2024-02-09 12:57:37 +0100 (Fr, 09 Feb 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -92,9 +92,7 @@ StageResults <- setRefClass("StageResults",
                 } else {
                     .setParameterType("stages", C_PARAM_USER_DEFINED)
                 }
-                .parameterNames <<- .getParameterNames(design = design)
             }
-            .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS
 
             .setParameterType("stage", C_PARAM_NOT_APPLICABLE)
 
@@ -1213,8 +1211,7 @@ as.data.frame.StageResults <- function(x, row.names = NULL,
             parameterSet = x,
             parameterNames = parametersToShow,
             niceColumnNamesEnabled = niceColumnNamesEnabled,
-            includeAllParameters = includeAllParameters,
-            tableColumnNames = .getTableColumnNames(design = x$.design)
+            includeAllParameters = includeAllParameters
         ))
     }