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

Issues #46 and #47 fixed
rpact-com · Aug 16, 2024 · ea3a28d · ea3a28d
2 parents 5dd91fb + a99cfa0
commit ea3a28d
Show file tree

Hide file tree

Showing 14 changed files with 117 additions and 60 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.9246
-Date: 2024-07-17
+Version: 4.0.1.9247
+Date: 2024-08-15
 Authors@R: c(
 	person(
 		given = "Gernot", 

diff --git a/NEWS.md b/NEWS.md
@@ -3,8 +3,10 @@
 
 * 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
-* Issues [#41](https://github.com/rpact-com/rpact/issues/41) and [#44](https://github.com/rpact-com/rpact/issues/44) fixed
+* Issues [#41](https://github.com/rpact-com/rpact/issues/41), [#44](https://github.com/rpact-com/rpact/issues/44), [#46](https://github.com/rpact-com/rpact/issues/46), and [#47](https://github.com/rpact-com/rpact/issues/47) fixed
 * Usage of pipe-operators improved
+* Analysis progress messages are only displayed when R is used interactively
+* Manual use of kable() for rpact result objects marked as deprecated, as the formatting and display will be handled automatically by rpact
 * Minor summary improvements
 
 

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: 8052 $
-## |  Last changed: $Date: 2024-07-18 11:19:40 +0200 (Do, 18 Jul 2024) $
+## |  File version: $Revision: 8087 $
+## |  Last changed: $Date: 2024-08-15 16:34:30 +0200 (Do, 15 Aug 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -1257,6 +1257,7 @@ ParameterSet <- R6::R6Class("ParameterSet",
                 }
                 if (includeAllParameters || (
                         parameterSet$.getParameterType(parameterName) != C_PARAM_NOT_APPLICABLE &&
+                            !R6::is.R6(parameterValues) &&
                             sum(is.na(parameterValues)) < length(parameterValues))) {
                     if (is.null(dataFrame)) {
                         dataFrame <- data.frame(x = parameterValues)
@@ -1399,8 +1400,6 @@ names.FieldSet <- function(x) {
 #'
 #' @title
 #' Print Field Set Values
-#'
-
 #'
 #' @description
 #' \code{print} prints its \code{\link{FieldSet}} argument and returns it invisibly (via \code{invisible(x)}).
@@ -1927,20 +1926,39 @@ knit_print.ParameterSet <- function(x, ...) {
 #' @param  ... Other arguments (see \code{\link[knitr]{kable}}).
 #'
 #' @details
+#' This function is deprecated and should no longer be used.
+#' Manual use of kable() for rpact result objects is no longer needed, 
+#' as the formatting and display will be handled automatically by the rpact package. 
+#' Please remove any manual kable() calls from your code to avoid redundancy and potential issues. 
+#' The results will be displayed in a consistent format automatically.
+#' 
 #' Generic function to represent a parameter set in Markdown.
 #' Use \code{options("rpact.print.heading.base.number" = "NUMBER")} (where \code{NUMBER} is an integer value >= -1) to
 #' specify the heading level. The default is \code{options("rpact.print.heading.base.number" = "0")}, i.e., the
 #' top headings start with \code{##} in Markdown. \code{options("rpact.print.heading.base.number" = "-1")} means
 #' that all headings will be written bold but are not explicit defined as header.
-#'
+#' 
 #' @name kableParameterSet
 #' 
+#' @keywords internal
+#' 
 #' @export
 #'
 kable.ParameterSet <- function(x, ...) {
     fCall <- match.call(expand.dots = FALSE)
+
+    lastWarningTime <- getOption("rpact.deprecated.message.time.function.kable")
+    if (is.null(lastWarningTime) || difftime(Sys.time(), lastWarningTime, units = "hours") > 8) {
+        options("rpact.deprecated.message.time.function.kable" = Sys.time())
+        .Deprecated(new = "",  
+            msg = paste0("Manual use of kable() for rpact result objects is no longer needed, ",
+                "as the formatting and display will be handled automatically by the rpact package"),
+            old = "kable")
+    }
+
     if (inherits(x, "ParameterSet")) {
         objName <- deparse(fCall$x)
+
         if (length(objName) > 0) {
             if (length(objName) > 1) {
                 objName <- paste0(objName[1], "...")

diff --git a/R/class_summary.R b/R/class_summary.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: info@rpact.com
 ## |
-## |  File version: $Revision: 8054 $
-## |  Last changed: $Date: 2024-07-18 13:16:10 +0200 (Do, 18 Jul 2024) $
+## |  File version: $Revision: 8087 $
+## |  Last changed: $Date: 2024-08-15 16:34:30 +0200 (Do, 15 Aug 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -1396,14 +1396,15 @@ 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 ", design$kMax, " looks")
         header <- .concatenateSummaryText(header,
-            paste0("(", design$.toString(startWithUpperCase = FALSE), ")."),
+            paste0("(", design$.toString(startWithUpperCase = FALSE), ")"),
             sep = " "
         )
     }
+    header <- .addAlphaAndBetaToHeader(header, design, designPlan = NULL, powerEnabled = FALSE, endOfRecord = TRUE)
     header <- paste0(header, "\n")
 
     header <- paste0(header, "The results were calculated using a ")
@@ -1431,14 +1432,6 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
         }
     }
 
-    header <- .concatenateSummaryText(header,
-        paste0(
-            "(", ifelse(design$sided == 1, "one", "two"),
-            "-sided, alpha = ", round(design$alpha, 4), ")"
-        ),
-        sep = " "
-    )
-
     if (!.isTrialDesignConditionalDunnett(design) && multiHypothesesEnabled) {
         if (stageResults$intersectionTest == "Dunnett") {
             header <- .concatenateSummaryText(header, "Dunnett intersection test")
@@ -1563,7 +1556,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
         paramName1, paramName2 = NA_character_,
         paramCaption1, paramCaption2 = NA_character_,
         shortcut1, shortcut2 = NA_character_,
-        digits1 = 2, digits2 = 2) {
+        digits1 = 3, digits2 = 3) {
     if (analysisResults$.design$kMax == 1) {
         return(header)
     }
@@ -1648,13 +1641,16 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
     return(header)
 }
 
-.addAlphaAndBetaToHeader <- function(header, design, designPlan, ..., endOfRecord = FALSE) {
+.addAlphaAndBetaToHeader <- function(header, design, designPlan, ..., endOfRecord = FALSE, powerEnabled = NA) {
     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"]])))
+    if (is.na(powerEnabled)) {
+        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, ".", "")),
@@ -1709,14 +1705,18 @@ SummaryFactory <- R6::R6Class("SummaryFactory",
 
 .createSummaryHeaderDesign <- function(design, designPlan, summaryFactory) {
     if (is.null(designPlan)) {
-        if (.isTrialDesignFisher(design)) {
-            designType <- "Fisher's combination test"
-        } else if (.isTrialDesignConditionalDunnett(design)) {
-            designType <- "Conditional Dunnett test"
+        if (design$kMax == 1) {
+            header <- "Fixed"
         } else {
-            designType <- C_TYPE_OF_DESIGN_LIST[[design$typeOfDesign]]
+            if (.isTrialDesignFisher(design)) {
+                designType <- C_TYPE_OF_FISHER_LIST[[design$method]]
+            } else if (.isTrialDesignConditionalDunnett(design)) {
+                designType <- "Conditional Dunnett test"
+            } else {
+                designType <- C_TYPE_OF_DESIGN_LIST[[design$typeOfDesign]]
+            }
+            header <- .firstCharacterToUpperCase(designType)
         }
-        header <- .firstCharacterToUpperCase(designType)
         header <- paste0(header, " design")
         if (design$.isDelayedResponseDesign()) {
             header <- paste0(header, " with delayed response")
@@ -3593,6 +3593,24 @@ 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 under H1",
+                    roundDigits = digitsSampleSize, transpose = TRUE
+                )
+            }
+
+            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,

diff --git a/R/f_analysis_base.R b/R/f_analysis_base.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: info@rpact.com
 ## |
-## |  File version: $Revision: 8023 $
-## |  Last changed: $Date: 2024-07-01 08:50:30 +0200 (Mo, 01 Jul 2024) $
+## |  File version: $Revision: 8087 $
+## |  Last changed: $Date: 2024-08-15 16:34:30 +0200 (Do, 15 Aug 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -243,7 +243,8 @@ getAnalysisResults <- function(design, dataInput, ...,
 
                 designBefore <- eval(parse(text = getObjectRCode(design,
                     newArgumentValues = list(
-                        informationRates = observedInformationRatesBefore
+                        informationRates = observedInformationRatesBefore,
+                        kMax = NA_integer_
                     ),
                     stringWrapParagraphWidth = NULL
                 )))
@@ -280,6 +281,7 @@ getAnalysisResults <- function(design, dataInput, ...,
                 design <- eval(parse(text = getObjectRCode(design,
                     newArgumentValues = list(
                         informationRates = observedInformationRates,
+                        kMax = NA_integer_,
                         userAlphaSpending = userAlphaSpending,
                         typeOfDesign = C_TYPE_OF_DESIGN_AS_USER
                     ),
@@ -291,7 +293,10 @@ getAnalysisResults <- function(design, dataInput, ...,
                 )
             } else {
                 design <- eval(parse(text = getObjectRCode(design,
-                    newArgumentValues = list(informationRates = observedInformationRates),
+                    newArgumentValues = list(
+                        informationRates = observedInformationRates, 
+                        kMax = NA_integer_
+                    ),
                     stringWrapParagraphWidth = NULL
                 )))
             }

diff --git a/R/f_core_constants.R b/R/f_core_constants.R
@@ -13,9 +13,9 @@
 ## |
 ## |  Contact us for information about our services: info@rpact.com
 ## |
-## |  File version: $Revision: 8023 $
-## |  Last changed: $Date: 2024-07-01 08:50:30 +0200 (Mo, 01 Jul 2024) $
-## |  Last changed by: $Author: pahlke $
+## |  File version: $Revision: 8059 $
+## |  Last changed: $Date: 2024-07-23 09:51:27 +0200 (Di, 23 Jul 2024) $
+## |  Last changed by: $Author: wassmer $
 ## |
 
 #' @include class_dictionary.R
@@ -239,6 +239,13 @@ C_TYPE_OF_DESIGN_LIST <- createDictionary("C_TYPE_OF_DESIGN_LIST", list(
     "noEarlyEfficacy" = "No early efficacy stop"
 ))
 
+C_TYPE_OF_FISHER_LIST <- createDictionary("C_TYPE_OF_FISHER_LIST", list(
+    "equalAlpha" = "Constant levels",
+    "fullAlpha" = "Full last stage level",
+    "noInteraction" = "Levels with no Interaction",
+    "userDefinedAlpha" = "User defined levels"
+))
+
 C_PLOT_SHOW_SOURCE_ARGUMENTS <- c("commands", "axes", "test", "validate")
 
 C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD <- "Conditional Power with Likelihood"

diff --git a/R/f_design_general_utilities.R b/R/f_design_general_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: 8087 $
+## |  Last changed: $Date: 2024-08-15 16:34:30 +0200 (Do, 15 Aug 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -133,7 +133,7 @@ NULL
             )
         }
     }
-
+    
     if (design$sided == 2 && .isDefinedArgument(parameterValues) &&
             (!.isTrialDesignInverseNormalOrGroupSequential(design) ||
                 (design$typeOfDesign != C_TYPE_OF_DESIGN_PT) && !.isBetaSpendingDesignType(design$typeBetaSpending)

diff --git a/R/f_logger.R b/R/f_logger.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: info@rpact.com
 ## |
-## |  File version: $Revision: 8023 $
-## |  Last changed: $Date: 2024-07-01 08:50:30 +0200 (Mo, 01 Jul 2024) $
+## |  File version: $Revision: 8087 $
+## |  Last changed: $Date: 2024-08-15 16:34:30 +0200 (Do, 15 Aug 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -81,7 +81,11 @@
     return(timeStr)
 }
 
-.logProgress <- function(s, ..., startTime, runtimeUnits = c("secs", "auto")) {
+.logProgress <- function(s, ..., startTime, runtimeUnits = c("secs", "auto"), enforceLogging = FALSE) {
+    if (isFALSE(enforceLogging) && !interactive()) {
+        return(invisible())
+    }
+
     if (!(getLogLevel() %in% c(
             C_LOG_LEVEL_TRACE, C_LOG_LEVEL_DEBUG,
             C_LOG_LEVEL_INFO, C_LOG_LEVEL_WARN,

diff --git a/R/f_simulation_base_survival.R b/R/f_simulation_base_survival.R
@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: info@rpact.com
 ## |
-## |  File version: $Revision: 8023 $
-## |  Last changed: $Date: 2024-07-01 08:50:30 +0200 (Mo, 01 Jul 2024) $
+## |  File version: $Revision: 8087 $
+## |  Last changed: $Date: 2024-08-15 16:34:30 +0200 (Do, 15 Aug 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -662,11 +662,7 @@ getSimulationSurvival <- function(design = NULL, ...,
     accrualTimeValue <- accrualTimeValue[1:accrualSetup$maxNumberOfSubjects]
 
     # to avoid last value to be NA_real_
-    i <- accrualSetup$maxNumberOfSubjects
-    while (is.na(accrualTimeValue[i])) {
-        accrualTimeValue[i] <- accrualTime[length(accrualTime)]
-        i <- i - 1
-    }
+    accrualTimeValue[is.na(accrualTimeValue)] <- accrualTime[length(accrualTime)]
 
     treatmentGroup <- rep(
         c(rep(1, allocation1), rep(2, allocation2)),

diff --git a/inst/doc/rpact_getting_started.html b/inst/doc/rpact_getting_started.html
@@ -12,7 +12,7 @@
 
 <meta name="author" content="Friedrich Pahlke and Gernot Wassmer" />
 
-<meta name="date" content="2024-06-27" />
+<meta name="date" content="2024-08-15" />
 
 <title>Getting started with rpact</title>
 
@@ -239,7 +239,7 @@
 
 <h1 class="title toc-ignore">Getting started with rpact</h1>
 <h4 class="author">Friedrich Pahlke and Gernot Wassmer</h4>
-<h4 class="date">2024-06-27</h4>
+<h4 class="date">2024-08-15</h4>
 
 
 

diff --git a/man/kableParameterSet.Rd b/man/kableParameterSet.Rd
diff --git a/src/f_simulation_base_survival.cpp b/src/f_simulation_base_survival.cpp
@@ -15,7 +15,7 @@
  * Contact us for information about our services: info@rpact.com
  *
  * File version: $Revision: 7679 $
- * Last changed: $Date: 2024-03-04 15:00:35 +0100 (Mo, 04 Mrz 2024) $
+ * Last changed: $Date: 2024-03-04 15:00:35 +0100 (Mon, 04 Mar 2024) $
  * Last changed by: $Author: wassmer $
  *
  */