Merge pull request #45 from rpact-com/dev/4.0.1

rpact-com · Jul 18, 2024 · 5dd91fb · 5dd91fb
2 parents 609d0fe + 14adc1e
commit 5dd91fb
Show file tree

Hide file tree

Showing 20 changed files with 158 additions and 146 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: rpact
 Title: Confirmatory Adaptive Clinical Trial Design and Analysis
-Version: 4.0.1.9245
-Date: 2024-06-24
+Version: 4.0.1.9246
+Date: 2024-07-17
 Authors@R: c(
 	person(
 		given = "Gernot", 

diff --git a/NEWS.md b/NEWS.md
@@ -3,8 +3,9 @@
 
 * Minimum version of suggested package `ggplot2` changed from 2.2.0 to 3.2.0
 * When analyzing with a two-sided test, an issue with the calculation of the conditional rejection probability was fixed
-* Issue [#41](https://github.com/rpact-com/rpact/issues/41) fixed
+* Issues [#41](https://github.com/rpact-com/rpact/issues/41) and [#44](https://github.com/rpact-com/rpact/issues/44) fixed
 * Usage of pipe-operators improved
+* Minor summary improvements
 
 
 # rpact 4.0.0

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: [email protected]
 ## |
-## |  File version: $Revision: 8023 $
-## |  Last changed: $Date: 2024-07-01 08:50:30 +0200 (Mo, 01 Jul 2024) $
+## |  File version: $Revision: 8052 $
+## |  Last changed: $Date: 2024-07-18 11:19:40 +0200 (Do, 18 Jul 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -404,7 +404,7 @@ writeDatasets <- function(datasets, file, ..., append = FALSE, quote = TRUE, sep
 
     datasetType <- NA_character_
     dataFrames <- NULL
-    for (i in 1:length(datasets)) {
+    for (i in seq_len(length(datasets))) {
         dataset <- datasets[[i]]
         .assertIsDataset(dataset)
         if (is.na(datasetType)) {
@@ -675,7 +675,7 @@ getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) {
     }
 
     argNames <- names(args)
-    for (i in 1:length(args)) {
+    for (i in seq_len(length(args))) {
         arg <- args[[i]]
         if (!inherits(arg, "emmGrid")) {
             argName <- argNames[i]
@@ -715,7 +715,7 @@ getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) {
         stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(emmeansResults), " must be not empty")
     }
 
-    for (stage in 1:length(emmeansResults)) {
+    for (stage in seq_len(length(emmeansResults))) {
         if (!inherits(emmeansResults[[stage]], "emmGrid")) {
             stop(sprintf(
                 paste0(
@@ -769,7 +769,7 @@ getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) {
     )
 
     stDevCalcMode <- getOption("rpact.dataset.stdev.calc.mode", "auto") # auto, sigma, norm, t
-    for (stage in 1:length(emmeansResults)) {
+    for (stage in seq_len(length(emmeansResults))) {
         emmeansResult <- emmeansResults[[stage]]
         emmeansResultsSummary <- summary(emmeansResult)
         emmeansResultsList <- as.list(emmeansResult)
@@ -797,7 +797,7 @@ getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) {
                 rpactGroupNumbers <- c(2:numberOfGroups, rpactGroupNumbers)
             }
         }
-        for (group in 1:length(emmeansResultsSummary$emmean)) {
+        for (group in seq_len(length(emmeansResultsSummary$emmean))) {
             stages <- c(stages, stage)
             groups <- c(groups, group)
             rpactGroupNumber <- rpactGroupNumbers[group]
@@ -884,7 +884,7 @@ getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) {
     subsetNumbers <- as.integer(subsetNumbers)
     gMax <- max(subsetNumbers) + 1
     validSubsetNames <- .createSubsetsByGMax(gMax, stratifiedInput = stratifiedInput, all = FALSE)
-    for (i in 1:length(subsetNames)) {
+    for (i in seq_len(length(subsetNames))) {
         subsetName <- subsetNames[i]
         if (subsetName == "" && !inherits(args[[i]], "TrialDesign")) {
             stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all subsets must be named")
@@ -2438,7 +2438,7 @@ DatasetMeans <- R6::R6Class("DatasetMeans",
                 }
 
                 fixedCovariateSample <- sample(values, length(subjects), replace = TRUE)
-                for (i in 1:length(subjects)) {
+                for (i in seq_len(length(subjects))) {
                     data[[fixedCovariateName]][data$subject == subjects[i]] <- fixedCovariateSample[i]
                 }
             } else if (is.numeric(values)) {
@@ -2448,7 +2448,7 @@ DatasetMeans <- R6::R6Class("DatasetMeans",
                     covMean <- runif(1, minValue, maxValue)
                     covSD <- covMean * 0.1
                     showMessage <- TRUE
-                    for (i in 1:length(subjects)) {
+                    for (i in seq_len(length(subjects))) {
                         groupName <- as.character(data$group[data$subject == subjects[i]])[1]
                         covEffect <- 1
                         if (groupName == controlName && !is.null(covariateEffects)) {

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: 8023 $
-## |  Last changed: $Date: 2024-07-01 08:50:30 +0200 (Mo, 01 Jul 2024) $
+## |  File version: $Revision: 8052 $
+## |  Last changed: $Date: 2024-07-18 11:19:40 +0200 (Do, 18 Jul 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -81,7 +81,7 @@ FieldSet <- R6::R6Class("FieldSet",
                 if (tableColumns > 0) {
                     values <- unlist(args, use.names = FALSE)
                     values <- values[values != "\n"]
-                    for (i in 1:length(values)) {
+                    for (i in seq_len(length(values))) {
                         values[i] <- gsub("\n", "", values[i])
                     }
                     if (!is.null(na) && length(na) == 1 && !is.na(na)) {
@@ -387,16 +387,6 @@ ParameterSet <- R6::R6Class("ParameterSet",
                 )
             }
         },
-#        .catMarkdownText = function(...) { # TODO remove
-#            self$.show(consoleOutputEnabled = FALSE, ...)
-#            if (length(self$.catLines) == 0) {
-#                return(invisible())
-#            }
-#
-#            for (line in self$.catLines) {
-#                cat(line)
-#            }
-#        },
         .showParametersOfOneGroup = function(parameters, title,
                 orderByParameterName = TRUE, consoleOutputEnabled = TRUE) {
             output <- ""
@@ -443,7 +433,7 @@ ParameterSet <- R6::R6Class("ParameterSet",
                     }
 
                     output <- ""
-                    for (i in 1:length(params)) {
+                    for (i in seq_len(length(params))) {
                         param <- params[[i]]
                         category <- NULL
                         parts <- strsplit(param$paramName, "$", fixed = TRUE)[[1]]
@@ -756,7 +746,8 @@ ParameterSet <- R6::R6Class("ParameterSet",
                 parameterValues <- self[[parameterName]]
                 if (is.vector(parameterValues) && length(parameterValues) > numberOfRows) {
                     numberOfRows <- length(parameterValues)
-                } else if (is.matrix(parameterValues) && (nrow(parameterValues) == 1 || ncol(parameterValues) == 1) &&
+                } else if (is.matrix(parameterValues) && 
+                        (nrow(parameterValues) == 1 || ncol(parameterValues) == 1) &&
                         length(parameterValues) > numberOfRows) {
                     numberOfRows <- length(parameterValues)
                 }
@@ -1525,7 +1516,8 @@ as.matrix.FieldSet <- function(x, ..., enforceRowNames = TRUE, niceColumnNamesEn
     if (inherits(x, "AnalysisResults")) {
         dfDesign <- as.data.frame(x$.design, niceColumnNamesEnabled = niceColumnNamesEnabled)
         dfStageResults <- as.data.frame(x$.stageResults, niceColumnNamesEnabled = niceColumnNamesEnabled)
-        dfStageResults <- dfStageResults[!is.na(dfStageResults[, grep("(test statistic)|(testStatistics)", colnames(dfStageResults))]), ]
+        dfStageResults <- dfStageResults[!is.na(dfStageResults[, 
+            grep("(test statistic)|(testStatistics)", colnames(dfStageResults))]), ]
         if (length(intersect(names(dfDesign), names(dfStageResults))) == 1) {
             dfTemp <- merge(dfDesign, dfStageResults)
             if (length(intersect(names(dfTemp), names(dataFrame))) >= 1) {

diff --git a/R/class_design_set.R b/R/class_design_set.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: [email protected]
 ## |
-## |  File version: $Revision: 8023 $
-## |  Last changed: $Date: 2024-07-01 08:50:30 +0200 (Mo, 01 Jul 2024) $
+## |  File version: $Revision: 8052 $
+## |  Last changed: $Date: 2024-07-18 11:19:40 +0200 (Do, 18 Jul 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -630,7 +630,7 @@ length.TrialDesignSet <- function(x) {
     }
 
     colNames <- character()
-    for (i in 1:length(colNames1)) {
+    for (i in seq_len(length(colNames1))) {
         colName1 <- colNames1[i]
         colName2 <- colNames2[i]
         if (!identical(colName1, colName2)) {

diff --git a/R/class_summary.R b/R/class_summary.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: [email protected]
 ## |
-## |  File version: $Revision: 8024 $
-## |  Last changed: $Date: 2024-07-02 13:50:24 +0200 (Di, 02 Jul 2024) $
+## |  File version: $Revision: 8054 $
+## |  Last changed: $Date: 2024-07-18 13:16:10 +0200 (Do, 18 Jul 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -310,7 +310,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
             tableColumns <- 0
             maxValueWidth <- 1
             if (length(self$summaryItems) > 0) {
-                for (i in 1:length(self$summaryItems)) {
+                for (i in seq_len(length(self$summaryItems))) {
                     validValues <- na.omit(self$summaryItems[[i]]$values)
                     if (length(validValues) > 0) {
                         w <- max(nchar(validValues))
@@ -319,7 +319,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
                     }
                 }
                 spaceString <- paste0(rep(" ", maxValueWidth + 1), collapse = "")
-                for (i in 1:length(self$summaryItems)) {
+                for (i in seq_len(length(self$summaryItems))) {
                     itemTitle <- self$summaryItems[[i]]$title
                     if (!is.null(itemTitle) && length(itemTitle) == 1 && !is.na(itemTitle)) {
                         summaryItemName <- summaryItemNames[i]
@@ -383,7 +383,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
         .getFormattedParameterValue = function(valuesToShow, valuesToShow2) {
             naText <- getOption("rpact.summary.na", "")
             if (length(valuesToShow) == length(valuesToShow2) && !all(is.na(valuesToShow2))) {
-                for (variantIndex in 1:length(valuesToShow)) {
+                for (variantIndex in seq_len(length(valuesToShow))) {
                     value1 <- as.character(valuesToShow[variantIndex])
                     value2 <- as.character(valuesToShow2[variantIndex])
                     if (grepl("^ *NA *$", value1)) {
@@ -1547,7 +1547,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
     value[!is.na(value)] <- round(value[!is.na(value)], 2)
 
     if ((is.matrix(value) && nrow(value) > 1) || length(value) > 1) {
-        treatmentNames <- 1:length(value)
+        treatmentNames <- seq_len(length(value))
         if (.isEnrichmentAnalysisResults(analysisResults)) {
             populations <- paste0("S", treatmentNames)
             gMax <- analysisResults$.stageResults$getGMax()
@@ -1648,6 +1648,25 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
     return(header)
 }
 
+.addAlphaAndBetaToHeader <- function(header, design, designPlan, ..., endOfRecord = FALSE) {
+    header <- .concatenateSummaryText(header, paste0(
+        ifelse(design$sided == 1, "one-sided", "two-sided"),
+        ifelse(design$kMax == 1, "", " overall")
+    ))
+    powerEnabled <- .isTrialDesignInverseNormalOrGroupSequential(design) && 
+        (is.null(designPlan) || (!.isSimulationResults(designPlan) && !identical("power", designPlan[[".objectType"]])))
+    header <- .concatenateSummaryText(header,
+        paste0("significance level ", round(100 * design$alpha, 2), "%", 
+            ifelse(!powerEnabled && endOfRecord, ".", "")),
+        sep = " "
+    )
+    if (powerEnabled) {
+        header <- .concatenateSummaryText(header, 
+            paste0("power ", round(100 * (1 - design$beta), 1), "%", ifelse(endOfRecord, ".", "")))
+    }
+    return(header)
+}
+
 .addEnrichmentEffectListToHeader <- function(header, designPlan) {
     if (!grepl("SimulationResultsEnrichment", .getClassName(designPlan)) ||
             is.null(designPlan[["effectList"]])) {
@@ -1763,17 +1782,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
                 paste0(ifelse(design$bindingFutility, "binding", "non-binding"), " futility")
             )
         }
-        header <- .concatenateSummaryText(header, paste0(
-            ifelse(design$sided == 1, "one-sided", "two-sided"),
-            ifelse(design$kMax == 1, "", " overall")
-        ))
-        header <- .concatenateSummaryText(header,
-            paste0("significance level ", round(100 * design$alpha, 2), "%"),
-            sep = " "
-        )
-        if (.isTrialDesignInverseNormalOrGroupSequential(design)) {
-            header <- .concatenateSummaryText(header, paste0("power ", round(100 * (1 - design$beta), 1), "%"))
-        }
+        header <- .addAlphaAndBetaToHeader(header, design, designPlan)
         header <- .concatenateSummaryText(header, "undefined endpoint")
 
         if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) {
@@ -1817,7 +1826,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
 
     header <- ""
     if (design$kMax == 1) {
-        header <- paste0(header, "Fixed sample analysis,")
+        header <- paste0(header, "Fixed sample analysis")
     } else {
         header <- paste0(header, "Sequential analysis with a maximum of ", design$kMax, " looks")
         prefix <- ifelse(design$.isDelayedResponseDesign(), "delayed response ", "")
@@ -1826,13 +1835,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
             sep = " "
         )
     }
-    header <- .concatenateSummaryText(header, ifelse(design$kMax == 1, "", "overall"))
-    header <- .concatenateSummaryText(header,
-        paste0("significance level ", round(100 * design$alpha, 2), "%"),
-        sep = " "
-    )
-    header <- .concatenateSummaryText(header, ifelse(design$sided == 1, "(one-sided).", "(two-sided)."), sep = " ")
-
+    header <- .addAlphaAndBetaToHeader(header, design, designPlan, endOfRecord = TRUE)
     header <- paste0(header, "\n")
 
     header <- paste0(header, "The results were ")
@@ -2106,10 +2109,6 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
         header <- .addEnrichmentEffectListToHeader(header, designPlan)
         header <- .addAdditionalArgumentsToHeader(header, designPlan, settings)
     }
-    if (!inherits(designPlan, "SimulationResults") && designPlan$.isSampleSizeObject()) {
-        header <- .concatenateSummaryText(header, paste0("power ", round(100 * (1 - design$beta), 1), "%"))
-    }
-
 
     if (inherits(designPlan, "SimulationResults")) {
         header <- .concatenateSummaryText(
@@ -2675,21 +2674,26 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
         if (outputSize != "small" && dataInput$getNumberOfGroups() > 1) {
             treatmentRateParamName <- "overallPi1"
             controlRateParamName <- "overallPi2"
+            enforceFirstCase <- TRUE
             if (.isEnrichmentStageResults(stageResults)) {
                 treatmentRateParamName <- "overallPisTreatment"
                 controlRateParamName <- "overallPisControl"
+                enforceFirstCase <- FALSE
             } else if (.isMultiArmStageResults(stageResults)) {
                 treatmentRateParamName <- "overallPiTreatments"
                 controlRateParamName <- "overallPiControl"
             }
             summaryFactory$addParameter(stageResults,
                 parameterName = treatmentRateParamName,
-                parameterCaption = "Cumulative treatment rate", roundDigits = digitsGeneral
+                parameterCaption = "Cumulative treatment rate", 
+                roundDigits = digitsGeneral
             )
+
             summaryFactory$addParameter(stageResults,
                 parameterName = controlRateParamName,
                 parameterCaption = "Cumulative control rate",
-                roundDigits = digitsGeneral, enforceFirstCase = TRUE
+                roundDigits = digitsGeneral, 
+                enforceFirstCase = enforceFirstCase
             )
         }
     }
@@ -3589,15 +3593,6 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
         }
 
         if (survivalEnabled) {
-            if (design$kMax > 1 && !(inherits(designPlan, "TrialDesignPlanSurvival") &&
-                    designPlan$.isSampleSizeObject())) {
-                summaryFactory$addParameter(designPlan,
-                    parameterName = "expectedNumberOfEvents",
-                    parameterCaption = "Expected number of events",
-                    roundDigits = digitsSampleSize, transpose = TRUE
-                )
-            }
-
             if (outputSize %in% c("medium", "large")) {
                 summaryFactory$addParameter(designPlan,
                     parameterName = parameterNameEvents,
@@ -3606,6 +3601,14 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
                     ),
                     roundDigits = digitsSampleSize, cumsumEnabled = FALSE
                 )
+                if (!enrichmentEnabled && design$kMax > 1) { 
+                    summaryFactory$addParameter(designPlan,
+                        parameterName = ifelse(designPlan$.isSampleSizeObject(), 
+                            "expectedEventsH1", "expectedNumberOfEvents"),
+                        parameterCaption = "Expected number of events under H1",
+                        roundDigits = digitsSampleSize, cumsumEnabled = FALSE
+                    )
+                }
             }
 
             if (outputSize == "large") {
@@ -3618,7 +3621,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
 
             summaryFactory$addParameter(designPlan,
                 parameterName = "studyDuration",
-                parameterCaption = "Expected study duration",
+                parameterCaption = "Expected study duration under H1",
                 roundDigits = digitsTime,
                 smoothedZeroFormat = TRUE,
                 transpose = TRUE
@@ -3667,7 +3670,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
         if (!countDataEnabled) {
             legendEntry <- list("(t)" = "treatment effect scale")
 
-            if (ncol(designPlan$criticalValuesEffectScale) > 0 && !all(is.na(designPlan$criticalValuesEffectScale))) {
+            if (ncol(designPlan$criticalValuesEffectScale) > 0 && 
+                    !all(is.na(designPlan$criticalValuesEffectScale))) {
                 summaryFactory$addParameter(designPlan,
                     parameterName = "criticalValuesEffectScale",
                     parameterCaption = ifelse(.isDelayedInformationEnabled(design = design),