Merge pull request #67 from rpact-com/dev/4.1.1

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rpact
 Title: Confirmatory Adaptive Clinical Trial Design and Analysis
-Version: 4.1.0.9271
-Date: 2024-11-20
+Version: 4.1.1.9273
+Date: 2024-12-12
 Authors@R: c(
 	person(
 		given = "Gernot", 
@@ -62,7 +62,8 @@ LinkingTo: Rcpp
 Suggests: 
 	ggplot2 (>= 3.2.0),	
 	testthat (>= 3.0.0),
-	rmarkdown (>= 1.10)
+	rmarkdown (>= 1.10),
+    rappdirs (>= 0.3.3)
 VignetteBuilder: knitr, rmarkdown
 RoxygenNote: 7.3.2
 Roxygen: list(markdown = TRUE)

NAMESPACE

@@ -48,14 +48,14 @@ S3method(print,Dataset)
 S3method(print,Dictionary)
 S3method(print,FieldSet)
 S3method(print,ParameterSet)
-S3method(print,SimulationResults)
 S3method(print,SummaryFactory)
 S3method(print,TrialDesignCharacteristics)
 S3method(print,TrialDesignSummaries)
 S3method(summary,AnalysisResults)
 S3method(summary,Dataset)
 S3method(summary,ParameterSet)
 S3method(summary,TrialDesignSet)
+export(MarkdownReporter)
 export(as251Normal)
 export(as251StudentT)
 export(fetch)
@@ -126,6 +126,7 @@ export(getSimulationMultiArmSurvival)
 export(getSimulationRates)
 export(getSimulationSurvival)
 export(getStageResults)
+export(getSystemIdentifier)
 export(getTestActions)
 export(getWideFormat)
 export(kable)
@@ -140,9 +141,12 @@ export(rcmd)
 export(readDataset)
 export(readDatasets)
 export(resetLogLevel)
+export(resetOptions)
 export(rpwexp)
+export(saveOptions)
 export(setLogLevel)
 export(setOutputFormat)
+export(setupPackageTests)
 export(testPackage)
 export(test_plan_section)
 export(writeDataset)

NEWS.md

@@ -1,8 +1,12 @@
-# rpact 4.1.1
+# rpact 4.2.0
 
 ## New features
 
 * For the functions `getSimulationMultiArmMeans()`, `getSimulationMultiArmRates()`, and `getSimulationMultiArmSurvival()` it is now possible to specify a parameter `doseLevels` to define the dose levels for a `linear` or `sigmoidEmax` dose-response relationship (see feature request [#63](https://github.com/rpact-com/rpact/issues/63))
+* `testPackage()` produces a comprehensive installation qualification report in html and pdf format (see new vignette [Installation Qualification of rpact](https://www.rpact.org/vignettes/utilities/rpact_installation_qualification))
+* `setupPackageTests()` sets up the package tests by downloading the test files and copying them to the rpact installation directory.
+* `saveOptions()` saves the current `rpact` options to a configuration file.
+* `resetOptions()` resets the `rpact` options to their default values.
 
 ## Improvements, issues, and changes
 

R/class_core_parameter_set.R

@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: [email protected]
 ## |
-## |  File version: $Revision: 8416 $
-## |  Last changed: $Date: 2024-11-18 16:13:44 +0100 (Mo, 18 Nov 2024) $
+## |  File version: $Revision: 8455 $
+## |  Last changed: $Date: 2024-12-12 09:33:14 +0100 (Do, 12 Dez 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -1698,10 +1698,22 @@ print.ParameterSet <- function(x, ..., markdown = NA) {
     if (is.na(markdown)) {
         markdown <- .isMarkdownEnabled("print")
     }
+
+    showStatistics <- NULL
+    if (inherits(x, "SimulationResults")) {
+        showStatistics <- .getOptionalArgument("showStatistics", ...)
+        if (!is.null(showStatistics)) {
+            .assertIsSingleLogical(showStatistics, "showStatistics")
+        }
+    }
 
     if (isTRUE(markdown)) {
         if (.isPrintCall(sysCalls)) {
-            result <- paste0(utils::capture.output(x$.catMarkdownText()), collapse = "\n")
+            if (!is.null(showStatistics)) {
+                result <- paste0(utils::capture.output(x$.catMarkdownText(showStatistics = showStatistics)), collapse = "\n")
+            } else {
+                result <- paste0(utils::capture.output(x$.catMarkdownText()), collapse = "\n")
+            }
             return(knitr::asis_output(result))
         }
 
@@ -1715,7 +1727,11 @@ print.ParameterSet <- function(x, ..., markdown = NA) {
         return(invisible(x))
     }
 
-    x$show()
+    if (!is.null(showStatistics)) {
+        x$show(showStatistics = showStatistics)
+    } else {
+        x$show()
+    }
     return(invisible(x))
 }
 
@@ -2102,7 +2118,7 @@ kable.ParameterSet <- function(x, ...) {
 
     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())
+        base::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"),

R/class_design.R

@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: [email protected]
 ## |
-## |  File version: $Revision: 8416 $
-## |  Last changed: $Date: 2024-11-18 16:13:44 +0100 (Mo, 18 Nov 2024) $
+## |  File version: $Revision: 8429 $
+## |  Last changed: $Date: 2024-11-20 14:14:32 +0100 (Mi, 20 Nov 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 

R/class_simulation_results.R

@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: [email protected]
 ## |
-## |  File version: $Revision: 8363 $
-## |  Last changed: $Date: 2024-11-07 07:18:40 +0100 (Do, 07 Nov 2024) $
+## |  File version: $Revision: 8451 $
+## |  Last changed: $Date: 2024-12-10 13:26:18 +0100 (Di, 10 Dez 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -1737,34 +1737,3 @@ SimulationResultsCountData <- R6::R6Class("SimulationResultsCountData",
     )
 )
 
-#'
-#' @title
-#' Print Simulation Results
-#'
-#' @description
-#' \code{print} prints its \code{SimulationResults} argument and
-#' returns it invisibly (via \code{invisible(x)}).
-#'
-#' @param x The \code{\link{SimulationResults}} object to print.
-#' @param markdown If \code{TRUE}, the object \code{x}
-#'        will be printed using markdown syntax;
-#'        normal representation will be used otherwise (default is \code{FALSE})
-#' @inheritParams param_three_dots
-#'
-#' @details
-#' Prints the parameters and results of an \code{SimulationResults} object.
-#'
-#' @export
-#'
-#' @keywords internal
-#'
-print.SimulationResults <- function(x, ..., showStatistics = FALSE, markdown = FALSE) {
-    if (markdown) {
-        x$.catMarkdownText(showStatistics = showStatistics)
-        return(invisible(x))
-    }
-
-    x$show(showStatistics = showStatistics)
-    invisible(x)
-}
-

R/f_analysis_base.R

@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: [email protected]
 ## |
-## |  File version: $Revision: 8426 $
-## |  Last changed: $Date: 2024-11-20 13:43:12 +0100 (Mi, 20 Nov 2024) $
+## |  File version: $Revision: 8454 $
+## |  Last changed: $Date: 2024-12-12 07:12:43 +0100 (Do, 12 Dez 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -180,7 +180,7 @@ getAnalysisResults <- function(
         maxInformation = NULL,
         informationEpsilon = NULL) {
 
-    on.exit(options("rpact.analyis.repeated.p.values.warnings.enabled" = "TRUE"))
+    on.exit(base::options("rpact.analyis.repeated.p.values.warnings.enabled" = "TRUE"))
     designAndDataInput <- .getDesignAndDataInput(design = design, dataInput = dataInput, ...)
     design <- designAndDataInput$design
     dataInput <- designAndDataInput$dataInput

R/f_analysis_boundary_recalculation.R

@@ -441,7 +441,7 @@ getObservedInformationRates <- function(dataInput,
             typeOfDesign = C_TYPE_OF_DESIGN_AS_USER
         )
     )
-    options("rpact.analyis.repeated.p.values.warnings.enabled" = "FALSE")
+    base::options("rpact.analyis.repeated.p.values.warnings.enabled" = "FALSE")
     warning("Repeated p-values not available for automatic ",
         "recalculation of boundaries at final stage",
         call. = FALSE

R/f_core_output_formats.R

@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: [email protected]
 ## |
-## |  File version: $Revision: 8124 $
-## |  Last changed: $Date: 2024-08-23 08:41:16 +0200 (Fr, 23 Aug 2024) $
+## |  File version: $Revision: 8454 $
+## |  Last changed: $Date: 2024-12-12 07:12:43 +0100 (Do, 12 Dez 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -791,6 +791,8 @@ C_OUTPUT_FORMAT_DEFAULT_VALUES <- pairlist(
 #' @param roundFunction A character value that specifies the R base round function
 #'        to use, default is \code{NA_character_}.
 #'        Allowed values are "ceiling", "floor", "trunc", "round", "signif", and \code{NA_character_}.
+#' @param persist A logical value indicating whether the output format settings 
+#'        should be saved persistently. Default is \code{TRUE}.
 #' @inheritParams param_three_dots
 #'
 #' @details
@@ -824,7 +826,8 @@ setOutputFormat <- function(parameterName = NA_character_, ...,
         futilityProbabilityEnabled = NA,
         file = NA_character_,
         resetToDefault = FALSE,
-        roundFunction = NA_character_) {
+        roundFunction = NA_character_,
+        persist = TRUE) {
     .assertIsCharacter(parameterName, "parameterName", naAllowed = TRUE)
     .assertIsSingleInteger(digits, "digits", naAllowed = TRUE, validateType = FALSE)
     .assertIsInClosedInterval(digits, "digits", lower = 0, upper = 20, naAllowed = TRUE)
@@ -835,7 +838,8 @@ setOutputFormat <- function(parameterName = NA_character_, ...,
     .assertIsSingleCharacter(file, "file", naAllowed = TRUE)
     .assertIsSingleLogical(resetToDefault, "resetToDefault")
     .assertIsSingleCharacter(roundFunction, "roundFunction", naAllowed = TRUE)
-
+    .assertIsSingleLogical(persist, "persist")
+
     .warnInCaseOfUnknownArguments(functionName = "setOutputFormat", ...)
 
     if (resetToDefault) {
@@ -932,6 +936,10 @@ setOutputFormat <- function(parameterName = NA_character_, ...,
             }
         }
     }
+
+    if (persist) {
+        saveOptions()
+    }
 }
 
 .getOutputFormatKey <- function(parameterName, silent = FALSE) {