Issues in print outputs fixed

rpact-com · Mar 26, 2024 · 65f7727 · 65f7727
1 parent 2edd396
commit 65f7727
Show file tree

Hide file tree

Showing 10 changed files with 113 additions and 111 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.9235
-Date: 2024-03-22
+Version: 4.0.0.9236
+Date: 2024-03-26
 Authors@R: c(
 	person(
 		given = "Gernot", 

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: info@rpact.com
 ## |
-## |  File version: $Revision: 7742 $
-## |  Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $
+## |  File version: $Revision: 7750 $
+## |  Last changed: $Date: 2024-03-26 15:44:44 +0100 (Di, 26 Mrz 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -48,9 +48,15 @@ FieldSet <- R6::R6Class("FieldSet",
         .catLines = NULL,
         .deprecatedFieldNames = NULL,
         .getFieldNames = function() {
-            return(unlist(lapply(class(self)[1:(length(class(self)) - 1)], function(x) {
-                names(get(x)$public_fields)
-            })))
+            classNames <- class(self)
+            classNames <- classNames[classNames != "R6"]
+            classNames <- base::rev(classNames)
+            fieldNames <- unlist(lapply(classNames, function(x) {
+                names(base::get(x)$public_fields)
+            }))
+            startFieldNameIndices <- grepl("^\\.", fieldNames)
+            fieldNames <- c(fieldNames[startFieldNameIndices], fieldNames[!startFieldNameIndices])
+            return(fieldNames)
         },
         .getVisibleFieldNames = function() {
             fieldNames <- self$.getFieldNames()
@@ -545,29 +551,36 @@ ParameterSet <- R6::R6Class("ParameterSet",
             return(invisible(output))
         },
         .extractParameterNameAndValue = function(parameterName) {
-            d <- regexpr("\\..+\\$", parameterName)
-            if (d[1] != 1) {
-                return(list(
-                    parameterName = parameterName,
-                    paramValue = base::get(parameterName, envir = self)
-                ))
-            }
-
-            index <- attr(d, "match.length")
-            objectName <- substr(parameterName, 1, index - 1)
-            parameterName <- substr(parameterName, index + 1, nchar(parameterName))
-            paramValue <- get(objectName)[[parameterName]]
-
-            # .closedTestResults$rejected
-            if (objectName == ".closedTestResults" && parameterName == "rejected") {
-                paramValueLogical <- as.logical(paramValue)
-                if (is.matrix(paramValue)) {
-                    paramValueLogical <- matrix(paramValueLogical, ncol = ncol(paramValue))
+            tryCatch({
+                d <- regexpr("\\..+\\$", parameterName)
+                if (d[1] != 1) {
+                    return(list(
+                        parameterName = parameterName,
+                        paramValue = base::get(parameterName, envir = self)
+                    ))
                 }
-                paramValue <- paramValueLogical
-            }
-
-            return(list(parameterName = parameterName, paramValue = paramValue))
+
+                index <- attr(d, "match.length")
+                objectName <- substr(parameterName, 1, index - 1)
+                parameterName <- substr(parameterName, index + 1, nchar(parameterName))
+                obj <- base::get(objectName, envir = self)
+                paramValue <- base::get(parameterName, envir = obj)
+                #paramValue <- self[[objectName]][[parameterName]]
+
+                if (objectName == ".closedTestResults" && parameterName == "rejected") {
+                    paramValueLogical <- as.logical(paramValue)
+                    if (is.matrix(paramValue)) {
+                        paramValueLogical <- matrix(paramValueLogical, ncol = ncol(paramValue))
+                    }
+                    paramValue <- paramValueLogical
+                }
+                return(list(parameterName = parameterName, paramValue = paramValue))
+            }, error = function(e) {
+                if (consoleOutputEnabled) {
+                    warning("Failed to extract parameter name and value from ", sQuote(parameterName), ": ", e$message)
+                }
+                return(list(parameterName = parameterName, paramValue = ""))
+            })
         },
         .showUnknownParameters = function(consoleOutputEnabled = TRUE) {
             params <- self$.getUndefinedParameters()
@@ -580,6 +593,7 @@ ParameterSet <- R6::R6Class("ParameterSet",
         .showParameterFormatted = function(paramName, paramValue, ..., paramValueFormatted = NA_character_,
                 showParameterType = FALSE, category = NULL, matrixRow = NA_integer_, consoleOutputEnabled = TRUE,
                 paramNameRaw = NA_character_, numberOfCategories = NA_integer_) {
+
             if (!is.na(paramNameRaw)) {
                 paramCaption <- .getParameterCaption(paramNameRaw, self)
             }
@@ -618,7 +632,7 @@ ParameterSet <- R6::R6Class("ParameterSet",
                             "conditionalErrorRate", "secondStagePValues",
                             "adjustedStageWisePValues", "overallAdjustedTestStatistics"
                         )) {
-                    treatments <- .closedTestResults$.getHypothesisTreatmentArmVariants()[matrixRow]
+                    treatments <- self$.closedTestResults$.getHypothesisTreatmentArmVariants()[matrixRow]
                     paramCaption <- paste0(
                         "Treatment", ifelse(grepl(",", treatments), "s", ""), " ",
                         treatments, " vs. control"
@@ -630,7 +644,7 @@ ParameterSet <- R6::R6Class("ParameterSet",
                             "adjustedStageWisePValues", "overallAdjustedTestStatistics", "rejectedIntersections"
                         )) {
                         if (.isEnrichmentAnalysisResults(self)) {
-                            populations <- .closedTestResults$.getHypothesisPopulationVariants()[matrixRow]
+                            populations <- self$.closedTestResults$.getHypothesisPopulationVariants()[matrixRow]
                         } else if (inherits(self, "ClosedCombinationTestResults")) {
                             populations <- self$.getHypothesisPopulationVariants()[matrixRow]
                         } else {

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: info@rpact.com
 ## |
-## |  File version: $Revision: 7742 $
-## |  Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $
+## |  File version: $Revision: 7750 $
+## |  Last changed: $Date: 2024-03-26 15:44:44 +0100 (Di, 26 Mrz 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -213,9 +213,9 @@ TrialDesignPlan <- R6::R6Class("TrialDesignPlan",
                     if (self$.design$kMax > 1) {
                         self$.cat("  [k]: values at stage k\n", consoleOutputEnabled = consoleOutputEnabled)
                     }
+                } else {
+                    self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled)
                 }
-
-                self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled)
             }
         },
         getAlpha = function() {
@@ -886,14 +886,14 @@ TrialDesignPlanSurvival <- R6::R6Class("TrialDesignPlanSurvival",
         },
         recreate = function(hazardRatio = NA_real_, pi1 = NA_real_) {
             hr <- NA_real_
-            if (.getParameterType("hazardRatio") == C_PARAM_USER_DEFINED) {
+            if (self$.getParameterType("hazardRatio") == C_PARAM_USER_DEFINED) {
                 hr <- hazardRatio
                 if (any(is.na(hazardRatio))) {
                     hr <- self$hazardRatio
                 }
             }
             pi1Temp <- NA_real_
-            if (.getParameterType("pi1") == C_PARAM_USER_DEFINED) {
+            if (self$.getParameterType("pi1") == C_PARAM_USER_DEFINED) {
                 pi1Temp <- pi1
                 if (any(is.na(pi1))) {
                     pi1Temp <- self$pi1
@@ -932,7 +932,7 @@ TrialDesignPlanSurvival <- R6::R6Class("TrialDesignPlanSurvival",
                     hazardRatio = hr
                 ))
             } else {
-                directionUpperTemp <- directionUpper
+                directionUpperTemp <- self$directionUpper
                 if (length(directionUpperTemp) > 1) {
                     directionUpperTemp <- directionUpperTemp[1]
                 }

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: info@rpact.com
 ## |
-## |  File version: $Revision: 7742 $
-## |  Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $
+## |  File version: $Revision: 7750 $
+## |  Last changed: $Date: 2024-03-26 15:44:44 +0100 (Di, 26 Mrz 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -297,7 +297,7 @@ SimulationResults <- R6::R6Class("SimulationResults",
                                     paramCaption2 <- paste0("%", parameterName2, "%")
                                 }
                                 for (stage in stages) {
-                                    .catStatisticsLine(
+                                    self$.catStatisticsLine(
                                         stage = stage,
                                         parameterName = parameterName2,
                                         paramCaption = paramCaption2,

diff --git a/R/f_core_plot.R b/R/f_core_plot.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: 7750 $
+## |  Last changed: $Date: 2024-03-26 15:44:44 +0100 (Di, 26 Mrz 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -850,7 +850,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap"
             "overallEarlyStop", "calculatedPower"
         ))]
         fieldNames <- c(
-            names(parameterSet), 
+            names(parameterSet), # alternatively use parameterSet$.getFieldNames()
             names(designMaster) 
         )
         if (simulationEnrichmentEnmabled) {

diff --git a/R/f_core_utilities.R b/R/f_core_utilities.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: 7750 $
+## |  Last changed: $Date: 2024-03-26 15:44:44 +0100 (Di, 26 Mrz 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -31,7 +31,7 @@ NULL
     .assertIsSingleCharacter(functionName, "functionName")
     tryCatch(
         {
-            return(environmentName(environment(get(functionName))))
+            return(environmentName(environment(base::get(functionName))))
         },
         error = function(e) {
             return(NA_character_)

diff --git a/R/f_simulation_base_count_data.R b/R/f_simulation_base_count_data.R
@@ -13,9 +13,9 @@
 ## |
 ## |  Contact us for information about our services: info@rpact.com
 ## |
-## |  File version: $Revision: 7744 $
-## |  Last changed: $Date: 2024-03-22 17:38:03 +0100 (Fr, 22 Mrz 2024) $
-## |  Last changed by: $Author: pahlke $
+## |  File version: $Revision: 7747 $
+## |  Last changed: $Date: 2024-03-25 17:58:00 +0100 (Mo, 25 Mrz 2024) $
+## |  Last changed by: $Author: wassmer $
 ## |
 
 .getInformationCountData <- function(lambda1,
@@ -101,13 +101,13 @@
 #' @inheritParams param_accrualTime_counts
 #' @inheritParams param_accrualIntensity_counts
 #' @inheritParams param_followUpTime_counts
-#' @inheritParams param_plannedMaxSubjects
+#' @inheritParams param_maxNumberOfSubjects
 #' @inheritParams param_overdispersion_counts
 #' @inheritParams param_directionUpper
 #' @inheritParams param_allocationRatioPlanned
 #' @inheritParams param_plannedSubjects
 #' @inheritParams param_minNumberOfSubjectsPerStage
-#' @inheritParams param_plannedMaxSubjectsPerStage
+#' @inheritParams param_maxNumberOfSubjectsPerStage
 #' @inheritParams param_conditionalPowerSimulation
 #' @inheritParams param_maxNumberOfIterations
 #' @inheritParams param_calcSubjectsFunction
@@ -173,7 +173,7 @@
 getSimulationCounts <- function(design = NULL,
         ...,
         plannedCalendarTime,
-        plannedMaxSubjects = NA_real_,
+        maxNumberOfSubjects = NA_real_,
         lambda1 = NA_real_,
         lambda2 = NA_real_,
         lambda = NA_real_,
@@ -225,7 +225,7 @@ getSimulationCounts <- function(design = NULL,
     sided <- design$sided
     sampleSizeEnabled <- FALSE
 
-    allocationRatioPlanned <- .assertIsValidAllocationRatioPlannedSampleSize(allocationRatioPlanned, plannedMaxSubjects)
+    allocationRatioPlanned <- .assertIsValidAllocationRatioPlannedSampleSize(allocationRatioPlanned, maxNumberOfSubjects)
     .assertIsValidEffectCountData(
         sampleSizeEnabled, sided, lambda1, lambda2, lambda, theta,
         thetaH0, overdispersion
@@ -242,7 +242,7 @@ getSimulationCounts <- function(design = NULL,
         followUpTime = followUpTime,
         accrualTime = accrualTime,
         accrualIntensity = accrualIntensity,
-        maxNumberOfSubjects = plannedMaxSubjects
+        maxNumberOfSubjects = maxNumberOfSubjects
     )
     .assertAreValidCalendarTimes(plannedCalendarTime, kMax)
     if (any(is.na(accrualTime))) {
@@ -266,7 +266,7 @@ getSimulationCounts <- function(design = NULL,
     }
 
     .setValueAndParameterType(simulationResults, "plannedCalendarTime", plannedCalendarTime, NA_real_)
-    .setValueAndParameterType(simulationResults, "plannedMaxSubjects", plannedMaxSubjects, NA_real_, notApplicableIfNA = TRUE)
+    .setValueAndParameterType(simulationResults, "maxNumberOfSubjects", maxNumberOfSubjects, NA_real_, notApplicableIfNA = TRUE)
     .setValueAndParameterType(simulationResults, "lambda1", lambda1, NA_real_, notApplicableIfNA = TRUE)
     .setValueAndParameterType(simulationResults, "lambda2", lambda2, NA_real_, notApplicableIfNA = TRUE)
     .setValueAndParameterType(simulationResults, "lambda", lambda, NA_real_, notApplicableIfNA = TRUE)
@@ -350,7 +350,7 @@ getSimulationCounts <- function(design = NULL,
             n2 <- length(recruit2)
             nTotal <- n1 + n2
         } else {
-            n2 <- plannedMaxSubjects / (1 + allocationRatioPlanned)
+            n2 <- maxNumberOfSubjects / (1 + allocationRatioPlanned)
             n1 <- allocationRatioPlanned * n2
             nTotal <- n1 + n2
             recruit1 <- seq(0, accrualTime, length.out = n1)

diff --git a/R/parameter_descriptions.R b/R/parameter_descriptions.R
@@ -13,9 +13,9 @@
 ## |
 ## |  Contact us for information about our services: info@rpact.com
 ## |
-## |  File version: $Revision: 7744 $
-## |  Last changed: $Date: 2024-03-22 17:38:03 +0100 (Fr, 22 Mrz 2024) $
-## |  Last changed by: $Author: pahlke $
+## |  File version: $Revision: 7747 $
+## |  Last changed: $Date: 2024-03-25 17:58:00 +0100 (Mo, 25 Mrz 2024) $
+## |  Last changed by: $Author: wassmer $
 ## |
 
 #' Parameter Description: "..."
@@ -510,7 +510,7 @@ NULL
 
 #' Parameter Description: Minimum Number Of Subjects Per Stage
 #' @param minNumberOfSubjectsPerStage When performing a data driven sample size recalculation,
-#'   the numeric vector \code{minNumberOfSubjectsPerStage} with length kMax determines the
+#'   the numeric vector \code{minNumberOfSubjectsPerStage} with length \code{kMax} determines the
 #'   minimum number of subjects per stage (i.e., not cumulated), the first element
 #'   is not taken into account. For two treatment arms, it is the number of subjects for both treatment arms.
 #'   For multi-arm designs \code{minNumberOfSubjectsPerStage} refers
@@ -521,7 +521,7 @@ NULL
 
 #' Parameter Description: Maximum Number Of Subjects Per Stage
 #' @param maxNumberOfSubjectsPerStage When performing a data driven sample size recalculation,
-#'   the numeric vector \code{maxNumberOfSubjectsPerStage} with length kMax determines the maximum number
+#'   the numeric vector \code{maxNumberOfSubjectsPerStage} with length \code{kMax} determines the maximum number
 #'   of subjects per stage (i.e., not cumulated), the first element is not taken into account.
 #'   For two treatment arms, it is the number of subjects for both treatment arms.
 #'   For multi-arm designs \code{maxNumberOfSubjectsPerStage} refers
@@ -906,20 +906,9 @@ NULL
 #' @keywords internal
 NULL
 
-#' Parameter Description: Planned Max Subjects Per Stage
-#' @param plannedMaxSubjectsPerStage TODO @Gernot please describe
-#' @name param_plannedMaxSubjectsPerStage
-#' @keywords internal
-NULL
-
-#' Parameter Description: Planned Max Subjects
-#' @param plannedMaxSubjects TODO @Gernot please describe
-#' @name param_plannedMaxSubjects
-#' @keywords internal
-NULL
-
 #' Parameter Description: Planned Calendar Time
-#' @param plannedCalendarTime TODO @Gernot please describe
+#' @param plannedCalendarTime For simulating count data, the time points where an analysis is planned to be performed.
+#' Should be a vector of length \code{kMax}
 #' @name param_plannedCalendarTime
 #' @keywords internal
 NULL