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

.gitignore

@@ -34,3 +34,5 @@ testthat-problems.rds
 /tests/testthat/Rplots.pdf
 /tests/testthat/index.txt
 /rpact.Rproj
+/figure/create_designPlan-1.png
+/figure/create_designPlan-2.png

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rpact
 Title: Confirmatory Adaptive Clinical Trial Design and Analysis
-Version: 4.0.1.9250
-Date: 2024-08-23
+Version: 4.0.1.9252
+Date: 2024-08-28
 Authors@R: c(
 	person(
 		given = "Gernot", 
@@ -64,7 +64,7 @@ Suggests:
 	testthat (>= 3.0.0),
 	rmarkdown (>= 1.10)
 VignetteBuilder: knitr, rmarkdown
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Roxygen: list(markdown = TRUE)
 Config/testthat/edition: 3
 Config/testthat/parallel: true

NAMESPACE

@@ -43,13 +43,15 @@ S3method(plot,TrialDesign)
 S3method(plot,TrialDesignCharacteristics)
 S3method(plot,TrialDesignPlan)
 S3method(plot,TrialDesignSet)
+S3method(plot,TrialDesignSummaries)
 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(pull,ParameterSet)
 S3method(summary,AnalysisResults)
 S3method(summary,Dataset)

R/class_analysis_dataset.R

@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: info@rpact.com
 ## |
-## |  File version: $Revision: 8113 $
-## |  Last changed: $Date: 2024-08-21 10:25:39 +0200 (Mi, 21 Aug 2024) $
+## |  File version: $Revision: 8141 $
+## |  Last changed: $Date: 2024-08-28 15:03:46 +0200 (Mi, 28 Aug 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -2531,8 +2531,15 @@ DatasetMeans <- R6::R6Class("DatasetMeans",
 #'
 #' @export
 #'
-plot.Dataset <- function(x, y, ..., main = "Dataset", xlab = "Stage", ylab = NA_character_,
-        legendTitle = "Group", palette = "Set1", showSource = FALSE, plotSettings = NULL) {
+plot.Dataset <- function(x, y, ..., 
+        main = "Dataset", 
+        xlab = "Stage", 
+        ylab = NA_character_,
+        legendTitle = "Group", 
+        palette = "Set1", 
+        showSource = FALSE, 
+        plotSettings = NULL) {
+
     markdown <- .getOptionalArgument("markdown", ..., optionalArgumentDefaultValue = NA)
     if (is.na(markdown)) {
         markdown <- .isMarkdownEnabled("plot")
@@ -2550,7 +2557,7 @@ plot.Dataset <- function(x, y, ..., main = "Dataset", xlab = "Stage", ylab = NA_
         ...)
 
     if (markdown) {
-        sep <- "\n\n-----\n\n"
+        sep <- .getMarkdownPlotPrintSeparator()
         print(do.call(.plot.Dataset, args))
         return(.knitPrintQueue(x, sep = sep, prefix = sep))
     }

R/class_analysis_results.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: 8141 $
+## |  Last changed: $Date: 2024-08-28 15:03:46 +0200 (Mi, 28 Aug 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -1825,12 +1825,22 @@ AnalysisResultsConditionalDunnett <- R6::R6Class("AnalysisResultsConditionalDunn
 #'
 #' @export
 #'
-plot.AnalysisResults <- function(x, y, ..., type = 1L,
+plot.AnalysisResults <- function(x, y, ..., 
+        type = 1L,
         nPlanned = NA_real_,
         allocationRatioPlanned = NA_real_,
-        main = NA_character_, xlab = NA_character_, ylab = NA_character_,
-        legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_,
-        showSource = FALSE, grid = 1, plotSettings = NULL) {
+        main = NA_character_, 
+        xlab = NA_character_, 
+        ylab = NA_character_,
+        legendTitle = NA_character_, 
+        palette = "Set1", 
+        legendPosition = NA_integer_,
+        showSource = FALSE, 
+        grid = 1, 
+        plotSettings = NULL) {
+
+    .assertIsValidPlotType(type, naAllowed = FALSE)
+    .assertIsSingleInteger(grid, "grid", naAllowed = FALSE, validateType = FALSE)
     markdown <- .getOptionalArgument("markdown", ..., optionalArgumentDefaultValue = NA)
     if (is.na(markdown)) {
         markdown <- .isMarkdownEnabled("plot")
@@ -1854,8 +1864,16 @@ plot.AnalysisResults <- function(x, y, ..., type = 1L,
         ...)
 
     if (markdown) {
-        sep <- "\n\n-----\n\n"
-        print(do.call(.plot.AnalysisResults, args))
+        sep <- .getMarkdownPlotPrintSeparator()
+        if (length(type) > 1 && grid == 1) {
+            grid <- 0
+            args$grid <- 0
+        }
+        if (grid > 0) {
+            print(do.call(.plot.AnalysisResults, args))            
+        } else {
+            do.call(.plot.AnalysisResults, args)
+        }
         return(.knitPrintQueue(x, sep = sep, prefix = sep))
     } else {
         return(do.call(.plot.AnalysisResults, args))

R/class_analysis_stage_results.R

@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: info@rpact.com
 ## |
-## |  File version: $Revision: 8113 $
-## |  Last changed: $Date: 2024-08-21 10:25:39 +0200 (Mi, 21 Aug 2024) $
+## |  File version: $Revision: 8141 $
+## |  Last changed: $Date: 2024-08-28 15:03:46 +0200 (Mi, 28 Aug 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -1575,7 +1575,7 @@ plot.StageResults <- function(
         ...)
 
     if (markdown) {
-        sep <- "\n\n-----\n\n"
+        sep <- .getMarkdownPlotPrintSeparator()
         print(do.call(.plot.StageResults, args))
         return(.knitPrintQueue(x, sep = sep, prefix = sep))
     }

R/class_core_parameter_set.R

@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: info@rpact.com
 ## |
-## |  File version: $Revision: 8124 $
-## |  Last changed: $Date: 2024-08-23 08:41:16 +0200 (Fr, 23 Aug 2024) $
+## |  File version: $Revision: 8141 $
+## |  Last changed: $Date: 2024-08-28 15:03:46 +0200 (Mi, 28 Aug 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -1550,7 +1550,7 @@ as.matrix.FieldSet <- function(x, ..., enforceRowNames = TRUE, niceColumnNamesEn
 #' @inheritParams param_digits
 #' @param output The output parts, default is \code{"all"}.
 #' @param printObject Show also the print output after the summary, default is \code{FALSE}.
-#' @param sep The separator line between the summary and the optional print output.
+#' @param sep The separator line between the summary and the optional print output, default is \code{"\n\n-----\n\n"}.
 #' @inheritParams param_three_dots
 #'
 #' @details
@@ -1570,9 +1570,14 @@ summary.ParameterSet <- function(object, ...,
         digits = NA_integer_,
         output = c("all", "title", "overview", "body"),
         printObject = FALSE,
-        sep = "\n\n-----\n\n") {
+        sep = NA_character_) {
+
     .warnInCaseOfUnknownArguments(functionName = "summary", ignore = c("printObject"), ...)
-
+    .assertIsSingleCharacter(sep, "sep", naAllowed = TRUE)
+    if (is.na(sep)) {
+        sep <- .getMarkdownPlotPrintSeparator()
+    }
+
     base::attr(object, "printObject") <- printObject
     base::attr(object, "printObjectSeparator") <- sep
 
@@ -1890,10 +1895,8 @@ plot.ParameterSet <- function(x, y, ..., main = NA_character_,
 #'
 #' @details
 #' Generic function to print a field 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.
+#' 
+#' @template details_knit_print
 #'
 #' @keywords internal
 #' 
@@ -1919,10 +1922,8 @@ knit_print.FieldSet <- function(x, ...) {
 #'
 #' @details
 #' Generic function to print 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.
+#' 
+#' @template details_knit_print
 #'
 #' @keywords internal
 #' 
@@ -1951,12 +1952,6 @@ knit_print.ParameterSet <- function(x, ...) {
 #' 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

R/class_design.R

@@ -13,8 +13,8 @@
 ## |
 ## |  Contact us for information about our services: info@rpact.com
 ## |
-## |  File version: $Revision: 8113 $
-## |  Last changed: $Date: 2024-08-21 10:25:39 +0200 (Mi, 21 Aug 2024) $
+## |  File version: $Revision: 8141 $
+## |  Last changed: $Date: 2024-08-28 15:03:46 +0200 (Mi, 28 Aug 2024) $
 ## |  Last changed by: $Author: pahlke $
 ## |
 
@@ -319,7 +319,6 @@ print.TrialDesignCharacteristics <- function(x, ..., markdown = NA, showDesign =
         return(invisible(x))
     }
 
-
     if (showDesign) {
         print.ParameterSet(x$.design, ..., markdown = markdown)
     }
@@ -1120,6 +1119,8 @@ plot.TrialDesign <- function(
         grid = 1, 
         plotSettings = NULL) {
 
+    .assertIsValidPlotType(type, naAllowed = FALSE)
+    .assertIsSingleInteger(grid, "grid", naAllowed = FALSE, validateType = FALSE)
     markdown <- .getOptionalArgument("markdown", ..., optionalArgumentDefaultValue = NA)
     if (is.na(markdown)) {
         markdown <- .isMarkdownEnabled("plot")
@@ -1143,8 +1144,16 @@ plot.TrialDesign <- function(
         ...)
 
     if (markdown) {
-        sep <- "\n\n-----\n\n"
-        print(do.call(.plot.TrialDesign, args))
+        sep <- .getMarkdownPlotPrintSeparator()
+        if (length(type) > 1 && grid == 1) {
+            grid <- 0
+            args$grid <- 0
+        }
+        if (grid > 0) {
+            print(do.call(.plot.TrialDesign, args))
+        } else {
+            do.call(.plot.TrialDesign, args)
+        }
         return(.knitPrintQueue(x, sep = sep, prefix = sep))
     }
 
@@ -1210,15 +1219,25 @@ plot.TrialDesign <- function(
 
 #' @rdname plot.TrialDesign
 #' @export
-plot.TrialDesignCharacteristics <- function(x, y, ...) {
+plot.TrialDesignCharacteristics <- function(x, y, ..., type = 1L, grid = 1) {
+    .assertIsValidPlotType(type, naAllowed = FALSE)
+    .assertIsSingleInteger(grid, "grid", naAllowed = FALSE, validateType = FALSE)
     markdown <- .getOptionalArgument("markdown", ..., optionalArgumentDefaultValue = NA)
     if (is.na(markdown)) {
         markdown <- .isMarkdownEnabled("plot")
     }
 
     if (markdown) {
-        sep <- "\n\n-----\n\n"
-        print(.plot.TrialDesign(x = x$.design, y = y, ...))
+        sep <- .getMarkdownPlotPrintSeparator()
+        if (length(type) > 1 && grid == 1) {
+            grid <- 0
+            args$grid <- 0
+        }
+        if (grid > 0) {
+            print(.plot.TrialDesign(x = x$.design, y = y, type = type, grid = grid, ...))            
+        } else {
+            .plot.TrialDesign(x = x$.design, y = y, type = type, grid = grid, ...)
+        }
         return(.knitPrintQueue(x, sep = sep, prefix = sep))
     }